Typ : Entity_Id;
Target : Node_Id) return List_Id;
-- This routine implements top-down expansion of nested aggregates. In
- -- doing so, it avoids the generation of temporaries at each level. N is a
- -- nested (record or array) aggregate that has been marked with Expansion_
- -- Delayed. Typ is the expected type of the aggregate. Target is a
- -- (duplicable) expression that will hold the result of the aggregate
- -- expansion.
+ -- doing so, it avoids the generation of temporaries at each level. N is
+ -- a nested record or array aggregate with the Expansion_Delayed flag.
+ -- Typ is the expected type of the aggregate. Target is a (duplicatable)
+ -- expression that will hold the result of the aggregate expansion.
function Make_OK_Assignment_Statement
(Sloc : Source_Ptr;
Name : Node_Id;
Expression : Node_Id) return Node_Id;
-- This is like Make_Assignment_Statement, except that Assignment_OK
- -- is set in the left operand. All assignments built by this unit
- -- use this routine. This is needed to deal with assignments to
- -- initialized constants that are done in place.
+ -- is set in the left operand. All assignments built by this unit use
+ -- this routine. This is needed to deal with assignments to initialized
+ -- constants that are done in place.
function Number_Of_Choices (N : Node_Id) return Nat;
-- Returns the number of discrete choices (not including the others choice
-- array aggregate with all constant values, where the aggregate can be
-- evaluated at compile time. If this is possible, then N is rewritten
-- to be its proper compile time value with all the components properly
- -- assembled. The expression is analyzed and resolved and True is
- -- returned. If this transformation is not possible, N is unchanged
- -- and False is returned
+ -- assembled. The expression is analyzed and resolved and True is returned.
+ -- If this transformation is not possible, N is unchanged and False is
+ -- returned.
function Safe_Slice_Assignment (N : Node_Id) return Boolean;
-- If a slice assignment has an aggregate with a single others_choice,
Hi : constant Node_Id :=
Type_High_Bound (Etype (First_Index (T)));
- Siz : constant Int := Component_Count (Component_Type (T));
+ Siz : constant Int := Component_Count (Component_Type (T));
begin
if not Compile_Time_Known_Value (Lo)
-- and the aggregate can be constructed statically and handled by
-- the back-end.
+ function Compile_Time_Known_Composite_Value (N : Node_Id) return Boolean;
+ -- Returns true if N is an expression of composite type which can be
+ -- fully evaluated at compile time without raising constraint error.
+ -- Such expressions can be passed as is to Gigi without any expansion.
+ --
+ -- This returns true for N_Aggregate with Compile_Time_Known_Aggregate
+ -- set and constants whose expression is such an aggregate, recursively.
+
function Component_Not_OK_For_Backend return Boolean;
-- Check for presence of component which makes it impossible for the
-- backend to process the aggregate, thus requiring the use of a series
-- For nested aggregates return the ultimate enclosing aggregate; for
-- non-nested aggregates return N.
+ ----------------------------------------
+ -- Compile_Time_Known_Composite_Value --
+ ----------------------------------------
+
+ function Compile_Time_Known_Composite_Value
+ (N : Node_Id) return Boolean
+ is
+ begin
+ -- If we have an entity name, then see if it is the name of a
+ -- constant and if so, test the corresponding constant value.
+
+ if Is_Entity_Name (N) then
+ declare
+ E : constant Entity_Id := Entity (N);
+ V : Node_Id;
+ begin
+ if Ekind (E) /= E_Constant then
+ return False;
+ else
+ V := Constant_Value (E);
+ return Present (V)
+ and then Compile_Time_Known_Composite_Value (V);
+ end if;
+ end;
+
+ -- We have a value, see if it is compile time known
+
+ else
+ if Nkind (N) = N_Aggregate then
+ return Compile_Time_Known_Aggregate (N);
+ end if;
+
+ -- All other types of values are not known at compile time
+
+ return False;
+ end if;
+
+ end Compile_Time_Known_Composite_Value;
+
----------------------------------
-- Component_Not_OK_For_Backend --
----------------------------------
return True;
end if;
- if Is_Scalar_Type (Etype (Expr_Q)) then
+ if Is_Elementary_Type (Etype (Expr_Q)) then
if not Compile_Time_Known_Value (Expr_Q) then
Static_Components := False;
end if;
- elsif Nkind (Expr_Q) /= N_Aggregate
- or else not Compile_Time_Known_Aggregate (Expr_Q)
- then
+ elsif not Compile_Time_Known_Composite_Value (Expr_Q) then
Static_Components := False;
if Is_Private_Type (Etype (Expr_Q))
elsif Component_Not_OK_For_Backend then
Convert_To_Assignments (N, Typ);
- -- If an ancestor is private, some components are not inherited and
- -- we cannot expand into a record aggregate
+ -- If an ancestor is private, some components are not inherited and we
+ -- cannot expand into a record aggregate.
elsif Has_Visible_Private_Ancestor (Typ) then
Convert_To_Assignments (N, Typ);
-- may be distinct from the default size of the type component, so
-- we need to expand to insure that the back-end copies the proper
-- size of the data. However, if the aggregate is the initial value of
- -- a constant, the target is immutable and may be built statically.
+ -- a constant, the target is immutable and might be built statically
+ -- if components are appropriate.
elsif Has_Mutable_Components (Typ)
and then
(Nkind (Parent (Top_Level_Aggr)) /= N_Object_Declaration
- or else not Constant_Present (Parent (Top_Level_Aggr)))
+ or else not Constant_Present (Parent (Top_Level_Aggr))
+ or else not Static_Components)
then
Convert_To_Assignments (N, Typ);
elsif Is_Derived_Type (Typ) then
- -- For untagged types, non-stored discriminants are replaced
+ -- For untagged types, non-stored discriminants are replaced
-- with stored discriminants, which are the ones that gigi uses
-- to describe the type and its components.
if Present (Orig_Tag) then
Tag_Value := Orig_Tag;
-
elsif not Tagged_Type_Expansion then
Tag_Value := Empty;
-
else
Tag_Value :=
New_Occurrence_Of
Expand_Record_Aggregate
(Parent_Aggr, Tag_Value, Parent_Expr);
+
+ -- The ancestor part may be a nested aggregate that has
+ -- delayed expansion: recheck now.
+
+ if Component_Not_OK_For_Backend then
+ Convert_To_Assignments (N, Typ);
+ end if;
end;
-- For a root type, the tag component is added (unless compiling
OSDN Git Service
