3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 with Atree; use Atree;
29 with Checks; use Checks;
30 with Debug; use Debug;
31 with Einfo; use Einfo;
32 with Elists; use Elists;
33 with Errout; use Errout;
34 with Eval_Fat; use Eval_Fat;
35 with Exp_Util; use Exp_Util;
36 with Nmake; use Nmake;
37 with Nlists; use Nlists;
40 with Sem_Cat; use Sem_Cat;
41 with Sem_Ch8; use Sem_Ch8;
42 with Sem_Res; use Sem_Res;
43 with Sem_Util; use Sem_Util;
44 with Sem_Type; use Sem_Type;
45 with Sem_Warn; use Sem_Warn;
46 with Sinfo; use Sinfo;
47 with Snames; use Snames;
48 with Stand; use Stand;
49 with Stringt; use Stringt;
50 with Tbuild; use Tbuild;
52 package body Sem_Eval is
54 -----------------------------------------
55 -- Handling of Compile Time Evaluation --
56 -----------------------------------------
58 -- The compile time evaluation of expressions is distributed over several
59 -- Eval_xxx procedures. These procedures are called immediatedly after
60 -- a subexpression is resolved and is therefore accomplished in a bottom
61 -- up fashion. The flags are synthesized using the following approach.
63 -- Is_Static_Expression is determined by following the detailed rules
64 -- in RM 4.9(4-14). This involves testing the Is_Static_Expression
65 -- flag of the operands in many cases.
67 -- Raises_Constraint_Error is set if any of the operands have the flag
68 -- set or if an attempt to compute the value of the current expression
69 -- results in detection of a runtime constraint error.
71 -- As described in the spec, the requirement is that Is_Static_Expression
72 -- be accurately set, and in addition for nodes for which this flag is set,
73 -- Raises_Constraint_Error must also be set. Furthermore a node which has
74 -- Is_Static_Expression set, and Raises_Constraint_Error clear, then the
75 -- requirement is that the expression value must be precomputed, and the
76 -- node is either a literal, or the name of a constant entity whose value
77 -- is a static expression.
79 -- The general approach is as follows. First compute Is_Static_Expression.
80 -- If the node is not static, then the flag is left off in the node and
81 -- we are all done. Otherwise for a static node, we test if any of the
82 -- operands will raise constraint error, and if so, propagate the flag
83 -- Raises_Constraint_Error to the result node and we are done (since the
84 -- error was already posted at a lower level).
86 -- For the case of a static node whose operands do not raise constraint
87 -- error, we attempt to evaluate the node. If this evaluation succeeds,
88 -- then the node is replaced by the result of this computation. If the
89 -- evaluation raises constraint error, then we rewrite the node with
90 -- Apply_Compile_Time_Constraint_Error to raise the exception and also
91 -- to post appropriate error messages.
97 type Bits is array (Nat range <>) of Boolean;
98 -- Used to convert unsigned (modular) values for folding logical ops
100 -- The following definitions are used to maintain a cache of nodes that
101 -- have compile time known values. The cache is maintained only for
102 -- discrete types (the most common case), and is populated by calls to
103 -- Compile_Time_Known_Value and Expr_Value, but only used by Expr_Value
104 -- since it is possible for the status to change (in particular it is
105 -- possible for a node to get replaced by a constraint error node).
107 CV_Bits : constant := 5;
108 -- Number of low order bits of Node_Id value used to reference entries
109 -- in the cache table.
111 CV_Cache_Size : constant Nat := 2 ** CV_Bits;
112 -- Size of cache for compile time values
114 subtype CV_Range is Nat range 0 .. CV_Cache_Size;
116 type CV_Entry is record
121 type CV_Cache_Array is array (CV_Range) of CV_Entry;
123 CV_Cache : CV_Cache_Array := (others => (Node_High_Bound, Uint_0));
124 -- This is the actual cache, with entries consisting of node/value pairs,
125 -- and the impossible value Node_High_Bound used for unset entries.
127 -----------------------
128 -- Local Subprograms --
129 -----------------------
131 function From_Bits (B : Bits; T : Entity_Id) return Uint;
132 -- Converts a bit string of length B'Length to a Uint value to be used
133 -- for a target of type T, which is a modular type. This procedure
134 -- includes the necessary reduction by the modulus in the case of a
135 -- non-binary modulus (for a binary modulus, the bit string is the
136 -- right length any way so all is well).
138 function Get_String_Val (N : Node_Id) return Node_Id;
139 -- Given a tree node for a folded string or character value, returns
140 -- the corresponding string literal or character literal (one of the
141 -- two must be available, or the operand would not have been marked
142 -- as foldable in the earlier analysis of the operation).
144 function OK_Bits (N : Node_Id; Bits : Uint) return Boolean;
145 -- Bits represents the number of bits in an integer value to be computed
146 -- (but the value has not been computed yet). If this value in Bits is
147 -- reasonable, a result of True is returned, with the implication that
148 -- the caller should go ahead and complete the calculation. If the value
149 -- in Bits is unreasonably large, then an error is posted on node N, and
150 -- False is returned (and the caller skips the proposed calculation).
152 procedure Out_Of_Range (N : Node_Id);
153 -- This procedure is called if it is determined that node N, which
154 -- appears in a non-static context, is a compile time known value
155 -- which is outside its range, i.e. the range of Etype. This is used
156 -- in contexts where this is an illegality if N is static, and should
157 -- generate a warning otherwise.
159 procedure Rewrite_In_Raise_CE (N : Node_Id; Exp : Node_Id);
160 -- N and Exp are nodes representing an expression, Exp is known
161 -- to raise CE. N is rewritten in term of Exp in the optimal way.
163 function String_Type_Len (Stype : Entity_Id) return Uint;
164 -- Given a string type, determines the length of the index type, or,
165 -- if this index type is non-static, the length of the base type of
166 -- this index type. Note that if the string type is itself static,
167 -- then the index type is static, so the second case applies only
168 -- if the string type passed is non-static.
170 function Test (Cond : Boolean) return Uint;
171 pragma Inline (Test);
172 -- This function simply returns the appropriate Boolean'Pos value
173 -- corresponding to the value of Cond as a universal integer. It is
174 -- used for producing the result of the static evaluation of the
177 procedure Test_Expression_Is_Foldable
182 -- Tests to see if expression N whose single operand is Op1 is foldable,
183 -- i.e. the operand value is known at compile time. If the operation is
184 -- foldable, then Fold is True on return, and Stat indicates whether
185 -- the result is static (i.e. both operands were static). Note that it
186 -- is quite possible for Fold to be True, and Stat to be False, since
187 -- there are cases in which we know the value of an operand even though
188 -- it is not technically static (e.g. the static lower bound of a range
189 -- whose upper bound is non-static).
191 -- If Stat is set False on return, then Expression_Is_Foldable makes a
192 -- call to Check_Non_Static_Context on the operand. If Fold is False on
193 -- return, then all processing is complete, and the caller should
194 -- return, since there is nothing else to do.
196 procedure Test_Expression_Is_Foldable
202 -- Same processing, except applies to an expression N with two operands
205 procedure To_Bits (U : Uint; B : out Bits);
206 -- Converts a Uint value to a bit string of length B'Length
208 ------------------------------
209 -- Check_Non_Static_Context --
210 ------------------------------
212 procedure Check_Non_Static_Context (N : Node_Id) is
213 T : Entity_Id := Etype (N);
214 Checks_On : constant Boolean :=
215 not Index_Checks_Suppressed (T)
216 and not Range_Checks_Suppressed (T);
219 -- We need the check only for static expressions not raising CE
220 -- We can also ignore cases in which the type is Any_Type
222 if not Is_OK_Static_Expression (N)
223 or else Etype (N) = Any_Type
227 -- Skip this check for non-scalar expressions
229 elsif not Is_Scalar_Type (T) then
233 -- Here we have the case of outer level static expression of
234 -- scalar type, where the processing of this procedure is needed.
236 -- For real types, this is where we convert the value to a machine
237 -- number (see RM 4.9(38)). Also see ACVC test C490001. We should
238 -- only need to do this if the parent is a constant declaration,
239 -- since in other cases, gigi should do the necessary conversion
240 -- correctly, but experimentation shows that this is not the case
241 -- on all machines, in particular if we do not convert all literals
242 -- to machine values in non-static contexts, then ACVC test C490001
243 -- fails on Sparc/Solaris and SGI/Irix.
245 if Nkind (N) = N_Real_Literal
246 and then not Is_Machine_Number (N)
247 and then not Is_Generic_Type (Etype (N))
248 and then Etype (N) /= Universal_Real
250 -- Check that value is in bounds before converting to machine
251 -- number, so as not to lose case where value overflows in the
252 -- least significant bit or less. See B490001.
254 if Is_Out_Of_Range (N, Base_Type (T)) then
259 -- Note: we have to copy the node, to avoid problems with conformance
260 -- of very similar numbers (see ACVC tests B4A010C and B63103A).
262 Rewrite (N, New_Copy (N));
264 if not Is_Floating_Point_Type (T) then
266 (N, Corresponding_Integer_Value (N) * Small_Value (T));
268 elsif not UR_Is_Zero (Realval (N)) then
270 RT : constant Entity_Id := Base_Type (T);
271 X : constant Ureal := Machine (RT, Realval (N), Round);
274 -- Warn if result of static rounding actually differs from
275 -- runtime evaluation, which uses round to even.
277 if Warn_On_Biased_Rounding and Rounding_Was_Biased then
278 Error_Msg_N ("static expression does not round to even"
279 & " ('R'M 4.9(38))?", N);
286 Set_Is_Machine_Number (N);
289 -- Check for out of range universal integer. This is a non-static
290 -- context, so the integer value must be in range of the runtime
291 -- representation of universal integers.
293 -- We do this only within an expression, because that is the only
294 -- case in which non-static universal integer values can occur, and
295 -- furthermore, Check_Non_Static_Context is currently (incorrectly???)
296 -- called in contexts like the expression of a number declaration where
297 -- we certainly want to allow out of range values.
299 if Etype (N) = Universal_Integer
300 and then Nkind (N) = N_Integer_Literal
301 and then Nkind (Parent (N)) in N_Subexpr
303 (Intval (N) < Expr_Value (Type_Low_Bound (Universal_Integer))
305 Intval (N) > Expr_Value (Type_High_Bound (Universal_Integer)))
307 Apply_Compile_Time_Constraint_Error
308 (N, "non-static universal integer value out of range?",
309 CE_Range_Check_Failed);
311 -- Check out of range of base type
313 elsif Is_Out_Of_Range (N, Base_Type (T)) then
316 -- Give warning if outside subtype (where one or both of the
317 -- bounds of the subtype is static). This warning is omitted
318 -- if the expression appears in a range that could be null
319 -- (warnings are handled elsewhere for this case).
321 elsif T /= Base_Type (T)
322 and then Nkind (Parent (N)) /= N_Range
324 if Is_In_Range (N, T) then
327 elsif Is_Out_Of_Range (N, T) then
328 Apply_Compile_Time_Constraint_Error
329 (N, "value not in range of}?", CE_Range_Check_Failed);
332 Enable_Range_Check (N);
335 Set_Do_Range_Check (N, False);
338 end Check_Non_Static_Context;
340 ---------------------------------
341 -- Check_String_Literal_Length --
342 ---------------------------------
344 procedure Check_String_Literal_Length (N : Node_Id; Ttype : Entity_Id) is
346 if not Raises_Constraint_Error (N)
347 and then Is_Constrained (Ttype)
350 UI_From_Int (String_Length (Strval (N))) /= String_Type_Len (Ttype)
352 Apply_Compile_Time_Constraint_Error
353 (N, "string length wrong for}?",
354 CE_Length_Check_Failed,
359 end Check_String_Literal_Length;
361 --------------------------
362 -- Compile_Time_Compare --
363 --------------------------
365 function Compile_Time_Compare (L, R : Node_Id) return Compare_Result is
366 Ltyp : constant Entity_Id := Etype (L);
367 Rtyp : constant Entity_Id := Etype (R);
369 procedure Compare_Decompose
373 -- This procedure decomposes the node N into an expression node
374 -- and a signed offset, so that the value of N is equal to the
375 -- value of R plus the value V (which may be negative). If no
376 -- such decomposition is possible, then on return R is a copy
377 -- of N, and V is set to zero.
379 function Compare_Fixup (N : Node_Id) return Node_Id;
380 -- This function deals with replacing 'Last and 'First references
381 -- with their corresponding type bounds, which we then can compare.
382 -- The argument is the original node, the result is the identity,
383 -- unless we have a 'Last/'First reference in which case the value
384 -- returned is the appropriate type bound.
386 function Is_Same_Value (L, R : Node_Id) return Boolean;
387 -- Returns True iff L and R represent expressions that definitely
388 -- have identical (but not necessarily compile time known) values
389 -- Indeed the caller is expected to have already dealt with the
390 -- cases of compile time known values, so these are not tested here.
392 -----------------------
393 -- Compare_Decompose --
394 -----------------------
396 procedure Compare_Decompose
402 if Nkind (N) = N_Op_Add
403 and then Nkind (Right_Opnd (N)) = N_Integer_Literal
406 V := Intval (Right_Opnd (N));
409 elsif Nkind (N) = N_Op_Subtract
410 and then Nkind (Right_Opnd (N)) = N_Integer_Literal
413 V := UI_Negate (Intval (Right_Opnd (N)));
416 elsif Nkind (N) = N_Attribute_Reference then
418 if Attribute_Name (N) = Name_Succ then
419 R := First (Expressions (N));
423 elsif Attribute_Name (N) = Name_Pred then
424 R := First (Expressions (N));
432 end Compare_Decompose;
438 function Compare_Fixup (N : Node_Id) return Node_Id is
444 if Nkind (N) = N_Attribute_Reference
445 and then (Attribute_Name (N) = Name_First
447 Attribute_Name (N) = Name_Last)
449 Xtyp := Etype (Prefix (N));
451 -- If we have no type, then just abandon the attempt to do
452 -- a fixup, this is probably the result of some other error.
458 -- Dereference an access type
460 if Is_Access_Type (Xtyp) then
461 Xtyp := Designated_Type (Xtyp);
464 -- If we don't have an array type at this stage, something
465 -- is peculiar, e.g. another error, and we abandon the attempt
468 if not Is_Array_Type (Xtyp) then
472 -- Ignore unconstrained array, since bounds are not meaningful
474 if not Is_Constrained (Xtyp) then
478 if Ekind (Xtyp) = E_String_Literal_Subtype then
479 if Attribute_Name (N) = Name_First then
480 return String_Literal_Low_Bound (Xtyp);
482 else -- Attribute_Name (N) = Name_Last
483 return Make_Integer_Literal (Sloc (N),
484 Intval => Intval (String_Literal_Low_Bound (Xtyp))
485 + String_Literal_Length (Xtyp));
489 -- Find correct index type
491 Indx := First_Index (Xtyp);
493 if Present (Expressions (N)) then
494 Subs := UI_To_Int (Expr_Value (First (Expressions (N))));
496 for J in 2 .. Subs loop
497 Indx := Next_Index (Indx);
501 Xtyp := Etype (Indx);
503 if Attribute_Name (N) = Name_First then
504 return Type_Low_Bound (Xtyp);
506 else -- Attribute_Name (N) = Name_Last
507 return Type_High_Bound (Xtyp);
518 function Is_Same_Value (L, R : Node_Id) return Boolean is
519 Lf : constant Node_Id := Compare_Fixup (L);
520 Rf : constant Node_Id := Compare_Fixup (R);
523 -- Values are the same if they are the same identifier and the
524 -- identifier refers to a constant object (E_Constant)
526 if Nkind (Lf) = N_Identifier and then Nkind (Rf) = N_Identifier
527 and then Entity (Lf) = Entity (Rf)
528 and then (Ekind (Entity (Lf)) = E_Constant or else
529 Ekind (Entity (Lf)) = E_In_Parameter or else
530 Ekind (Entity (Lf)) = E_Loop_Parameter)
534 -- Or if they are compile time known and identical
536 elsif Compile_Time_Known_Value (Lf)
538 Compile_Time_Known_Value (Rf)
539 and then Expr_Value (Lf) = Expr_Value (Rf)
543 -- Or if they are both 'First or 'Last values applying to the
544 -- same entity (first and last don't change even if value does)
546 elsif Nkind (Lf) = N_Attribute_Reference
548 Nkind (Rf) = N_Attribute_Reference
549 and then Attribute_Name (Lf) = Attribute_Name (Rf)
550 and then (Attribute_Name (Lf) = Name_First
552 Attribute_Name (Lf) = Name_Last)
553 and then Is_Entity_Name (Prefix (Lf))
554 and then Is_Entity_Name (Prefix (Rf))
555 and then Entity (Prefix (Lf)) = Entity (Prefix (Rf))
559 -- All other cases, we can't tell
566 -- Start of processing for Compile_Time_Compare
569 -- If either operand could raise constraint error, then we cannot
570 -- know the result at compile time (since CE may be raised!)
572 if not (Cannot_Raise_Constraint_Error (L)
574 Cannot_Raise_Constraint_Error (R))
579 -- Identical operands are most certainly equal
584 -- If expressions have no types, then do not attempt to determine
585 -- if they are the same, since something funny is going on. One
586 -- case in which this happens is during generic template analysis,
587 -- when bounds are not fully analyzed.
589 elsif No (Ltyp) or else No (Rtyp) then
592 -- We only attempt compile time analysis for scalar values
594 elsif not Is_Scalar_Type (Ltyp)
595 or else Is_Packed_Array_Type (Ltyp)
599 -- Case where comparison involves two compile time known values
601 elsif Compile_Time_Known_Value (L)
602 and then Compile_Time_Known_Value (R)
604 -- For the floating-point case, we have to be a little careful, since
605 -- at compile time we are dealing with universal exact values, but at
606 -- runtime, these will be in non-exact target form. That's why the
607 -- returned results are LE and GE below instead of LT and GT.
609 if Is_Floating_Point_Type (Ltyp)
611 Is_Floating_Point_Type (Rtyp)
614 Lo : constant Ureal := Expr_Value_R (L);
615 Hi : constant Ureal := Expr_Value_R (R);
627 -- For the integer case we know exactly (note that this includes the
628 -- fixed-point case, where we know the run time integer values now)
632 Lo : constant Uint := Expr_Value (L);
633 Hi : constant Uint := Expr_Value (R);
646 -- Cases where at least one operand is not known at compile time
649 -- Here is where we check for comparisons against maximum bounds of
650 -- types, where we know that no value can be outside the bounds of
651 -- the subtype. Note that this routine is allowed to assume that all
652 -- expressions are within their subtype bounds. Callers wishing to
653 -- deal with possibly invalid values must in any case take special
654 -- steps (e.g. conversions to larger types) to avoid this kind of
655 -- optimization, which is always considered to be valid. We do not
656 -- attempt this optimization with generic types, since the type
657 -- bounds may not be meaningful in this case.
659 if Is_Discrete_Type (Ltyp)
660 and then not Is_Generic_Type (Ltyp)
661 and then not Is_Generic_Type (Rtyp)
663 if Is_Same_Value (R, Type_High_Bound (Ltyp)) then
666 elsif Is_Same_Value (R, Type_Low_Bound (Ltyp)) then
669 elsif Is_Same_Value (L, Type_High_Bound (Rtyp)) then
672 elsif Is_Same_Value (L, Type_Low_Bound (Ltyp)) then
677 -- Next attempt is to decompose the expressions to extract
678 -- a constant offset resulting from the use of any of the forms:
685 -- Then we see if the two expressions are the same value, and if so
686 -- the result is obtained by comparing the offsets.
695 Compare_Decompose (L, Lnode, Loffs);
696 Compare_Decompose (R, Rnode, Roffs);
698 if Is_Same_Value (Lnode, Rnode) then
699 if Loffs = Roffs then
702 elsif Loffs < Roffs then
709 -- If the expressions are different, we cannot say at compile
710 -- time how they compare, so we return the Unknown indication.
717 end Compile_Time_Compare;
719 ------------------------------
720 -- Compile_Time_Known_Value --
721 ------------------------------
723 function Compile_Time_Known_Value (Op : Node_Id) return Boolean is
724 K : constant Node_Kind := Nkind (Op);
725 CV_Ent : CV_Entry renames CV_Cache (Nat (Op) mod CV_Cache_Size);
728 -- Never known at compile time if bad type or raises constraint error
729 -- or empty (latter case occurs only as a result of a previous error)
733 or else Etype (Op) = Any_Type
734 or else Raises_Constraint_Error (Op)
739 -- If we have an entity name, then see if it is the name of a constant
740 -- and if so, test the corresponding constant value, or the name of
741 -- an enumeration literal, which is always a constant.
743 if Present (Etype (Op)) and then Is_Entity_Name (Op) then
745 E : constant Entity_Id := Entity (Op);
749 -- Never known at compile time if it is a packed array value.
750 -- We might want to try to evaluate these at compile time one
751 -- day, but we do not make that attempt now.
753 if Is_Packed_Array_Type (Etype (Op)) then
757 if Ekind (E) = E_Enumeration_Literal then
760 elsif Ekind (E) = E_Constant then
761 V := Constant_Value (E);
762 return Present (V) and then Compile_Time_Known_Value (V);
766 -- We have a value, see if it is compile time known
769 -- Integer literals are worth storing in the cache
771 if K = N_Integer_Literal then
773 CV_Ent.V := Intval (Op);
776 -- Other literals and NULL are known at compile time
779 K = N_Character_Literal
789 -- Any reference to Null_Parameter is known at compile time. No
790 -- other attribute references (that have not already been folded)
791 -- are known at compile time.
793 elsif K = N_Attribute_Reference then
794 return Attribute_Name (Op) = Name_Null_Parameter;
798 -- If we fall through, not known at compile time
802 -- If we get an exception while trying to do this test, then some error
803 -- has occurred, and we simply say that the value is not known after all
808 end Compile_Time_Known_Value;
810 --------------------------------------
811 -- Compile_Time_Known_Value_Or_Aggr --
812 --------------------------------------
814 function Compile_Time_Known_Value_Or_Aggr (Op : Node_Id) return Boolean is
816 -- If we have an entity name, then see if it is the name of a constant
817 -- and if so, test the corresponding constant value, or the name of
818 -- an enumeration literal, which is always a constant.
820 if Is_Entity_Name (Op) then
822 E : constant Entity_Id := Entity (Op);
826 if Ekind (E) = E_Enumeration_Literal then
829 elsif Ekind (E) /= E_Constant then
833 V := Constant_Value (E);
835 and then Compile_Time_Known_Value_Or_Aggr (V);
839 -- We have a value, see if it is compile time known
842 if Compile_Time_Known_Value (Op) then
845 elsif Nkind (Op) = N_Aggregate then
847 if Present (Expressions (Op)) then
852 Expr := First (Expressions (Op));
853 while Present (Expr) loop
854 if not Compile_Time_Known_Value_Or_Aggr (Expr) then
863 if Present (Component_Associations (Op)) then
868 Cass := First (Component_Associations (Op));
869 while Present (Cass) loop
871 Compile_Time_Known_Value_Or_Aggr (Expression (Cass))
883 -- All other types of values are not known at compile time
890 end Compile_Time_Known_Value_Or_Aggr;
896 -- This is only called for actuals of functions that are not predefined
897 -- operators (which have already been rewritten as operators at this
898 -- stage), so the call can never be folded, and all that needs doing for
899 -- the actual is to do the check for a non-static context.
901 procedure Eval_Actual (N : Node_Id) is
903 Check_Non_Static_Context (N);
910 -- Allocators are never static, so all we have to do is to do the
911 -- check for a non-static context if an expression is present.
913 procedure Eval_Allocator (N : Node_Id) is
914 Expr : constant Node_Id := Expression (N);
917 if Nkind (Expr) = N_Qualified_Expression then
918 Check_Non_Static_Context (Expression (Expr));
922 ------------------------
923 -- Eval_Arithmetic_Op --
924 ------------------------
926 -- Arithmetic operations are static functions, so the result is static
927 -- if both operands are static (RM 4.9(7), 4.9(20)).
929 procedure Eval_Arithmetic_Op (N : Node_Id) is
930 Left : constant Node_Id := Left_Opnd (N);
931 Right : constant Node_Id := Right_Opnd (N);
932 Ltype : constant Entity_Id := Etype (Left);
933 Rtype : constant Entity_Id := Etype (Right);
938 -- If not foldable we are done
940 Test_Expression_Is_Foldable (N, Left, Right, Stat, Fold);
946 -- Fold for cases where both operands are of integer type
948 if Is_Integer_Type (Ltype) and then Is_Integer_Type (Rtype) then
950 Left_Int : constant Uint := Expr_Value (Left);
951 Right_Int : constant Uint := Expr_Value (Right);
958 Result := Left_Int + Right_Int;
960 when N_Op_Subtract =>
961 Result := Left_Int - Right_Int;
963 when N_Op_Multiply =>
966 (Num_Bits (Left_Int) + Num_Bits (Right_Int)))
968 Result := Left_Int * Right_Int;
975 -- The exception Constraint_Error is raised by integer
976 -- division, rem and mod if the right operand is zero.
978 if Right_Int = 0 then
979 Apply_Compile_Time_Constraint_Error
980 (N, "division by zero", CE_Divide_By_Zero);
983 Result := Left_Int / Right_Int;
988 -- The exception Constraint_Error is raised by integer
989 -- division, rem and mod if the right operand is zero.
991 if Right_Int = 0 then
992 Apply_Compile_Time_Constraint_Error
993 (N, "mod with zero divisor", CE_Divide_By_Zero);
996 Result := Left_Int mod Right_Int;
1001 -- The exception Constraint_Error is raised by integer
1002 -- division, rem and mod if the right operand is zero.
1004 if Right_Int = 0 then
1005 Apply_Compile_Time_Constraint_Error
1006 (N, "rem with zero divisor", CE_Divide_By_Zero);
1009 Result := Left_Int rem Right_Int;
1013 raise Program_Error;
1016 -- Adjust the result by the modulus if the type is a modular type
1018 if Is_Modular_Integer_Type (Ltype) then
1019 Result := Result mod Modulus (Ltype);
1022 Fold_Uint (N, Result);
1025 -- Cases where at least one operand is a real. We handle the cases
1026 -- of both reals, or mixed/real integer cases (the latter happen
1027 -- only for divide and multiply, and the result is always real).
1029 elsif Is_Real_Type (Ltype) or else Is_Real_Type (Rtype) then
1036 if Is_Real_Type (Ltype) then
1037 Left_Real := Expr_Value_R (Left);
1039 Left_Real := UR_From_Uint (Expr_Value (Left));
1042 if Is_Real_Type (Rtype) then
1043 Right_Real := Expr_Value_R (Right);
1045 Right_Real := UR_From_Uint (Expr_Value (Right));
1048 if Nkind (N) = N_Op_Add then
1049 Result := Left_Real + Right_Real;
1051 elsif Nkind (N) = N_Op_Subtract then
1052 Result := Left_Real - Right_Real;
1054 elsif Nkind (N) = N_Op_Multiply then
1055 Result := Left_Real * Right_Real;
1057 else pragma Assert (Nkind (N) = N_Op_Divide);
1058 if UR_Is_Zero (Right_Real) then
1059 Apply_Compile_Time_Constraint_Error
1060 (N, "division by zero", CE_Divide_By_Zero);
1064 Result := Left_Real / Right_Real;
1067 Fold_Ureal (N, Result);
1071 Set_Is_Static_Expression (N, Stat);
1072 end Eval_Arithmetic_Op;
1074 ----------------------------
1075 -- Eval_Character_Literal --
1076 ----------------------------
1078 -- Nothing to be done!
1080 procedure Eval_Character_Literal (N : Node_Id) is
1081 pragma Warnings (Off, N);
1085 end Eval_Character_Literal;
1087 ------------------------
1088 -- Eval_Concatenation --
1089 ------------------------
1091 -- Concatenation is a static function, so the result is static if
1092 -- both operands are static (RM 4.9(7), 4.9(21)).
1094 procedure Eval_Concatenation (N : Node_Id) is
1095 Left : constant Node_Id := Left_Opnd (N);
1096 Right : constant Node_Id := Right_Opnd (N);
1097 C_Typ : constant Entity_Id := Root_Type (Component_Type (Etype (N)));
1102 -- Concatenation is never static in Ada 83, so if Ada 83
1103 -- check operand non-static context
1106 and then Comes_From_Source (N)
1108 Check_Non_Static_Context (Left);
1109 Check_Non_Static_Context (Right);
1113 -- If not foldable we are done. In principle concatenation that yields
1114 -- any string type is static (i.e. an array type of character types).
1115 -- However, character types can include enumeration literals, and
1116 -- concatenation in that case cannot be described by a literal, so we
1117 -- only consider the operation static if the result is an array of
1118 -- (a descendant of) a predefined character type.
1120 Test_Expression_Is_Foldable (N, Left, Right, Stat, Fold);
1122 if (C_Typ = Standard_Character
1123 or else C_Typ = Standard_Wide_Character)
1128 Set_Is_Static_Expression (N, False);
1132 -- Compile time string concatenation.
1134 -- ??? Note that operands that are aggregates can be marked as
1135 -- static, so we should attempt at a later stage to fold
1136 -- concatenations with such aggregates.
1139 Left_Str : constant Node_Id := Get_String_Val (Left);
1141 Right_Str : constant Node_Id := Get_String_Val (Right);
1144 -- Establish new string literal, and store left operand. We make
1145 -- sure to use the special Start_String that takes an operand if
1146 -- the left operand is a string literal. Since this is optimized
1147 -- in the case where that is the most recently created string
1148 -- literal, we ensure efficient time/space behavior for the
1149 -- case of a concatenation of a series of string literals.
1151 if Nkind (Left_Str) = N_String_Literal then
1152 Left_Len := String_Length (Strval (Left_Str));
1153 Start_String (Strval (Left_Str));
1156 Store_String_Char (Char_Literal_Value (Left_Str));
1160 -- Now append the characters of the right operand
1162 if Nkind (Right_Str) = N_String_Literal then
1164 S : constant String_Id := Strval (Right_Str);
1167 for J in 1 .. String_Length (S) loop
1168 Store_String_Char (Get_String_Char (S, J));
1172 Store_String_Char (Char_Literal_Value (Right_Str));
1175 Set_Is_Static_Expression (N, Stat);
1179 -- If left operand is the empty string, the result is the
1180 -- right operand, including its bounds if anomalous.
1183 and then Is_Array_Type (Etype (Right))
1184 and then Etype (Right) /= Any_String
1186 Set_Etype (N, Etype (Right));
1189 Fold_Str (N, End_String);
1192 end Eval_Concatenation;
1194 ---------------------------------
1195 -- Eval_Conditional_Expression --
1196 ---------------------------------
1198 -- This GNAT internal construct can never be statically folded, so the
1199 -- only required processing is to do the check for non-static context
1200 -- for the two expression operands.
1202 procedure Eval_Conditional_Expression (N : Node_Id) is
1203 Condition : constant Node_Id := First (Expressions (N));
1204 Then_Expr : constant Node_Id := Next (Condition);
1205 Else_Expr : constant Node_Id := Next (Then_Expr);
1208 Check_Non_Static_Context (Then_Expr);
1209 Check_Non_Static_Context (Else_Expr);
1210 end Eval_Conditional_Expression;
1212 ----------------------
1213 -- Eval_Entity_Name --
1214 ----------------------
1216 -- This procedure is used for identifiers and expanded names other than
1217 -- named numbers (see Eval_Named_Integer, Eval_Named_Real. These are
1218 -- static if they denote a static constant (RM 4.9(6)) or if the name
1219 -- denotes an enumeration literal (RM 4.9(22)).
1221 procedure Eval_Entity_Name (N : Node_Id) is
1222 Def_Id : constant Entity_Id := Entity (N);
1226 -- Enumeration literals are always considered to be constants
1227 -- and cannot raise constraint error (RM 4.9(22)).
1229 if Ekind (Def_Id) = E_Enumeration_Literal then
1230 Set_Is_Static_Expression (N);
1233 -- A name is static if it denotes a static constant (RM 4.9(5)), and
1234 -- we also copy Raise_Constraint_Error. Notice that even if non-static,
1235 -- it does not violate 10.2.1(8) here, since this is not a variable.
1237 elsif Ekind (Def_Id) = E_Constant then
1239 -- Deferred constants must always be treated as nonstatic
1240 -- outside the scope of their full view.
1242 if Present (Full_View (Def_Id))
1243 and then not In_Open_Scopes (Scope (Def_Id))
1247 Val := Constant_Value (Def_Id);
1250 if Present (Val) then
1251 Set_Is_Static_Expression
1252 (N, Is_Static_Expression (Val)
1253 and then Is_Static_Subtype (Etype (Def_Id)));
1254 Set_Raises_Constraint_Error (N, Raises_Constraint_Error (Val));
1256 if not Is_Static_Expression (N)
1257 and then not Is_Generic_Type (Etype (N))
1259 Validate_Static_Object_Name (N);
1266 -- Fall through if the name is not static.
1268 Validate_Static_Object_Name (N);
1269 end Eval_Entity_Name;
1271 ----------------------------
1272 -- Eval_Indexed_Component --
1273 ----------------------------
1275 -- Indexed components are never static, so we need to perform the check
1276 -- for non-static context on the index values. Then, we check if the
1277 -- value can be obtained at compile time, even though it is non-static.
1279 procedure Eval_Indexed_Component (N : Node_Id) is
1283 Expr := First (Expressions (N));
1284 while Present (Expr) loop
1285 Check_Non_Static_Context (Expr);
1289 -- See if this is a constant array reference
1291 if List_Length (Expressions (N)) = 1
1292 and then Is_Entity_Name (Prefix (N))
1293 and then Ekind (Entity (Prefix (N))) = E_Constant
1294 and then Present (Constant_Value (Entity (Prefix (N))))
1297 Loc : constant Source_Ptr := Sloc (N);
1298 Arr : constant Node_Id := Constant_Value (Entity (Prefix (N)));
1299 Sub : constant Node_Id := First (Expressions (N));
1305 -- Linear one's origin subscript value for array reference
1308 -- Lower bound of the first array index
1311 -- Value from constant array
1314 Atyp := Etype (Arr);
1316 if Is_Access_Type (Atyp) then
1317 Atyp := Designated_Type (Atyp);
1320 -- If we have an array type (we should have but perhaps there
1321 -- are error cases where this is not the case), then see if we
1322 -- can do a constant evaluation of the array reference.
1324 if Is_Array_Type (Atyp) then
1325 if Ekind (Atyp) = E_String_Literal_Subtype then
1326 Lbd := String_Literal_Low_Bound (Atyp);
1328 Lbd := Type_Low_Bound (Etype (First_Index (Atyp)));
1331 if Compile_Time_Known_Value (Sub)
1332 and then Nkind (Arr) = N_Aggregate
1333 and then Compile_Time_Known_Value (Lbd)
1334 and then Is_Discrete_Type (Component_Type (Atyp))
1336 Lin := UI_To_Int (Expr_Value (Sub) - Expr_Value (Lbd)) + 1;
1338 if List_Length (Expressions (Arr)) >= Lin then
1339 Elm := Pick (Expressions (Arr), Lin);
1341 -- If the resulting expression is compile time known,
1342 -- then we can rewrite the indexed component with this
1343 -- value, being sure to mark the result as non-static.
1344 -- We also reset the Sloc, in case this generates an
1345 -- error later on (e.g. 136'Access).
1347 if Compile_Time_Known_Value (Elm) then
1348 Rewrite (N, Duplicate_Subexpr_No_Checks (Elm));
1349 Set_Is_Static_Expression (N, False);
1357 end Eval_Indexed_Component;
1359 --------------------------
1360 -- Eval_Integer_Literal --
1361 --------------------------
1363 -- Numeric literals are static (RM 4.9(1)), and have already been marked
1364 -- as static by the analyzer. The reason we did it that early is to allow
1365 -- the possibility of turning off the Is_Static_Expression flag after
1366 -- analysis, but before resolution, when integer literals are generated
1367 -- in the expander that do not correspond to static expressions.
1369 procedure Eval_Integer_Literal (N : Node_Id) is
1370 T : constant Entity_Id := Etype (N);
1373 -- If the literal appears in a non-expression context, then it is
1374 -- certainly appearing in a non-static context, so check it. This
1375 -- is actually a redundant check, since Check_Non_Static_Context
1376 -- would check it, but it seems worth while avoiding the call.
1378 if Nkind (Parent (N)) not in N_Subexpr then
1379 Check_Non_Static_Context (N);
1382 -- Modular integer literals must be in their base range
1384 if Is_Modular_Integer_Type (T)
1385 and then Is_Out_Of_Range (N, Base_Type (T))
1389 end Eval_Integer_Literal;
1391 ---------------------
1392 -- Eval_Logical_Op --
1393 ---------------------
1395 -- Logical operations are static functions, so the result is potentially
1396 -- static if both operands are potentially static (RM 4.9(7), 4.9(20)).
1398 procedure Eval_Logical_Op (N : Node_Id) is
1399 Left : constant Node_Id := Left_Opnd (N);
1400 Right : constant Node_Id := Right_Opnd (N);
1405 -- If not foldable we are done
1407 Test_Expression_Is_Foldable (N, Left, Right, Stat, Fold);
1413 -- Compile time evaluation of logical operation
1416 Left_Int : constant Uint := Expr_Value (Left);
1417 Right_Int : constant Uint := Expr_Value (Right);
1420 if Is_Modular_Integer_Type (Etype (N)) then
1422 Left_Bits : Bits (0 .. UI_To_Int (Esize (Etype (N))) - 1);
1423 Right_Bits : Bits (0 .. UI_To_Int (Esize (Etype (N))) - 1);
1426 To_Bits (Left_Int, Left_Bits);
1427 To_Bits (Right_Int, Right_Bits);
1429 -- Note: should really be able to use array ops instead of
1430 -- these loops, but they weren't working at the time ???
1432 if Nkind (N) = N_Op_And then
1433 for J in Left_Bits'Range loop
1434 Left_Bits (J) := Left_Bits (J) and Right_Bits (J);
1437 elsif Nkind (N) = N_Op_Or then
1438 for J in Left_Bits'Range loop
1439 Left_Bits (J) := Left_Bits (J) or Right_Bits (J);
1443 pragma Assert (Nkind (N) = N_Op_Xor);
1445 for J in Left_Bits'Range loop
1446 Left_Bits (J) := Left_Bits (J) xor Right_Bits (J);
1450 Fold_Uint (N, From_Bits (Left_Bits, Etype (N)));
1454 pragma Assert (Is_Boolean_Type (Etype (N)));
1456 if Nkind (N) = N_Op_And then
1458 Test (Is_True (Left_Int) and then Is_True (Right_Int)));
1460 elsif Nkind (N) = N_Op_Or then
1462 Test (Is_True (Left_Int) or else Is_True (Right_Int)));
1465 pragma Assert (Nkind (N) = N_Op_Xor);
1467 Test (Is_True (Left_Int) xor Is_True (Right_Int)));
1471 Set_Is_Static_Expression (N, Stat);
1473 end Eval_Logical_Op;
1475 ------------------------
1476 -- Eval_Membership_Op --
1477 ------------------------
1479 -- A membership test is potentially static if the expression is static,
1480 -- and the range is a potentially static range, or is a subtype mark
1481 -- denoting a static subtype (RM 4.9(12)).
1483 procedure Eval_Membership_Op (N : Node_Id) is
1484 Left : constant Node_Id := Left_Opnd (N);
1485 Right : constant Node_Id := Right_Opnd (N);
1494 -- Ignore if error in either operand, except to make sure that
1495 -- Any_Type is properly propagated to avoid junk cascaded errors.
1497 if Etype (Left) = Any_Type
1498 or else Etype (Right) = Any_Type
1500 Set_Etype (N, Any_Type);
1504 -- Case of right operand is a subtype name
1506 if Is_Entity_Name (Right) then
1507 Def_Id := Entity (Right);
1509 if (Is_Scalar_Type (Def_Id) or else Is_String_Type (Def_Id))
1510 and then Is_OK_Static_Subtype (Def_Id)
1512 Test_Expression_Is_Foldable (N, Left, Stat, Fold);
1514 if not Fold or else not Stat then
1518 Check_Non_Static_Context (Left);
1522 -- For string membership tests we will check the length
1525 if not Is_String_Type (Def_Id) then
1526 Lo := Type_Low_Bound (Def_Id);
1527 Hi := Type_High_Bound (Def_Id);
1534 -- Case of right operand is a range
1537 if Is_Static_Range (Right) then
1538 Test_Expression_Is_Foldable (N, Left, Stat, Fold);
1540 if not Fold or else not Stat then
1543 -- If one bound of range raises CE, then don't try to fold
1545 elsif not Is_OK_Static_Range (Right) then
1546 Check_Non_Static_Context (Left);
1551 Check_Non_Static_Context (Left);
1555 -- Here we know range is an OK static range
1557 Lo := Low_Bound (Right);
1558 Hi := High_Bound (Right);
1561 -- For strings we check that the length of the string expression is
1562 -- compatible with the string subtype if the subtype is constrained,
1563 -- or if unconstrained then the test is always true.
1565 if Is_String_Type (Etype (Right)) then
1566 if not Is_Constrained (Etype (Right)) then
1571 Typlen : constant Uint := String_Type_Len (Etype (Right));
1572 Strlen : constant Uint :=
1573 UI_From_Int (String_Length (Strval (Get_String_Val (Left))));
1575 Result := (Typlen = Strlen);
1579 -- Fold the membership test. We know we have a static range and Lo
1580 -- and Hi are set to the expressions for the end points of this range.
1582 elsif Is_Real_Type (Etype (Right)) then
1584 Leftval : constant Ureal := Expr_Value_R (Left);
1587 Result := Expr_Value_R (Lo) <= Leftval
1588 and then Leftval <= Expr_Value_R (Hi);
1593 Leftval : constant Uint := Expr_Value (Left);
1596 Result := Expr_Value (Lo) <= Leftval
1597 and then Leftval <= Expr_Value (Hi);
1601 if Nkind (N) = N_Not_In then
1602 Result := not Result;
1605 Fold_Uint (N, Test (Result));
1606 Warn_On_Known_Condition (N);
1608 end Eval_Membership_Op;
1610 ------------------------
1611 -- Eval_Named_Integer --
1612 ------------------------
1614 procedure Eval_Named_Integer (N : Node_Id) is
1617 Expr_Value (Expression (Declaration_Node (Entity (N)))));
1618 end Eval_Named_Integer;
1620 ---------------------
1621 -- Eval_Named_Real --
1622 ---------------------
1624 procedure Eval_Named_Real (N : Node_Id) is
1627 Expr_Value_R (Expression (Declaration_Node (Entity (N)))));
1628 end Eval_Named_Real;
1634 -- Exponentiation is a static functions, so the result is potentially
1635 -- static if both operands are potentially static (RM 4.9(7), 4.9(20)).
1637 procedure Eval_Op_Expon (N : Node_Id) is
1638 Left : constant Node_Id := Left_Opnd (N);
1639 Right : constant Node_Id := Right_Opnd (N);
1644 -- If not foldable we are done
1646 Test_Expression_Is_Foldable (N, Left, Right, Stat, Fold);
1652 -- Fold exponentiation operation
1655 Right_Int : constant Uint := Expr_Value (Right);
1660 if Is_Integer_Type (Etype (Left)) then
1662 Left_Int : constant Uint := Expr_Value (Left);
1666 -- Exponentiation of an integer raises the exception
1667 -- Constraint_Error for a negative exponent (RM 4.5.6)
1669 if Right_Int < 0 then
1670 Apply_Compile_Time_Constraint_Error
1671 (N, "integer exponent negative", CE_Range_Check_Failed);
1675 if OK_Bits (N, Num_Bits (Left_Int) * Right_Int) then
1676 Result := Left_Int ** Right_Int;
1681 if Is_Modular_Integer_Type (Etype (N)) then
1682 Result := Result mod Modulus (Etype (N));
1685 Fold_Uint (N, Result);
1693 Left_Real : constant Ureal := Expr_Value_R (Left);
1696 -- Cannot have a zero base with a negative exponent
1698 if UR_Is_Zero (Left_Real) then
1700 if Right_Int < 0 then
1701 Apply_Compile_Time_Constraint_Error
1702 (N, "zero ** negative integer", CE_Range_Check_Failed);
1705 Fold_Ureal (N, Ureal_0);
1709 Fold_Ureal (N, Left_Real ** Right_Int);
1714 Set_Is_Static_Expression (N, Stat);
1722 -- The not operation is a static functions, so the result is potentially
1723 -- static if the operand is potentially static (RM 4.9(7), 4.9(20)).
1725 procedure Eval_Op_Not (N : Node_Id) is
1726 Right : constant Node_Id := Right_Opnd (N);
1731 -- If not foldable we are done
1733 Test_Expression_Is_Foldable (N, Right, Stat, Fold);
1739 -- Fold not operation
1742 Rint : constant Uint := Expr_Value (Right);
1743 Typ : constant Entity_Id := Etype (N);
1746 -- Negation is equivalent to subtracting from the modulus minus
1747 -- one. For a binary modulus this is equivalent to the ones-
1748 -- component of the original value. For non-binary modulus this
1749 -- is an arbitrary but consistent definition.
1751 if Is_Modular_Integer_Type (Typ) then
1752 Fold_Uint (N, Modulus (Typ) - 1 - Rint);
1755 pragma Assert (Is_Boolean_Type (Typ));
1756 Fold_Uint (N, Test (not Is_True (Rint)));
1759 Set_Is_Static_Expression (N, Stat);
1763 -------------------------------
1764 -- Eval_Qualified_Expression --
1765 -------------------------------
1767 -- A qualified expression is potentially static if its subtype mark denotes
1768 -- a static subtype and its expression is potentially static (RM 4.9 (11)).
1770 procedure Eval_Qualified_Expression (N : Node_Id) is
1771 Operand : constant Node_Id := Expression (N);
1772 Target_Type : constant Entity_Id := Entity (Subtype_Mark (N));
1779 -- Can only fold if target is string or scalar and subtype is static
1780 -- Also, do not fold if our parent is an allocator (this is because
1781 -- the qualified expression is really part of the syntactic structure
1782 -- of an allocator, and we do not want to end up with something that
1783 -- corresponds to "new 1" where the 1 is the result of folding a
1784 -- qualified expression).
1786 if not Is_Static_Subtype (Target_Type)
1787 or else Nkind (Parent (N)) = N_Allocator
1789 Check_Non_Static_Context (Operand);
1793 -- If not foldable we are done
1795 Test_Expression_Is_Foldable (N, Operand, Stat, Fold);
1800 -- Don't try fold if target type has constraint error bounds
1802 elsif not Is_OK_Static_Subtype (Target_Type) then
1803 Set_Raises_Constraint_Error (N);
1807 -- Here we will fold, save Print_In_Hex indication
1809 Hex := Nkind (Operand) = N_Integer_Literal
1810 and then Print_In_Hex (Operand);
1812 -- Fold the result of qualification
1814 if Is_Discrete_Type (Target_Type) then
1815 Fold_Uint (N, Expr_Value (Operand));
1816 Set_Is_Static_Expression (N, Stat);
1818 -- Preserve Print_In_Hex indication
1820 if Hex and then Nkind (N) = N_Integer_Literal then
1821 Set_Print_In_Hex (N);
1824 elsif Is_Real_Type (Target_Type) then
1825 Fold_Ureal (N, Expr_Value_R (Operand));
1826 Set_Is_Static_Expression (N, Stat);
1829 Fold_Str (N, Strval (Get_String_Val (Operand)));
1832 Set_Is_Static_Expression (N, False);
1834 Check_String_Literal_Length (N, Target_Type);
1840 if Is_Out_Of_Range (N, Etype (N)) then
1844 end Eval_Qualified_Expression;
1846 -----------------------
1847 -- Eval_Real_Literal --
1848 -----------------------
1850 -- Numeric literals are static (RM 4.9(1)), and have already been marked
1851 -- as static by the analyzer. The reason we did it that early is to allow
1852 -- the possibility of turning off the Is_Static_Expression flag after
1853 -- analysis, but before resolution, when integer literals are generated
1854 -- in the expander that do not correspond to static expressions.
1856 procedure Eval_Real_Literal (N : Node_Id) is
1858 -- If the literal appears in a non-expression context, then it is
1859 -- certainly appearing in a non-static context, so check it.
1861 if Nkind (Parent (N)) not in N_Subexpr then
1862 Check_Non_Static_Context (N);
1865 end Eval_Real_Literal;
1867 ------------------------
1868 -- Eval_Relational_Op --
1869 ------------------------
1871 -- Relational operations are static functions, so the result is static
1872 -- if both operands are static (RM 4.9(7), 4.9(20)).
1874 procedure Eval_Relational_Op (N : Node_Id) is
1875 Left : constant Node_Id := Left_Opnd (N);
1876 Right : constant Node_Id := Right_Opnd (N);
1877 Typ : constant Entity_Id := Etype (Left);
1883 -- One special case to deal with first. If we can tell that
1884 -- the result will be false because the lengths of one or
1885 -- more index subtypes are compile time known and different,
1886 -- then we can replace the entire result by False. We only
1887 -- do this for one dimensional arrays, because the case of
1888 -- multi-dimensional arrays is rare and too much trouble!
1890 if Is_Array_Type (Typ)
1891 and then Number_Dimensions (Typ) = 1
1892 and then (Nkind (N) = N_Op_Eq
1893 or else Nkind (N) = N_Op_Ne)
1895 if Raises_Constraint_Error (Left)
1896 or else Raises_Constraint_Error (Right)
1902 procedure Get_Static_Length (Op : Node_Id; Len : out Uint);
1903 -- If Op is an expression for a constrained array with a
1904 -- known at compile time length, then Len is set to this
1905 -- (non-negative length). Otherwise Len is set to minus 1.
1907 procedure Get_Static_Length (Op : Node_Id; Len : out Uint) is
1911 if Nkind (Op) = N_String_Literal then
1912 Len := UI_From_Int (String_Length (Strval (Op)));
1914 elsif not Is_Constrained (Etype (Op)) then
1915 Len := Uint_Minus_1;
1918 T := Etype (First_Index (Etype (Op)));
1920 if Is_Discrete_Type (T)
1922 Compile_Time_Known_Value (Type_Low_Bound (T))
1924 Compile_Time_Known_Value (Type_High_Bound (T))
1926 Len := UI_Max (Uint_0,
1927 Expr_Value (Type_High_Bound (T)) -
1928 Expr_Value (Type_Low_Bound (T)) + 1);
1930 Len := Uint_Minus_1;
1933 end Get_Static_Length;
1939 Get_Static_Length (Left, Len_L);
1940 Get_Static_Length (Right, Len_R);
1942 if Len_L /= Uint_Minus_1
1943 and then Len_R /= Uint_Minus_1
1944 and then Len_L /= Len_R
1946 Fold_Uint (N, Test (Nkind (N) = N_Op_Ne));
1947 Set_Is_Static_Expression (N, False);
1948 Warn_On_Known_Condition (N);
1954 -- Can only fold if type is scalar (don't fold string ops)
1956 if not Is_Scalar_Type (Typ) then
1957 Check_Non_Static_Context (Left);
1958 Check_Non_Static_Context (Right);
1962 -- If not foldable we are done
1964 Test_Expression_Is_Foldable (N, Left, Right, Stat, Fold);
1970 -- Integer and Enumeration (discrete) type cases
1972 if Is_Discrete_Type (Typ) then
1974 Left_Int : constant Uint := Expr_Value (Left);
1975 Right_Int : constant Uint := Expr_Value (Right);
1979 when N_Op_Eq => Result := Left_Int = Right_Int;
1980 when N_Op_Ne => Result := Left_Int /= Right_Int;
1981 when N_Op_Lt => Result := Left_Int < Right_Int;
1982 when N_Op_Le => Result := Left_Int <= Right_Int;
1983 when N_Op_Gt => Result := Left_Int > Right_Int;
1984 when N_Op_Ge => Result := Left_Int >= Right_Int;
1987 raise Program_Error;
1990 Fold_Uint (N, Test (Result));
1996 pragma Assert (Is_Real_Type (Typ));
1999 Left_Real : constant Ureal := Expr_Value_R (Left);
2000 Right_Real : constant Ureal := Expr_Value_R (Right);
2004 when N_Op_Eq => Result := (Left_Real = Right_Real);
2005 when N_Op_Ne => Result := (Left_Real /= Right_Real);
2006 when N_Op_Lt => Result := (Left_Real < Right_Real);
2007 when N_Op_Le => Result := (Left_Real <= Right_Real);
2008 when N_Op_Gt => Result := (Left_Real > Right_Real);
2009 when N_Op_Ge => Result := (Left_Real >= Right_Real);
2012 raise Program_Error;
2015 Fold_Uint (N, Test (Result));
2019 Set_Is_Static_Expression (N, Stat);
2020 Warn_On_Known_Condition (N);
2021 end Eval_Relational_Op;
2027 -- Shift operations are intrinsic operations that can never be static,
2028 -- so the only processing required is to perform the required check for
2029 -- a non static context for the two operands.
2031 -- Actually we could do some compile time evaluation here some time ???
2033 procedure Eval_Shift (N : Node_Id) is
2035 Check_Non_Static_Context (Left_Opnd (N));
2036 Check_Non_Static_Context (Right_Opnd (N));
2039 ------------------------
2040 -- Eval_Short_Circuit --
2041 ------------------------
2043 -- A short circuit operation is potentially static if both operands
2044 -- are potentially static (RM 4.9 (13))
2046 procedure Eval_Short_Circuit (N : Node_Id) is
2047 Kind : constant Node_Kind := Nkind (N);
2048 Left : constant Node_Id := Left_Opnd (N);
2049 Right : constant Node_Id := Right_Opnd (N);
2051 Rstat : constant Boolean :=
2052 Is_Static_Expression (Left)
2053 and then Is_Static_Expression (Right);
2056 -- Short circuit operations are never static in Ada 83
2059 and then Comes_From_Source (N)
2061 Check_Non_Static_Context (Left);
2062 Check_Non_Static_Context (Right);
2066 -- Now look at the operands, we can't quite use the normal call to
2067 -- Test_Expression_Is_Foldable here because short circuit operations
2068 -- are a special case, they can still be foldable, even if the right
2069 -- operand raises constraint error.
2071 -- If either operand is Any_Type, just propagate to result and
2072 -- do not try to fold, this prevents cascaded errors.
2074 if Etype (Left) = Any_Type or else Etype (Right) = Any_Type then
2075 Set_Etype (N, Any_Type);
2078 -- If left operand raises constraint error, then replace node N with
2079 -- the raise constraint error node, and we are obviously not foldable.
2080 -- Is_Static_Expression is set from the two operands in the normal way,
2081 -- and we check the right operand if it is in a non-static context.
2083 elsif Raises_Constraint_Error (Left) then
2085 Check_Non_Static_Context (Right);
2088 Rewrite_In_Raise_CE (N, Left);
2089 Set_Is_Static_Expression (N, Rstat);
2092 -- If the result is not static, then we won't in any case fold
2094 elsif not Rstat then
2095 Check_Non_Static_Context (Left);
2096 Check_Non_Static_Context (Right);
2100 -- Here the result is static, note that, unlike the normal processing
2101 -- in Test_Expression_Is_Foldable, we did *not* check above to see if
2102 -- the right operand raises constraint error, that's because it is not
2103 -- significant if the left operand is decisive.
2105 Set_Is_Static_Expression (N);
2107 -- It does not matter if the right operand raises constraint error if
2108 -- it will not be evaluated. So deal specially with the cases where
2109 -- the right operand is not evaluated. Note that we will fold these
2110 -- cases even if the right operand is non-static, which is fine, but
2111 -- of course in these cases the result is not potentially static.
2113 Left_Int := Expr_Value (Left);
2115 if (Kind = N_And_Then and then Is_False (Left_Int))
2116 or else (Kind = N_Or_Else and Is_True (Left_Int))
2118 Fold_Uint (N, Left_Int);
2122 -- If first operand not decisive, then it does matter if the right
2123 -- operand raises constraint error, since it will be evaluated, so
2124 -- we simply replace the node with the right operand. Note that this
2125 -- properly propagates Is_Static_Expression and Raises_Constraint_Error
2126 -- (both are set to True in Right).
2128 if Raises_Constraint_Error (Right) then
2129 Rewrite_In_Raise_CE (N, Right);
2130 Check_Non_Static_Context (Left);
2134 -- Otherwise the result depends on the right operand
2136 Fold_Uint (N, Expr_Value (Right));
2139 end Eval_Short_Circuit;
2145 -- Slices can never be static, so the only processing required is to
2146 -- check for non-static context if an explicit range is given.
2148 procedure Eval_Slice (N : Node_Id) is
2149 Drange : constant Node_Id := Discrete_Range (N);
2152 if Nkind (Drange) = N_Range then
2153 Check_Non_Static_Context (Low_Bound (Drange));
2154 Check_Non_Static_Context (High_Bound (Drange));
2158 -------------------------
2159 -- Eval_String_Literal --
2160 -------------------------
2162 procedure Eval_String_Literal (N : Node_Id) is
2163 T : constant Entity_Id := Etype (N);
2164 B : constant Entity_Id := Base_Type (T);
2168 -- Nothing to do if error type (handles cases like default expressions
2169 -- or generics where we have not yet fully resolved the type)
2171 if B = Any_Type or else B = Any_String then
2174 -- String literals are static if the subtype is static (RM 4.9(2)), so
2175 -- reset the static expression flag (it was set unconditionally in
2176 -- Analyze_String_Literal) if the subtype is non-static. We tell if
2177 -- the subtype is static by looking at the lower bound.
2179 elsif not Is_OK_Static_Expression (String_Literal_Low_Bound (T)) then
2180 Set_Is_Static_Expression (N, False);
2182 elsif Nkind (Original_Node (N)) = N_Type_Conversion then
2183 Set_Is_Static_Expression (N, False);
2185 -- Test for illegal Ada 95 cases. A string literal is illegal in
2186 -- Ada 95 if its bounds are outside the index base type and this
2187 -- index type is static. This can hapen in only two ways. Either
2188 -- the string literal is too long, or it is null, and the lower
2189 -- bound is type'First. In either case it is the upper bound that
2190 -- is out of range of the index type.
2193 if Root_Type (B) = Standard_String
2194 or else Root_Type (B) = Standard_Wide_String
2196 I := Standard_Positive;
2198 I := Etype (First_Index (B));
2201 if String_Literal_Length (T) > String_Type_Len (B) then
2202 Apply_Compile_Time_Constraint_Error
2203 (N, "string literal too long for}", CE_Length_Check_Failed,
2205 Typ => First_Subtype (B));
2207 elsif String_Literal_Length (T) = 0
2208 and then not Is_Generic_Type (I)
2209 and then Expr_Value (String_Literal_Low_Bound (T)) =
2210 Expr_Value (Type_Low_Bound (Base_Type (I)))
2212 Apply_Compile_Time_Constraint_Error
2213 (N, "null string literal not allowed for}",
2214 CE_Length_Check_Failed,
2216 Typ => First_Subtype (B));
2220 end Eval_String_Literal;
2222 --------------------------
2223 -- Eval_Type_Conversion --
2224 --------------------------
2226 -- A type conversion is potentially static if its subtype mark is for a
2227 -- static scalar subtype, and its operand expression is potentially static
2230 procedure Eval_Type_Conversion (N : Node_Id) is
2231 Operand : constant Node_Id := Expression (N);
2232 Source_Type : constant Entity_Id := Etype (Operand);
2233 Target_Type : constant Entity_Id := Etype (N);
2238 function To_Be_Treated_As_Integer (T : Entity_Id) return Boolean;
2239 -- Returns true if type T is an integer type, or if it is a
2240 -- fixed-point type to be treated as an integer (i.e. the flag
2241 -- Conversion_OK is set on the conversion node).
2243 function To_Be_Treated_As_Real (T : Entity_Id) return Boolean;
2244 -- Returns true if type T is a floating-point type, or if it is a
2245 -- fixed-point type that is not to be treated as an integer (i.e. the
2246 -- flag Conversion_OK is not set on the conversion node).
2248 function To_Be_Treated_As_Integer (T : Entity_Id) return Boolean is
2252 or else (Is_Fixed_Point_Type (T) and then Conversion_OK (N));
2253 end To_Be_Treated_As_Integer;
2255 function To_Be_Treated_As_Real (T : Entity_Id) return Boolean is
2258 Is_Floating_Point_Type (T)
2259 or else (Is_Fixed_Point_Type (T) and then not Conversion_OK (N));
2260 end To_Be_Treated_As_Real;
2262 -- Start of processing for Eval_Type_Conversion
2265 -- Cannot fold if target type is non-static or if semantic error.
2267 if not Is_Static_Subtype (Target_Type) then
2268 Check_Non_Static_Context (Operand);
2271 elsif Error_Posted (N) then
2275 -- If not foldable we are done
2277 Test_Expression_Is_Foldable (N, Operand, Stat, Fold);
2282 -- Don't try fold if target type has constraint error bounds
2284 elsif not Is_OK_Static_Subtype (Target_Type) then
2285 Set_Raises_Constraint_Error (N);
2289 -- Remaining processing depends on operand types. Note that in the
2290 -- following type test, fixed-point counts as real unless the flag
2291 -- Conversion_OK is set, in which case it counts as integer.
2293 -- Fold conversion, case of string type. The result is not static.
2295 if Is_String_Type (Target_Type) then
2296 Fold_Str (N, Strval (Get_String_Val (Operand)));
2297 Set_Is_Static_Expression (N, False);
2301 -- Fold conversion, case of integer target type
2303 elsif To_Be_Treated_As_Integer (Target_Type) then
2308 -- Integer to integer conversion
2310 if To_Be_Treated_As_Integer (Source_Type) then
2311 Result := Expr_Value (Operand);
2313 -- Real to integer conversion
2316 Result := UR_To_Uint (Expr_Value_R (Operand));
2319 -- If fixed-point type (Conversion_OK must be set), then the
2320 -- result is logically an integer, but we must replace the
2321 -- conversion with the corresponding real literal, since the
2322 -- type from a semantic point of view is still fixed-point.
2324 if Is_Fixed_Point_Type (Target_Type) then
2326 (N, UR_From_Uint (Result) * Small_Value (Target_Type));
2328 -- Otherwise result is integer literal
2331 Fold_Uint (N, Result);
2335 -- Fold conversion, case of real target type
2337 elsif To_Be_Treated_As_Real (Target_Type) then
2342 if To_Be_Treated_As_Real (Source_Type) then
2343 Result := Expr_Value_R (Operand);
2345 Result := UR_From_Uint (Expr_Value (Operand));
2348 Fold_Ureal (N, Result);
2351 -- Enumeration types
2354 Fold_Uint (N, Expr_Value (Operand));
2357 Set_Is_Static_Expression (N, Stat);
2359 if Is_Out_Of_Range (N, Etype (N)) then
2363 end Eval_Type_Conversion;
2369 -- Predefined unary operators are static functions (RM 4.9(20)) and thus
2370 -- are potentially static if the operand is potentially static (RM 4.9(7))
2372 procedure Eval_Unary_Op (N : Node_Id) is
2373 Right : constant Node_Id := Right_Opnd (N);
2378 -- If not foldable we are done
2380 Test_Expression_Is_Foldable (N, Right, Stat, Fold);
2386 -- Fold for integer case
2388 if Is_Integer_Type (Etype (N)) then
2390 Rint : constant Uint := Expr_Value (Right);
2394 -- In the case of modular unary plus and abs there is no need
2395 -- to adjust the result of the operation since if the original
2396 -- operand was in bounds the result will be in the bounds of the
2397 -- modular type. However, in the case of modular unary minus the
2398 -- result may go out of the bounds of the modular type and needs
2401 if Nkind (N) = N_Op_Plus then
2404 elsif Nkind (N) = N_Op_Minus then
2405 if Is_Modular_Integer_Type (Etype (N)) then
2406 Result := (-Rint) mod Modulus (Etype (N));
2412 pragma Assert (Nkind (N) = N_Op_Abs);
2416 Fold_Uint (N, Result);
2419 -- Fold for real case
2421 elsif Is_Real_Type (Etype (N)) then
2423 Rreal : constant Ureal := Expr_Value_R (Right);
2427 if Nkind (N) = N_Op_Plus then
2430 elsif Nkind (N) = N_Op_Minus then
2431 Result := UR_Negate (Rreal);
2434 pragma Assert (Nkind (N) = N_Op_Abs);
2435 Result := abs Rreal;
2438 Fold_Ureal (N, Result);
2442 Set_Is_Static_Expression (N, Stat);
2446 -------------------------------
2447 -- Eval_Unchecked_Conversion --
2448 -------------------------------
2450 -- Unchecked conversions can never be static, so the only required
2451 -- processing is to check for a non-static context for the operand.
2453 procedure Eval_Unchecked_Conversion (N : Node_Id) is
2455 Check_Non_Static_Context (Expression (N));
2456 end Eval_Unchecked_Conversion;
2458 --------------------
2459 -- Expr_Rep_Value --
2460 --------------------
2462 function Expr_Rep_Value (N : Node_Id) return Uint is
2463 Kind : constant Node_Kind := Nkind (N);
2467 if Is_Entity_Name (N) then
2470 -- An enumeration literal that was either in the source or
2471 -- created as a result of static evaluation.
2473 if Ekind (Ent) = E_Enumeration_Literal then
2474 return Enumeration_Rep (Ent);
2476 -- A user defined static constant
2479 pragma Assert (Ekind (Ent) = E_Constant);
2480 return Expr_Rep_Value (Constant_Value (Ent));
2483 -- An integer literal that was either in the source or created
2484 -- as a result of static evaluation.
2486 elsif Kind = N_Integer_Literal then
2489 -- A real literal for a fixed-point type. This must be the fixed-point
2490 -- case, either the literal is of a fixed-point type, or it is a bound
2491 -- of a fixed-point type, with type universal real. In either case we
2492 -- obtain the desired value from Corresponding_Integer_Value.
2494 elsif Kind = N_Real_Literal then
2495 pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N))));
2496 return Corresponding_Integer_Value (N);
2498 -- Peculiar VMS case, if we have xxx'Null_Parameter, return zero
2500 elsif Kind = N_Attribute_Reference
2501 and then Attribute_Name (N) = Name_Null_Parameter
2505 -- Otherwise must be character literal
2508 pragma Assert (Kind = N_Character_Literal);
2511 -- Since Character literals of type Standard.Character don't
2512 -- have any defining character literals built for them, they
2513 -- do not have their Entity set, so just use their Char
2514 -- code. Otherwise for user-defined character literals use
2515 -- their Pos value as usual which is the same as the Rep value.
2518 return UI_From_Int (Int (Char_Literal_Value (N)));
2520 return Enumeration_Rep (Ent);
2529 function Expr_Value (N : Node_Id) return Uint is
2530 Kind : constant Node_Kind := Nkind (N);
2531 CV_Ent : CV_Entry renames CV_Cache (Nat (N) mod CV_Cache_Size);
2536 -- If already in cache, then we know it's compile time known and
2537 -- we can return the value that was previously stored in the cache
2538 -- since compile time known values cannot change :-)
2540 if CV_Ent.N = N then
2544 -- Otherwise proceed to test value
2546 if Is_Entity_Name (N) then
2549 -- An enumeration literal that was either in the source or
2550 -- created as a result of static evaluation.
2552 if Ekind (Ent) = E_Enumeration_Literal then
2553 Val := Enumeration_Pos (Ent);
2555 -- A user defined static constant
2558 pragma Assert (Ekind (Ent) = E_Constant);
2559 Val := Expr_Value (Constant_Value (Ent));
2562 -- An integer literal that was either in the source or created
2563 -- as a result of static evaluation.
2565 elsif Kind = N_Integer_Literal then
2568 -- A real literal for a fixed-point type. This must be the fixed-point
2569 -- case, either the literal is of a fixed-point type, or it is a bound
2570 -- of a fixed-point type, with type universal real. In either case we
2571 -- obtain the desired value from Corresponding_Integer_Value.
2573 elsif Kind = N_Real_Literal then
2575 pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N))));
2576 Val := Corresponding_Integer_Value (N);
2578 -- Peculiar VMS case, if we have xxx'Null_Parameter, return zero
2580 elsif Kind = N_Attribute_Reference
2581 and then Attribute_Name (N) = Name_Null_Parameter
2585 -- Otherwise must be character literal
2588 pragma Assert (Kind = N_Character_Literal);
2591 -- Since Character literals of type Standard.Character don't
2592 -- have any defining character literals built for them, they
2593 -- do not have their Entity set, so just use their Char
2594 -- code. Otherwise for user-defined character literals use
2595 -- their Pos value as usual.
2598 Val := UI_From_Int (Int (Char_Literal_Value (N)));
2600 Val := Enumeration_Pos (Ent);
2604 -- Come here with Val set to value to be returned, set cache
2615 function Expr_Value_E (N : Node_Id) return Entity_Id is
2616 Ent : constant Entity_Id := Entity (N);
2619 if Ekind (Ent) = E_Enumeration_Literal then
2622 pragma Assert (Ekind (Ent) = E_Constant);
2623 return Expr_Value_E (Constant_Value (Ent));
2631 function Expr_Value_R (N : Node_Id) return Ureal is
2632 Kind : constant Node_Kind := Nkind (N);
2637 if Kind = N_Real_Literal then
2640 elsif Kind = N_Identifier or else Kind = N_Expanded_Name then
2642 pragma Assert (Ekind (Ent) = E_Constant);
2643 return Expr_Value_R (Constant_Value (Ent));
2645 elsif Kind = N_Integer_Literal then
2646 return UR_From_Uint (Expr_Value (N));
2648 -- Strange case of VAX literals, which are at this stage transformed
2649 -- into Vax_Type!x_To_y(IEEE_Literal). See Expand_N_Real_Literal in
2650 -- Exp_Vfpt for further details.
2652 elsif Vax_Float (Etype (N))
2653 and then Nkind (N) = N_Unchecked_Type_Conversion
2655 Expr := Expression (N);
2657 if Nkind (Expr) = N_Function_Call
2658 and then Present (Parameter_Associations (Expr))
2660 Expr := First (Parameter_Associations (Expr));
2662 if Nkind (Expr) = N_Real_Literal then
2663 return Realval (Expr);
2667 -- Peculiar VMS case, if we have xxx'Null_Parameter, return 0.0
2669 elsif Kind = N_Attribute_Reference
2670 and then Attribute_Name (N) = Name_Null_Parameter
2675 -- If we fall through, we have a node that cannot be interepreted
2676 -- as a compile time constant. That is definitely an error.
2678 raise Program_Error;
2685 function Expr_Value_S (N : Node_Id) return Node_Id is
2687 if Nkind (N) = N_String_Literal then
2690 pragma Assert (Ekind (Entity (N)) = E_Constant);
2691 return Expr_Value_S (Constant_Value (Entity (N)));
2699 procedure Fold_Str (N : Node_Id; Val : String_Id) is
2700 Loc : constant Source_Ptr := Sloc (N);
2701 Typ : constant Entity_Id := Etype (N);
2704 Rewrite (N, Make_String_Literal (Loc, Strval => Val));
2705 Analyze_And_Resolve (N, Typ);
2712 procedure Fold_Uint (N : Node_Id; Val : Uint) is
2713 Loc : constant Source_Ptr := Sloc (N);
2714 Typ : constant Entity_Id := Etype (N);
2717 -- For a result of type integer, subsitute an N_Integer_Literal node
2718 -- for the result of the compile time evaluation of the expression.
2720 if Is_Integer_Type (Etype (N)) then
2721 Rewrite (N, Make_Integer_Literal (Loc, Val));
2723 -- Otherwise we have an enumeration type, and we substitute either
2724 -- an N_Identifier or N_Character_Literal to represent the enumeration
2725 -- literal corresponding to the given value, which must always be in
2726 -- range, because appropriate tests have already been made for this.
2728 else pragma Assert (Is_Enumeration_Type (Etype (N)));
2729 Rewrite (N, Get_Enum_Lit_From_Pos (Etype (N), Val, Loc));
2732 -- We now have the literal with the right value, both the actual type
2733 -- and the expected type of this literal are taken from the expression
2734 -- that was evaluated.
2745 procedure Fold_Ureal (N : Node_Id; Val : Ureal) is
2746 Loc : constant Source_Ptr := Sloc (N);
2747 Typ : constant Entity_Id := Etype (N);
2750 Rewrite (N, Make_Real_Literal (Loc, Realval => Val));
2753 -- Both the actual and expected type comes from the original expression
2763 function From_Bits (B : Bits; T : Entity_Id) return Uint is
2767 for J in 0 .. B'Last loop
2773 if Non_Binary_Modulus (T) then
2774 V := V mod Modulus (T);
2780 --------------------
2781 -- Get_String_Val --
2782 --------------------
2784 function Get_String_Val (N : Node_Id) return Node_Id is
2786 if Nkind (N) = N_String_Literal then
2789 elsif Nkind (N) = N_Character_Literal then
2793 pragma Assert (Is_Entity_Name (N));
2794 return Get_String_Val (Constant_Value (Entity (N)));
2798 --------------------
2799 -- In_Subrange_Of --
2800 --------------------
2802 function In_Subrange_Of
2805 Fixed_Int : Boolean := False)
2815 if T1 = T2 or else Is_Subtype_Of (T1, T2) then
2818 -- Never in range if both types are not scalar. Don't know if this can
2819 -- actually happen, but just in case.
2821 elsif not Is_Scalar_Type (T1) or else not Is_Scalar_Type (T1) then
2825 L1 := Type_Low_Bound (T1);
2826 H1 := Type_High_Bound (T1);
2828 L2 := Type_Low_Bound (T2);
2829 H2 := Type_High_Bound (T2);
2831 -- Check bounds to see if comparison possible at compile time
2833 if Compile_Time_Compare (L1, L2) in Compare_GE
2835 Compile_Time_Compare (H1, H2) in Compare_LE
2840 -- If bounds not comparable at compile time, then the bounds of T2
2841 -- must be compile time known or we cannot answer the query.
2843 if not Compile_Time_Known_Value (L2)
2844 or else not Compile_Time_Known_Value (H2)
2849 -- If the bounds of T1 are know at compile time then use these
2850 -- ones, otherwise use the bounds of the base type (which are of
2851 -- course always static).
2853 if not Compile_Time_Known_Value (L1) then
2854 L1 := Type_Low_Bound (Base_Type (T1));
2857 if not Compile_Time_Known_Value (H1) then
2858 H1 := Type_High_Bound (Base_Type (T1));
2861 -- Fixed point types should be considered as such only if
2862 -- flag Fixed_Int is set to False.
2864 if Is_Floating_Point_Type (T1) or else Is_Floating_Point_Type (T2)
2865 or else (Is_Fixed_Point_Type (T1) and then not Fixed_Int)
2866 or else (Is_Fixed_Point_Type (T2) and then not Fixed_Int)
2869 Expr_Value_R (L2) <= Expr_Value_R (L1)
2871 Expr_Value_R (H2) >= Expr_Value_R (H1);
2875 Expr_Value (L2) <= Expr_Value (L1)
2877 Expr_Value (H2) >= Expr_Value (H1);
2882 -- If any exception occurs, it means that we have some bug in the compiler
2883 -- possibly triggered by a previous error, or by some unforseen peculiar
2884 -- occurrence. However, this is only an optimization attempt, so there is
2885 -- really no point in crashing the compiler. Instead we just decide, too
2886 -- bad, we can't figure out the answer in this case after all.
2891 -- Debug flag K disables this behavior (useful for debugging)
2893 if Debug_Flag_K then
2904 function Is_In_Range
2907 Fixed_Int : Boolean := False;
2908 Int_Real : Boolean := False)
2915 -- Universal types have no range limits, so always in range.
2917 if Typ = Universal_Integer or else Typ = Universal_Real then
2920 -- Never in range if not scalar type. Don't know if this can
2921 -- actually happen, but our spec allows it, so we must check!
2923 elsif not Is_Scalar_Type (Typ) then
2926 -- Never in range unless we have a compile time known value.
2928 elsif not Compile_Time_Known_Value (N) then
2933 Lo : constant Node_Id := Type_Low_Bound (Typ);
2934 Hi : constant Node_Id := Type_High_Bound (Typ);
2935 LB_Known : constant Boolean := Compile_Time_Known_Value (Lo);
2936 UB_Known : constant Boolean := Compile_Time_Known_Value (Hi);
2939 -- Fixed point types should be considered as such only in
2940 -- flag Fixed_Int is set to False.
2942 if Is_Floating_Point_Type (Typ)
2943 or else (Is_Fixed_Point_Type (Typ) and then not Fixed_Int)
2946 Valr := Expr_Value_R (N);
2948 if LB_Known and then Valr >= Expr_Value_R (Lo)
2949 and then UB_Known and then Valr <= Expr_Value_R (Hi)
2957 Val := Expr_Value (N);
2959 if LB_Known and then Val >= Expr_Value (Lo)
2960 and then UB_Known and then Val <= Expr_Value (Hi)
2975 function Is_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean is
2976 Typ : constant Entity_Id := Etype (Lo);
2979 if not Compile_Time_Known_Value (Lo)
2980 or else not Compile_Time_Known_Value (Hi)
2985 if Is_Discrete_Type (Typ) then
2986 return Expr_Value (Lo) > Expr_Value (Hi);
2989 pragma Assert (Is_Real_Type (Typ));
2990 return Expr_Value_R (Lo) > Expr_Value_R (Hi);
2994 -----------------------------
2995 -- Is_OK_Static_Expression --
2996 -----------------------------
2998 function Is_OK_Static_Expression (N : Node_Id) return Boolean is
3000 return Is_Static_Expression (N)
3001 and then not Raises_Constraint_Error (N);
3002 end Is_OK_Static_Expression;
3004 ------------------------
3005 -- Is_OK_Static_Range --
3006 ------------------------
3008 -- A static range is a range whose bounds are static expressions, or a
3009 -- Range_Attribute_Reference equivalent to such a range (RM 4.9(26)).
3010 -- We have already converted range attribute references, so we get the
3011 -- "or" part of this rule without needing a special test.
3013 function Is_OK_Static_Range (N : Node_Id) return Boolean is
3015 return Is_OK_Static_Expression (Low_Bound (N))
3016 and then Is_OK_Static_Expression (High_Bound (N));
3017 end Is_OK_Static_Range;
3019 --------------------------
3020 -- Is_OK_Static_Subtype --
3021 --------------------------
3023 -- Determines if Typ is a static subtype as defined in (RM 4.9(26))
3024 -- where neither bound raises constraint error when evaluated.
3026 function Is_OK_Static_Subtype (Typ : Entity_Id) return Boolean is
3027 Base_T : constant Entity_Id := Base_Type (Typ);
3028 Anc_Subt : Entity_Id;
3031 -- First a quick check on the non static subtype flag. As described
3032 -- in further detail in Einfo, this flag is not decisive in all cases,
3033 -- but if it is set, then the subtype is definitely non-static.
3035 if Is_Non_Static_Subtype (Typ) then
3039 Anc_Subt := Ancestor_Subtype (Typ);
3041 if Anc_Subt = Empty then
3045 if Is_Generic_Type (Root_Type (Base_T))
3046 or else Is_Generic_Actual_Type (Base_T)
3052 elsif Is_String_Type (Typ) then
3054 Ekind (Typ) = E_String_Literal_Subtype
3056 (Is_OK_Static_Subtype (Component_Type (Typ))
3057 and then Is_OK_Static_Subtype (Etype (First_Index (Typ))));
3061 elsif Is_Scalar_Type (Typ) then
3062 if Base_T = Typ then
3066 -- Scalar_Range (Typ) might be an N_Subtype_Indication, so
3067 -- use Get_Type_Low,High_Bound.
3069 return Is_OK_Static_Subtype (Anc_Subt)
3070 and then Is_OK_Static_Expression (Type_Low_Bound (Typ))
3071 and then Is_OK_Static_Expression (Type_High_Bound (Typ));
3074 -- Types other than string and scalar types are never static
3079 end Is_OK_Static_Subtype;
3081 ---------------------
3082 -- Is_Out_Of_Range --
3083 ---------------------
3085 function Is_Out_Of_Range
3088 Fixed_Int : Boolean := False;
3089 Int_Real : Boolean := False)
3096 -- Universal types have no range limits, so always in range.
3098 if Typ = Universal_Integer or else Typ = Universal_Real then
3101 -- Never out of range if not scalar type. Don't know if this can
3102 -- actually happen, but our spec allows it, so we must check!
3104 elsif not Is_Scalar_Type (Typ) then
3107 -- Never out of range if this is a generic type, since the bounds
3108 -- of generic types are junk. Note that if we only checked for
3109 -- static expressions (instead of compile time known values) below,
3110 -- we would not need this check, because values of a generic type
3111 -- can never be static, but they can be known at compile time.
3113 elsif Is_Generic_Type (Typ) then
3116 -- Never out of range unless we have a compile time known value.
3118 elsif not Compile_Time_Known_Value (N) then
3123 Lo : constant Node_Id := Type_Low_Bound (Typ);
3124 Hi : constant Node_Id := Type_High_Bound (Typ);
3125 LB_Known : constant Boolean := Compile_Time_Known_Value (Lo);
3126 UB_Known : constant Boolean := Compile_Time_Known_Value (Hi);
3129 -- Real types (note that fixed-point types are not treated
3130 -- as being of a real type if the flag Fixed_Int is set,
3131 -- since in that case they are regarded as integer types).
3133 if Is_Floating_Point_Type (Typ)
3134 or else (Is_Fixed_Point_Type (Typ) and then not Fixed_Int)
3137 Valr := Expr_Value_R (N);
3139 if LB_Known and then Valr < Expr_Value_R (Lo) then
3142 elsif UB_Known and then Expr_Value_R (Hi) < Valr then
3150 Val := Expr_Value (N);
3152 if LB_Known and then Val < Expr_Value (Lo) then
3155 elsif UB_Known and then Expr_Value (Hi) < Val then
3164 end Is_Out_Of_Range;
3166 ---------------------
3167 -- Is_Static_Range --
3168 ---------------------
3170 -- A static range is a range whose bounds are static expressions, or a
3171 -- Range_Attribute_Reference equivalent to such a range (RM 4.9(26)).
3172 -- We have already converted range attribute references, so we get the
3173 -- "or" part of this rule without needing a special test.
3175 function Is_Static_Range (N : Node_Id) return Boolean is
3177 return Is_Static_Expression (Low_Bound (N))
3178 and then Is_Static_Expression (High_Bound (N));
3179 end Is_Static_Range;
3181 -----------------------
3182 -- Is_Static_Subtype --
3183 -----------------------
3185 -- Determines if Typ is a static subtype as defined in (RM 4.9(26)).
3187 function Is_Static_Subtype (Typ : Entity_Id) return Boolean is
3188 Base_T : constant Entity_Id := Base_Type (Typ);
3189 Anc_Subt : Entity_Id;
3192 -- First a quick check on the non static subtype flag. As described
3193 -- in further detail in Einfo, this flag is not decisive in all cases,
3194 -- but if it is set, then the subtype is definitely non-static.
3196 if Is_Non_Static_Subtype (Typ) then
3200 Anc_Subt := Ancestor_Subtype (Typ);
3202 if Anc_Subt = Empty then
3206 if Is_Generic_Type (Root_Type (Base_T))
3207 or else Is_Generic_Actual_Type (Base_T)
3213 elsif Is_String_Type (Typ) then
3215 Ekind (Typ) = E_String_Literal_Subtype
3217 (Is_Static_Subtype (Component_Type (Typ))
3218 and then Is_Static_Subtype (Etype (First_Index (Typ))));
3222 elsif Is_Scalar_Type (Typ) then
3223 if Base_T = Typ then
3227 return Is_Static_Subtype (Anc_Subt)
3228 and then Is_Static_Expression (Type_Low_Bound (Typ))
3229 and then Is_Static_Expression (Type_High_Bound (Typ));
3232 -- Types other than string and scalar types are never static
3237 end Is_Static_Subtype;
3239 --------------------
3240 -- Not_Null_Range --
3241 --------------------
3243 function Not_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean is
3244 Typ : constant Entity_Id := Etype (Lo);
3247 if not Compile_Time_Known_Value (Lo)
3248 or else not Compile_Time_Known_Value (Hi)
3253 if Is_Discrete_Type (Typ) then
3254 return Expr_Value (Lo) <= Expr_Value (Hi);
3257 pragma Assert (Is_Real_Type (Typ));
3259 return Expr_Value_R (Lo) <= Expr_Value_R (Hi);
3267 function OK_Bits (N : Node_Id; Bits : Uint) return Boolean is
3269 -- We allow a maximum of 500,000 bits which seems a reasonable limit
3271 if Bits < 500_000 then
3275 Error_Msg_N ("static value too large, capacity exceeded", N);
3284 procedure Out_Of_Range (N : Node_Id) is
3286 -- If we have the static expression case, then this is an illegality
3287 -- in Ada 95 mode, except that in an instance, we never generate an
3288 -- error (if the error is legitimate, it was already diagnosed in
3289 -- the template). The expression to compute the length of a packed
3290 -- array is attached to the array type itself, and deserves a separate
3293 if Is_Static_Expression (N)
3294 and then not In_Instance
3298 if Nkind (Parent (N)) = N_Defining_Identifier
3299 and then Is_Array_Type (Parent (N))
3300 and then Present (Packed_Array_Type (Parent (N)))
3301 and then Present (First_Rep_Item (Parent (N)))
3304 ("length of packed array must not exceed Integer''Last",
3305 First_Rep_Item (Parent (N)));
3306 Rewrite (N, Make_Integer_Literal (Sloc (N), Uint_1));
3309 Apply_Compile_Time_Constraint_Error
3310 (N, "value not in range of}", CE_Range_Check_Failed);
3313 -- Here we generate a warning for the Ada 83 case, or when we are
3314 -- in an instance, or when we have a non-static expression case.
3317 Warn_On_Instance := True;
3318 Apply_Compile_Time_Constraint_Error
3319 (N, "value not in range of}?", CE_Range_Check_Failed);
3320 Warn_On_Instance := False;
3324 -------------------------
3325 -- Rewrite_In_Raise_CE --
3326 -------------------------
3328 procedure Rewrite_In_Raise_CE (N : Node_Id; Exp : Node_Id) is
3329 Typ : constant Entity_Id := Etype (N);
3332 -- If we want to raise CE in the condition of a raise_CE node
3333 -- we may as well get rid of the condition
3335 if Present (Parent (N))
3336 and then Nkind (Parent (N)) = N_Raise_Constraint_Error
3338 Set_Condition (Parent (N), Empty);
3340 -- If the expression raising CE is a N_Raise_CE node, we can use
3341 -- that one. We just preserve the type of the context
3343 elsif Nkind (Exp) = N_Raise_Constraint_Error then
3347 -- We have to build an explicit raise_ce node
3351 Make_Raise_Constraint_Error (Sloc (Exp),
3352 Reason => CE_Range_Check_Failed));
3353 Set_Raises_Constraint_Error (N);
3356 end Rewrite_In_Raise_CE;
3358 ---------------------
3359 -- String_Type_Len --
3360 ---------------------
3362 function String_Type_Len (Stype : Entity_Id) return Uint is
3363 NT : constant Entity_Id := Etype (First_Index (Stype));
3367 if Is_OK_Static_Subtype (NT) then
3370 T := Base_Type (NT);
3373 return Expr_Value (Type_High_Bound (T)) -
3374 Expr_Value (Type_Low_Bound (T)) + 1;
3375 end String_Type_Len;
3377 ------------------------------------
3378 -- Subtypes_Statically_Compatible --
3379 ------------------------------------
3381 function Subtypes_Statically_Compatible
3387 if Is_Scalar_Type (T1) then
3389 -- Definitely compatible if we match
3391 if Subtypes_Statically_Match (T1, T2) then
3394 -- If either subtype is nonstatic then they're not compatible
3396 elsif not Is_Static_Subtype (T1)
3397 or else not Is_Static_Subtype (T2)
3401 -- If either type has constraint error bounds, then consider that
3402 -- they match to avoid junk cascaded errors here.
3404 elsif not Is_OK_Static_Subtype (T1)
3405 or else not Is_OK_Static_Subtype (T2)
3409 -- Base types must match, but we don't check that (should
3410 -- we???) but we do at least check that both types are
3411 -- real, or both types are not real.
3413 elsif (Is_Real_Type (T1) /= Is_Real_Type (T2)) then
3416 -- Here we check the bounds
3420 LB1 : constant Node_Id := Type_Low_Bound (T1);
3421 HB1 : constant Node_Id := Type_High_Bound (T1);
3422 LB2 : constant Node_Id := Type_Low_Bound (T2);
3423 HB2 : constant Node_Id := Type_High_Bound (T2);
3426 if Is_Real_Type (T1) then
3428 (Expr_Value_R (LB1) > Expr_Value_R (HB1))
3430 (Expr_Value_R (LB2) <= Expr_Value_R (LB1)
3432 Expr_Value_R (HB1) <= Expr_Value_R (HB2));
3436 (Expr_Value (LB1) > Expr_Value (HB1))
3438 (Expr_Value (LB2) <= Expr_Value (LB1)
3440 Expr_Value (HB1) <= Expr_Value (HB2));
3445 elsif Is_Access_Type (T1) then
3446 return not Is_Constrained (T2)
3447 or else Subtypes_Statically_Match
3448 (Designated_Type (T1), Designated_Type (T2));
3451 return (Is_Composite_Type (T1) and then not Is_Constrained (T2))
3452 or else Subtypes_Statically_Match (T1, T2);
3454 end Subtypes_Statically_Compatible;
3456 -------------------------------
3457 -- Subtypes_Statically_Match --
3458 -------------------------------
3460 -- Subtypes statically match if they have statically matching constraints
3461 -- (RM 4.9.1(2)). Constraints statically match if there are none, or if
3462 -- they are the same identical constraint, or if they are static and the
3463 -- values match (RM 4.9.1(1)).
3465 function Subtypes_Statically_Match (T1, T2 : Entity_Id) return Boolean is
3467 -- A type always statically matches itself
3474 elsif Is_Scalar_Type (T1) then
3476 -- Base types must be the same
3478 if Base_Type (T1) /= Base_Type (T2) then
3482 -- A constrained numeric subtype never matches an unconstrained
3483 -- subtype, i.e. both types must be constrained or unconstrained.
3485 -- To understand the requirement for this test, see RM 4.9.1(1).
3486 -- As is made clear in RM 3.5.4(11), type Integer, for example
3487 -- is a constrained subtype with constraint bounds matching the
3488 -- bounds of its corresponding uncontrained base type. In this
3489 -- situation, Integer and Integer'Base do not statically match,
3490 -- even though they have the same bounds.
3492 -- We only apply this test to types in Standard and types that
3493 -- appear in user programs. That way, we do not have to be
3494 -- too careful about setting Is_Constrained right for itypes.
3496 if Is_Numeric_Type (T1)
3497 and then (Is_Constrained (T1) /= Is_Constrained (T2))
3498 and then (Scope (T1) = Standard_Standard
3499 or else Comes_From_Source (T1))
3500 and then (Scope (T2) = Standard_Standard
3501 or else Comes_From_Source (T2))
3506 -- If there was an error in either range, then just assume
3507 -- the types statically match to avoid further junk errors
3509 if Error_Posted (Scalar_Range (T1))
3511 Error_Posted (Scalar_Range (T2))
3516 -- Otherwise both types have bound that can be compared
3519 LB1 : constant Node_Id := Type_Low_Bound (T1);
3520 HB1 : constant Node_Id := Type_High_Bound (T1);
3521 LB2 : constant Node_Id := Type_Low_Bound (T2);
3522 HB2 : constant Node_Id := Type_High_Bound (T2);
3525 -- If the bounds are the same tree node, then match
3527 if LB1 = LB2 and then HB1 = HB2 then
3530 -- Otherwise bounds must be static and identical value
3533 if not Is_Static_Subtype (T1)
3534 or else not Is_Static_Subtype (T2)
3538 -- If either type has constraint error bounds, then say
3539 -- that they match to avoid junk cascaded errors here.
3541 elsif not Is_OK_Static_Subtype (T1)
3542 or else not Is_OK_Static_Subtype (T2)
3546 elsif Is_Real_Type (T1) then
3548 (Expr_Value_R (LB1) = Expr_Value_R (LB2))
3550 (Expr_Value_R (HB1) = Expr_Value_R (HB2));
3554 Expr_Value (LB1) = Expr_Value (LB2)
3556 Expr_Value (HB1) = Expr_Value (HB2);
3561 -- Type with discriminants
3563 elsif Has_Discriminants (T1) or else Has_Discriminants (T2) then
3564 if Has_Discriminants (T1) /= Has_Discriminants (T2) then
3569 DL1 : constant Elist_Id := Discriminant_Constraint (T1);
3570 DL2 : constant Elist_Id := Discriminant_Constraint (T2);
3572 DA1 : Elmt_Id := First_Elmt (DL1);
3573 DA2 : Elmt_Id := First_Elmt (DL2);
3579 elsif Is_Constrained (T1) /= Is_Constrained (T2) then
3583 while Present (DA1) loop
3585 Expr1 : constant Node_Id := Node (DA1);
3586 Expr2 : constant Node_Id := Node (DA2);
3589 if not Is_Static_Expression (Expr1)
3590 or else not Is_Static_Expression (Expr2)
3594 -- If either expression raised a constraint error,
3595 -- consider the expressions as matching, since this
3596 -- helps to prevent cascading errors.
3598 elsif Raises_Constraint_Error (Expr1)
3599 or else Raises_Constraint_Error (Expr2)
3603 elsif Expr_Value (Expr1) /= Expr_Value (Expr2) then
3615 -- A definite type does not match an indefinite or classwide type.
3618 Has_Unknown_Discriminants (T1) /= Has_Unknown_Discriminants (T2)
3624 elsif Is_Array_Type (T1) then
3626 -- If either subtype is unconstrained then both must be,
3627 -- and if both are unconstrained then no further checking
3630 if not Is_Constrained (T1) or else not Is_Constrained (T2) then
3631 return not (Is_Constrained (T1) or else Is_Constrained (T2));
3634 -- Both subtypes are constrained, so check that the index
3635 -- subtypes statically match.
3638 Index1 : Node_Id := First_Index (T1);
3639 Index2 : Node_Id := First_Index (T2);
3642 while Present (Index1) loop
3644 Subtypes_Statically_Match (Etype (Index1), Etype (Index2))
3649 Next_Index (Index1);
3650 Next_Index (Index2);
3656 elsif Is_Access_Type (T1) then
3657 return Subtypes_Statically_Match
3658 (Designated_Type (T1),
3659 Designated_Type (T2));
3661 -- All other types definitely match
3666 end Subtypes_Statically_Match;
3672 function Test (Cond : Boolean) return Uint is
3681 ---------------------------------
3682 -- Test_Expression_Is_Foldable --
3683 ---------------------------------
3687 procedure Test_Expression_Is_Foldable
3696 -- If operand is Any_Type, just propagate to result and do not
3697 -- try to fold, this prevents cascaded errors.
3699 if Etype (Op1) = Any_Type then
3700 Set_Etype (N, Any_Type);
3704 -- If operand raises constraint error, then replace node N with the
3705 -- raise constraint error node, and we are obviously not foldable.
3706 -- Note that this replacement inherits the Is_Static_Expression flag
3707 -- from the operand.
3709 elsif Raises_Constraint_Error (Op1) then
3710 Rewrite_In_Raise_CE (N, Op1);
3714 -- If the operand is not static, then the result is not static, and
3715 -- all we have to do is to check the operand since it is now known
3716 -- to appear in a non-static context.
3718 elsif not Is_Static_Expression (Op1) then
3719 Check_Non_Static_Context (Op1);
3720 Fold := Compile_Time_Known_Value (Op1);
3723 -- An expression of a formal modular type is not foldable because
3724 -- the modulus is unknown.
3726 elsif Is_Modular_Integer_Type (Etype (Op1))
3727 and then Is_Generic_Type (Etype (Op1))
3729 Check_Non_Static_Context (Op1);
3733 -- Here we have the case of an operand whose type is OK, which is
3734 -- static, and which does not raise constraint error, we can fold.
3737 Set_Is_Static_Expression (N);
3741 end Test_Expression_Is_Foldable;
3745 procedure Test_Expression_Is_Foldable
3752 Rstat : constant Boolean := Is_Static_Expression (Op1)
3753 and then Is_Static_Expression (Op2);
3758 -- If either operand is Any_Type, just propagate to result and
3759 -- do not try to fold, this prevents cascaded errors.
3761 if Etype (Op1) = Any_Type or else Etype (Op2) = Any_Type then
3762 Set_Etype (N, Any_Type);
3766 -- If left operand raises constraint error, then replace node N with
3767 -- the raise constraint error node, and we are obviously not foldable.
3768 -- Is_Static_Expression is set from the two operands in the normal way,
3769 -- and we check the right operand if it is in a non-static context.
3771 elsif Raises_Constraint_Error (Op1) then
3773 Check_Non_Static_Context (Op2);
3776 Rewrite_In_Raise_CE (N, Op1);
3777 Set_Is_Static_Expression (N, Rstat);
3781 -- Similar processing for the case of the right operand. Note that
3782 -- we don't use this routine for the short-circuit case, so we do
3783 -- not have to worry about that special case here.
3785 elsif Raises_Constraint_Error (Op2) then
3787 Check_Non_Static_Context (Op1);
3790 Rewrite_In_Raise_CE (N, Op2);
3791 Set_Is_Static_Expression (N, Rstat);
3795 -- Exclude expressions of a generic modular type, as above.
3797 elsif Is_Modular_Integer_Type (Etype (Op1))
3798 and then Is_Generic_Type (Etype (Op1))
3800 Check_Non_Static_Context (Op1);
3804 -- If result is not static, then check non-static contexts on operands
3805 -- since one of them may be static and the other one may not be static
3807 elsif not Rstat then
3808 Check_Non_Static_Context (Op1);
3809 Check_Non_Static_Context (Op2);
3810 Fold := Compile_Time_Known_Value (Op1)
3811 and then Compile_Time_Known_Value (Op2);
3814 -- Else result is static and foldable. Both operands are static,
3815 -- and neither raises constraint error, so we can definitely fold.
3818 Set_Is_Static_Expression (N);
3823 end Test_Expression_Is_Foldable;
3829 procedure To_Bits (U : Uint; B : out Bits) is
3831 for J in 0 .. B'Last loop
3832 B (J) := (U / (2 ** J)) mod 2 /= 0;