@@ -4216,84 +4216,152 @@ package body Exp_Aggr is
procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
- Aggr_Code : List_Id;
- Full_Typ : Entity_Id;
- Instr : Node_Id;
- Parent_Kind : Node_Kind;
- Parent_Node : Node_Id;
- Target_Expr : Node_Id;
- Temp : Entity_Id;
- Unc_Decl : Boolean := False;
+ function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean;
+ -- Decl is an N_Object_Declaration node. Return true if it declares an
+ -- object with a known size; in this context, that is always the case,
+ -- except for a declaration without explicit constraints of an object,
+ -- either whose nominal subtype is class-wide, or whose initialization
+ -- contains a conditional expression and whose nominal subtype is both
+ -- discriminated and unconstrained.
+
+ ----------------
+ -- Known_Size --
+ ----------------
+
+ function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean
+ is
+ begin
+ if Is_Entity_Name (Object_Definition (Decl)) then
+ declare
+ Typ : constant Entity_Id := Entity (Object_Definition (Decl));
+
+ begin
+ return not Is_Class_Wide_Type (Typ)
+ and then not (Cond_Init
+ and then Has_Discriminants (Typ)
+ and then not Is_Constrained (Typ));
+ end;
+
+ else
+ return True;
+ end if;
+ end Known_Size;
+
+ -- Local variables
+
+ Aggr_Code : List_Id;
+ Full_Typ : Entity_Id;
+ In_Cond_Expr : Boolean;
+ Instr : Node_Id;
+ Node : Node_Id;
+ Parent_Node : Node_Id;
+ Target_Expr : Node_Id;
+ Temp : Entity_Id;
+
+ -- Start of processing for Convert_To_Assignments
begin
pragma Assert (Nkind (N) in N_Aggregate | N_Extension_Aggregate);
pragma Assert (not Is_Static_Dispatch_Table_Aggregate (N));
pragma Assert (Is_Record_Type (Typ));
- Parent_Node := Parent (N);
- Parent_Kind := Nkind (Parent_Node);
+ In_Cond_Expr := False;
+ Node := N;
+ Parent_Node := Parent (Node);
- if Parent_Kind = N_Qualified_Expression then
- -- Check if we are in an unconstrained declaration because in this
- -- case the current delayed expansion mechanism doesn't work when
- -- the declared object size depends on the initializing expr.
+ -- First, climb the parent chain, looking through qualified expressions
+ -- and dependent expressions of conditional expressions.
- Parent_Node := Parent (Parent_Node);
- Parent_Kind := Nkind (Parent_Node);
+ while True loop
+ case Nkind (Parent_Node) is
+ when N_Case_Expression_Alternative =>
+ null;
- if Parent_Kind = N_Object_Declaration then
- Unc_Decl :=
- not Is_Entity_Name (Object_Definition (Parent_Node))
- or else (Nkind (N) = N_Aggregate
- and then
- Has_Discriminants
- (Entity (Object_Definition (Parent_Node))))
- or else Is_Class_Wide_Type
- (Entity (Object_Definition (Parent_Node)));
- end if;
- end if;
+ when N_Case_Expression =>
+ exit when Node = Expression (Parent_Node);
+ In_Cond_Expr := True;
+
+ when N_If_Expression =>
+ exit when Node = First (Expressions (Parent_Node));
+ In_Cond_Expr := True;
- -- Just set the Delay flag in the cases where the transformation will be
- -- done top down from above.
+ when N_Qualified_Expression =>
+ null;
+
+ when others =>
+ exit;
+ end case;
+
+ Node := Parent_Node;
+ Parent_Node := Parent (Node);
+ end loop;
+
+ -- Set the Expansion_Delayed flag in the cases where the transformation
+ -- will be done top down from above.
if
-- Internal aggregates (transformed when expanding the parent),
-- excluding container aggregates as these are transformed into
- -- subprogram calls later.
+ -- subprogram calls later. So far aggregates with self-references
+ -- are not supported if they appear in a conditional expression.
- (Parent_Kind = N_Component_Association
- and then not Is_Container_Aggregate (Parent (Parent_Node)))
+ (Nkind (Parent_Node) = N_Component_Association
+ and then not Is_Container_Aggregate (Parent (Parent_Node))
+ and then not (In_Cond_Expr and then Has_Self_Reference (N)))
- or else (Parent_Kind in N_Aggregate | N_Extension_Aggregate
- and then not Is_Container_Aggregate (Parent_Node))
+ or else (Nkind (Parent_Node) in N_Aggregate | N_Extension_Aggregate
+ and then not Is_Container_Aggregate (Parent_Node)
+ and then not (In_Cond_Expr and then Has_Self_Reference (N)))
-- Allocator (see Convert_Aggr_In_Allocator)
- or else Parent_Kind = N_Allocator
+ or else Nkind (Parent_Node) = N_Allocator
- -- Object declaration (see Convert_Aggr_In_Object_Decl)
+ -- Object declaration (see Convert_Aggr_In_Object_Decl). So far only
+ -- declarations with a known size are supported.
- or else (Parent_Kind = N_Object_Declaration and then not Unc_Decl)
+ or else (Nkind (Parent_Node) = N_Object_Declaration
+ and then Known_Size (Parent_Node, In_Cond_Expr))
-- Safe assignment (see Convert_Aggr_In_Assignment). So far only the
-- assignments in init procs are taken into account.
- or else (Parent_Kind = N_Assignment_Statement
+ or else (Nkind (Parent_Node) = N_Assignment_Statement
and then Inside_Init_Proc)
-
- -- (Ada 2005) An inherently limited type in a return statement, which
- -- will be handled in a build-in-place fashion, and may be rewritten
- -- as an extended return and have its own finalization machinery.
- -- In the case of a simple return, the aggregate needs to be delayed
- -- until the scope for the return statement has been created, so
- -- that any finalization chain will be associated with that scope.
- -- For extended returns, we delay expansion to avoid the creation
- -- of an unwanted transient scope that could result in premature
- -- finalization of the return object (which is built in place
- -- within the caller's scope).
-
- or else Is_Build_In_Place_Aggregate_Return (N)
then
+ Node := N;
+
+ -- Mark the aggregate, as well as all the intermediate conditional
+ -- expressions, as having expansion delayed. This will block the
+ -- usual (bottom-up) expansion of the marked nodes and replace it
+ -- with a top-down expansion from the parent node.
+
+ while Node /= Parent_Node loop
+ if Nkind (Node) in N_Aggregate
+ | N_Case_Expression
+ | N_Extension_Aggregate
+ | N_If_Expression
+ then
+ Set_Expansion_Delayed (Node);
+ end if;
+
+ Node := Parent (Node);
+ end loop;
+
+ return;
+
+ -- (Ada 2005) An inherently limited type in a return statement, which
+ -- will be handled in a build-in-place fashion, and may be rewritten
+ -- as an extended return and have its own finalization machinery.
+ -- In the case of a simple return, the aggregate needs to be delayed
+ -- until the scope for the return statement has been created, so
+ -- that any finalization chain will be associated with that scope.
+ -- For extended returns, we delay expansion to avoid the creation
+ -- of an unwanted transient scope that could result in premature
+ -- finalization of the return object (which is built in place
+ -- within the caller's scope).
+
+ elsif Is_Build_In_Place_Aggregate_Return (N) then
Set_Expansion_Delayed (N);
return;
end if;
@@ -4304,11 +4372,19 @@ package body Exp_Aggr is
Establish_Transient_Scope (N, Manage_Sec_Stack => False);
end if;
+ -- Now get back to the immediate parent, modulo qualified expression
+
+ Parent_Node := Parent (N);
+
+ if Nkind (Parent_Node) = N_Qualified_Expression then
+ Parent_Node := Parent (Parent_Node);
+ end if;
+
-- If the context is an assignment and the aggregate is limited, this
-- is a subaggregate of an enclosing aggregate being expanded; it must
-- be built in place, so use the target of the current assignment.
- if Parent_Kind = N_Assignment_Statement
+ if Nkind (Parent_Node) = N_Assignment_Statement
and then Is_Limited_Type (Typ)
then
Target_Expr := New_Copy_Tree (Name (Parent_Node));
@@ -4321,7 +4397,7 @@ package body Exp_Aggr is
-- by-copy semantics of aggregates. This avoids large stack usage and
-- generates more efficient code.
- elsif Parent_Kind = N_Assignment_Statement
+ elsif Nkind (Parent_Node) = N_Assignment_Statement
and then In_Place_Assign_OK (N, Get_Base_Object (Name (Parent_Node)))
then
declare
@@ -8678,6 +8754,13 @@ package body Exp_Aggr is
Name => New_Copy_Tree (Comp),
Expression => Relocate_Node (Init_Expr));
+ -- If the initialization expression is a conditional expression whose
+ -- expansion has been delayed, analyze it again and expand it.
+
+ if Is_Delayed_Conditional_Expression (Expression (Init_Stmt)) then
+ Set_Analyzed (Expression (Init_Stmt), False);
+ end if;
+
Append_To (Blk_Stmts, Init_Stmt);
-- Arrange for the component to be adjusted if need be (the call will be
@@ -8796,6 +8879,18 @@ package body Exp_Aggr is
and then Expansion_Delayed (Unqual_N);
end Is_Delayed_Aggregate;
+ ---------------------------------------
+ -- Is_Delayed_Conditional_Expression --
+ ---------------------------------------
+
+ function Is_Delayed_Conditional_Expression (N : Node_Id) return Boolean is
+ Unqual_N : constant Node_Id := Unqualify (N);
+
+ begin
+ return Nkind (Unqual_N) in N_Case_Expression | N_If_Expression
+ and then Expansion_Delayed (Unqual_N);
+ end Is_Delayed_Conditional_Expression;
+
--------------------------------
-- Is_CCG_Supported_Aggregate --
--------------------------------
@@ -54,6 +54,10 @@ package Exp_Aggr is
-- Returns True if N is an aggregate of some kind whose Expansion_Delayed
-- flag is set (see sinfo for meaning of flag).
+ function Is_Delayed_Conditional_Expression (N : Node_Id) return Boolean;
+ -- Returns True if N is a conditional expression whose Expansion_Delayed
+ -- flag is set (see sinfo for meaning of flag).
+
function Static_Array_Aggregate (N : Node_Id) return Boolean;
-- N is an array aggregate that may have a component association with
-- an others clause and a range. If bounds are static and the expressions
@@ -7689,10 +7689,48 @@ package body Exp_Ch3 is
Expander_Mode_Restore;
end if;
+ -- For a special return object, the transformation must wait until
+ -- after the object is turned into an allocator.
+
if not Special_Ret_Obj then
Convert_Aggr_In_Object_Decl (N);
end if;
+ -- If the initialization expression is a conditional expression whose
+ -- expansion has been delayed, assign it explicitly to the object but
+ -- only after analyzing it again and expanding it.
+
+ elsif Is_Delayed_Conditional_Expression (Expr_Q) then
+ -- For a special return object, the transformation must wait until
+ -- after the object is turned into an allocator, and will be done
+ -- during the expansion of the allocator.
+
+ if not Special_Ret_Obj then
+ declare
+ Assign : constant Node_Id :=
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Def_Id, Loc),
+ Expression => Relocate_Node (Expr));
+
+ begin
+ Set_Assignment_OK (Name (Assign));
+ Set_Analyzed (Expression (Assign), False);
+ Set_No_Finalize_Actions (Assign);
+ Insert_Action_After (Init_After, Assign);
+
+ -- Save the assignment statement when declaring a controlled
+ -- object. This reference is used later by the finalization
+ -- machinery to mark the object as successfully initialized
+
+ if Needs_Finalization (Typ) then
+ Set_Last_Aggregate_Assignment (Def_Id, Assign);
+ end if;
+
+ Set_Expression (N, Empty);
+ Set_No_Initialization (N);
+ end;
+ end if;
+
-- Ada 2005 (AI-318-02): If the initialization expression is a call
-- to a build-in-place function, then access to the declared object
-- must be passed to the function. Currently we limit such functions
@@ -564,10 +564,16 @@ package body Exp_Ch4 is
procedure Build_Aggregate_In_Place (Temp : Entity_Id; Typ : Entity_Id);
-- If Exp is an aggregate to build in place, build the declaration of
- -- Temp with Typ and with expression an uninitialized allocator for
- -- Etype (Exp), then perform an in-place aggregate assignment of Exp
+ -- Temp with Typ and initializing expression an uninitialized allocator
+ -- for Etype (Exp), then perform an in-place aggregate assignment of Exp
-- into the allocated memory.
+ procedure Build_Explicit_Assignment (Temp : Entity_Id; Typ : Entity_Id);
+ -- If Exp is a conditional expression whose expansion has been delayed,
+ -- build the declaration of Temp with Typ and initializing expression an
+ -- uninitialized allocator for Etype (Exp), then perform an assignment
+ -- of Exp into the allocated memory.
+
------------------------------
-- Build_Aggregate_In_Place --
------------------------------
@@ -598,13 +604,58 @@ package body Exp_Ch4 is
Convert_Aggr_In_Allocator (N, Temp);
end Build_Aggregate_In_Place;
+ -------------------------------
+ -- Build_Explicit_Assignment --
+ -------------------------------
+
+ procedure Build_Explicit_Assignment (Temp : Entity_Id; Typ : Entity_Id)
+ is
+ Assign : constant Node_Id :=
+ Make_Assignment_Statement (Loc,
+ Name =>
+ Make_Explicit_Dereference (Loc,
+ New_Occurrence_Of (Temp, Loc)),
+ Expression => Relocate_Node (Exp));
+
+ Temp_Decl : constant Node_Id :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp,
+ Object_Definition => New_Occurrence_Of (Typ, Loc),
+ Expression =>
+ Make_Allocator (Loc,
+ Expression => New_Occurrence_Of (Etype (Exp), Loc)));
+
+ begin
+ -- Prevent default initialization of the allocator
+
+ Set_No_Initialization (Expression (Temp_Decl));
+
+ -- Copy the Comes_From_Source flag onto the allocator since logically
+ -- this allocator is a replacement of the original allocator. This is
+ -- for proper handling of restriction No_Implicit_Heap_Allocations.
+
+ Preserve_Comes_From_Source (Expression (Temp_Decl), N);
+
+ -- Insert the declaration
+
+ Insert_Action (N, Temp_Decl);
+
+ -- Arrange for the expression to be analyzed again and expanded
+
+ Set_Assignment_OK (Name (Assign));
+ Set_Analyzed (Expression (Assign), False);
+ Set_No_Finalize_Actions (Assign);
+ Insert_Action (N, Assign);
+ end Build_Explicit_Assignment;
+
-- Local variables
- Adj_Call : Node_Id;
- Aggr_In_Place : Boolean;
- Node : Node_Id;
- Temp : Entity_Id;
- Temp_Decl : Node_Id;
+ Adj_Call : Node_Id;
+ Aggr_In_Place : Boolean;
+ Delayed_Cond_Expr : Boolean;
+ Node : Node_Id;
+ Temp : Entity_Id;
+ Temp_Decl : Node_Id;
TagT : Entity_Id := Empty;
-- Type used as source for tag assignment
@@ -631,13 +682,16 @@ package body Exp_Ch4 is
Apply_Constraint_Check (Exp, T, No_Sliding => True);
- Aggr_In_Place := Is_Delayed_Aggregate (Exp);
+ Aggr_In_Place := Is_Delayed_Aggregate (Exp);
+ Delayed_Cond_Expr := Is_Delayed_Conditional_Expression (Exp);
-- If the expression is an aggregate to be built in place, then we need
-- to delay applying predicate checks, because this would result in the
- -- creation of a temporary, which is illegal for limited types,
+ -- creation of a temporary, which is illegal for limited types and just
+ -- inefficient in the other cases. Likewise for a conditional expression
+ -- whose expansion has been delayed.
- if not Aggr_In_Place then
+ if not Aggr_In_Place and then not Delayed_Cond_Expr then
Apply_Predicate_Check (Exp, T);
end if;
@@ -741,6 +795,7 @@ package body Exp_Ch4 is
-- or this is a return/secondary stack allocation.
if not Aggr_In_Place
+ and then not Delayed_Cond_Expr
and then Present (Storage_Pool (N))
and then not Is_RTE (Storage_Pool (N), RE_RS_Pool)
and then not Is_RTE (Storage_Pool (N), RE_SS_Pool)
@@ -793,6 +848,9 @@ package body Exp_Ch4 is
if Aggr_In_Place then
Build_Aggregate_In_Place (Temp, PtrT);
+ elsif Delayed_Cond_Expr then
+ Build_Explicit_Assignment (Temp, PtrT);
+
else
Node := Relocate_Node (N);
Set_Analyzed (Node);
@@ -845,6 +903,9 @@ package body Exp_Ch4 is
if Aggr_In_Place then
Build_Aggregate_In_Place (Temp, Def_Id);
+ elsif Delayed_Cond_Expr then
+ Build_Explicit_Assignment (Temp, Def_Id);
+
else
Node := Relocate_Node (N);
Set_Analyzed (Node);
@@ -940,6 +1001,7 @@ package body Exp_Ch4 is
and then Needs_Finalization (T)
and then not Is_Inherently_Limited_Type (T)
and then not Aggr_In_Place
+ and then not Delayed_Cond_Expr
and then Nkind (Exp) /= N_Function_Call
and then not Special_Return
then
@@ -975,7 +1037,7 @@ package body Exp_Ch4 is
Rewrite (N, New_Occurrence_Of (Temp, Loc));
Analyze_And_Resolve (N, PtrT);
- if Aggr_In_Place then
+ if Aggr_In_Place or else Delayed_Cond_Expr then
Apply_Predicate_Check (N, T, Deref => True);
end if;
@@ -1003,6 +1065,19 @@ package body Exp_Ch4 is
Apply_Predicate_Check (N, T, Deref => True);
end if;
+ -- If the initialization expression is a conditional expression whose
+ -- expansion has been delayed, assign it explicitly to the allocator,
+ -- but only after analyzing it again and expanding it.
+
+ elsif Delayed_Cond_Expr then
+ Temp := Make_Temporary (Loc, 'P', N);
+ Build_Explicit_Assignment (Temp, PtrT);
+ Build_Allocate_Deallocate_Proc (Declaration_Node (Temp), Mark => N);
+ Rewrite (N, New_Occurrence_Of (Temp, Loc));
+ Analyze_And_Resolve (N, PtrT);
+
+ Apply_Predicate_Check (N, T, Deref => True);
+
elsif Is_Access_Type (T) and then Can_Never_Be_Null (T) then
Install_Null_Excluding_Check (Exp);
@@ -4886,6 +4961,32 @@ package body Exp_Ch4 is
------------------------------
procedure Expand_N_Case_Expression (N : Node_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+ Par : constant Node_Id := Parent (N);
+ Typ : constant Entity_Id := Etype (N);
+
+ In_Predicate : constant Boolean :=
+ Ekind (Current_Scope) in E_Function | E_Procedure
+ and then Is_Predicate_Function (Current_Scope);
+ -- Flag set when the case expression appears within a predicate
+
+ Optimize_Return_Stmt : constant Boolean :=
+ Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
+ -- Small optimization: when the case expression appears in the context
+ -- of a simple return statement, expand into
+
+ -- case X is
+ -- when A =>
+ -- return AX;
+ -- when B =>
+ -- return BX;
+ -- ...
+ -- end case;
+
+ -- This makes the expansion much easier when expressions are calls to
+ -- a BIP function. But do not perform it when the return statement is
+ -- within a predicate function, as this causes spurious errors.
+
function Is_Copy_Type (Typ : Entity_Id) return Boolean;
-- Return True if we can copy objects of this type when expanding a case
-- expression.
@@ -4909,10 +5010,6 @@ package body Exp_Ch4 is
-- Local variables
- Loc : constant Source_Ptr := Sloc (N);
- Par : constant Node_Id := Parent (N);
- Typ : constant Entity_Id := Etype (N);
-
Acts : List_Id;
Alt : Node_Id;
Case_Stmt : Node_Id;
@@ -4920,16 +5017,39 @@ package body Exp_Ch4 is
Target : Entity_Id := Empty;
Target_Typ : Entity_Id;
- In_Predicate : Boolean := False;
- -- Flag set when the case expression appears within a predicate
+ Optimize_Assignment_Stmt : Boolean;
+ -- Small optimization: when the case expression appears in the context
+ -- of a safe assignment statement, expand into
- Optimize_Return_Stmt : Boolean := False;
- -- Flag set when the case expression can be optimized in the context of
- -- a simple return statement.
+ -- case X is
+ -- when A =>
+ -- lhs := AX;
+ -- when B =>
+ -- lhs := BX;
+ -- ...
+ -- end case;
+
+ -- This makes the expansion much more efficient in the context of an
+ -- aggregate converted into assignments.
-- Start of processing for Expand_N_Case_Expression
begin
+ -- If the expansion of the expression has been delayed, we wait for the
+ -- rewriting of its parent as an assignment statement; when that's done,
+ -- we optimize the assignment (the very purpose of the manipulation).
+
+ if Expansion_Delayed (N) then
+ if Nkind (Par) /= N_Assignment_Statement then
+ return;
+ end if;
+
+ Optimize_Assignment_Stmt := True;
+
+ else
+ Optimize_Assignment_Stmt := False;
+ end if;
+
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
@@ -4941,15 +5061,11 @@ package body Exp_Ch4 is
-- to which it applies has a static predicate aspect, do not expand,
-- because it will be converted to the proper predicate form later.
- if Ekind (Current_Scope) in E_Function | E_Procedure
- and then Is_Predicate_Function (Current_Scope)
+ if In_Predicate
+ and then
+ Has_Static_Predicate_Aspect (Etype (First_Entity (Current_Scope)))
then
- In_Predicate := True;
-
- if Has_Static_Predicate_Aspect (Etype (First_Entity (Current_Scope)))
- then
- return;
- end if;
+ return;
end if;
-- When the type of the case expression is elementary, expand
@@ -5002,24 +5118,6 @@ package body Exp_Ch4 is
Set_From_Conditional_Expression (Case_Stmt);
Acts := New_List;
- -- Small optimization: when the case expression appears in the context
- -- of a simple return statement, expand into
-
- -- case X is
- -- when A =>
- -- return AX;
- -- when B =>
- -- return BX;
- -- ...
- -- end case;
-
- -- This makes the expansion much easier when expressions are calls to
- -- a BIP function. But do not perform it when the return statement is
- -- within a predicate function, as this causes spurious errors.
-
- Optimize_Return_Stmt :=
- Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
-
-- Scalar/Copy case
if Is_Copy_Type (Typ) then
@@ -5060,7 +5158,10 @@ package body Exp_Ch4 is
-- Generate:
-- Target : [Ptr_]Typ;
- if not Optimize_Return_Stmt then
+ if Optimize_Assignment_Stmt then
+ Remove_Side_Effects (Name (Par), Name_Req => True);
+
+ elsif not Optimize_Return_Stmt then
Target := Make_Temporary (Loc, 'T');
Decl :=
@@ -5077,24 +5178,42 @@ package body Exp_Ch4 is
Alt := First (Alternatives (N));
while Present (Alt) loop
declare
- Alt_Expr : Node_Id := Expression (Alt);
+ Alt_Expr : Node_Id := Relocate_Node (Expression (Alt));
Alt_Loc : constant Source_Ptr := Sloc (Alt_Expr);
LHS : Node_Id;
Stmts : List_Id;
begin
- -- Take the unrestricted access of the expression value for non-
- -- scalar types. This approach avoids big copies and covers the
- -- limited and unconstrained cases.
+ -- Generate:
+ -- lhs := AX;
+
+ if Optimize_Assignment_Stmt then
+ -- We directly copy the parent node to preserve its flags
+
+ Stmts := New_List (New_Copy (Par));
+ Set_Sloc (First (Stmts), Alt_Loc);
+ Set_Name (First (Stmts), New_Copy_Tree (Name (Par)));
+ Set_Expression (First (Stmts), Alt_Expr);
+
+ -- If the expression is itself a conditional expression whose
+ -- expansion has been delayed, analyze it again and expand it.
+
+ if Is_Delayed_Conditional_Expression (Alt_Expr) then
+ Set_Analyzed (Alt_Expr, False);
+ end if;
-- Generate:
- -- return AX['Unrestricted_Access];
+ -- return AX;
- if Optimize_Return_Stmt then
+ elsif Optimize_Return_Stmt then
Stmts := New_List (
Make_Simple_Return_Statement (Alt_Loc,
Expression => Alt_Expr));
+ -- Take the unrestricted access of the expression value for non-
+ -- scalar types. This approach avoids big copies and covers the
+ -- limited and unconstrained cases.
+
-- Generate:
-- Target := AX['Unrestricted_Access];
@@ -5150,9 +5269,9 @@ package body Exp_Ch4 is
Next (Alt);
end loop;
- -- Rewrite the parent return statement as a case statement
+ -- Rewrite the parent statement as a case statement
- if Optimize_Return_Stmt then
+ if Optimize_Assignment_Stmt or else Optimize_Return_Stmt then
Rewrite (Par, Case_Stmt);
Analyze (Par);
@@ -5332,6 +5451,26 @@ package body Exp_Ch4 is
Par : constant Node_Id := Parent (N);
Typ : constant Entity_Id := Etype (N);
+ In_Predicate : constant Boolean :=
+ Ekind (Current_Scope) in E_Function | E_Procedure
+ and then Is_Predicate_Function (Current_Scope);
+ -- Flag set when the if expression appears within a predicate
+
+ Optimize_Return_Stmt : constant Boolean :=
+ Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
+ -- Small optimization: when the if expression appears in the context of
+ -- a simple return statement, expand into
+
+ -- if cond then
+ -- return then-expr
+ -- else
+ -- return else-expr;
+ -- end if;
+
+ -- This makes the expansion much easier when expressions are calls to
+ -- a BIP function. But do not perform it when the return statement is
+ -- within a predicate function, as this causes spurious errors.
+
Force_Expand : constant Boolean := Is_Anonymous_Access_Actual (N);
-- Determine if we are dealing with a special case of a conditional
-- expression used as an actual for an anonymous access type which
@@ -5365,18 +5504,44 @@ package body Exp_Ch4 is
-- Local variables
Actions : List_Id;
- Decl : Node_Id;
- Expr : Node_Id;
- New_If : Node_Id;
- New_N : Node_Id;
+ Decl : Node_Id;
+ Expr : Node_Id;
+ New_Else : Node_Id;
+ New_If : Node_Id;
+ New_N : Node_Id;
+ New_Then : Node_Id;
+
+ Optimize_Assignment_Stmt : Boolean;
+ -- Small optimization: when the if expression appears in the context of
+ -- a safe assignment statement, expand into
+
+ -- if cond then
+ -- lhs := then-expr
+ -- else
+ -- lhs := else-expr;
+ -- end if;
- Optimize_Return_Stmt : Boolean := False;
- -- Flag set when the if expression can be optimized in the context of
- -- a simple return statement.
+ -- This makes the expansion much more efficient in the context of an
+ -- aggregate converted into assignments.
-- Start of processing for Expand_N_If_Expression
begin
+ -- If the expansion of the expression has been delayed, we wait for the
+ -- rewriting of its parent as an assignment statement; when that's done,
+ -- we optimize the assignment (the very purpose of the manipulation).
+
+ if Expansion_Delayed (N) then
+ if Nkind (Par) /= N_Assignment_Statement then
+ return;
+ end if;
+
+ Optimize_Assignment_Stmt := True;
+
+ else
+ Optimize_Assignment_Stmt := False;
+ end if;
+
-- Deal with non-standard booleans
Adjust_Condition (Cond);
@@ -5457,25 +5622,54 @@ package body Exp_Ch4 is
end;
end if;
- -- Small optimization: when the if expression appears in the context of
- -- a simple return statement, expand into
+ if Optimize_Assignment_Stmt then
+ Remove_Side_Effects (Name (Par), Name_Req => True);
- -- if cond then
- -- return then-expr
- -- else
- -- return else-expr;
- -- end if;
+ -- When the "then" or "else" expressions involve controlled function
+ -- calls, generated temporaries are chained on the corresponding list
+ -- of actions. These temporaries need to be finalized after the if
+ -- expression is evaluated.
- -- This makes the expansion much easier when expressions are calls to
- -- a BIP function. But do not perform it when the return statement is
- -- within a predicate function, as this causes spurious errors.
+ Process_Transients_In_Expression (N, Then_Actions (N));
+ Process_Transients_In_Expression (N, Else_Actions (N));
+
+ -- We directly copy the parent node to preserve its flags
+
+ New_Then := New_Copy (Par);
+ Set_Sloc (New_Then, Sloc (Thenx));
+ Set_Name (New_Then, New_Copy_Tree (Name (Par)));
+ Set_Expression (New_Then, Relocate_Node (Thenx));
+
+ -- If the expression is itself a conditional expression whose
+ -- expansion has been delayed, analyze it again and expand it.
- Optimize_Return_Stmt :=
- Nkind (Par) = N_Simple_Return_Statement
- and then not (Ekind (Current_Scope) in E_Function | E_Procedure
- and then Is_Predicate_Function (Current_Scope));
+ if Is_Delayed_Conditional_Expression (Expression (New_Then)) then
+ Set_Analyzed (Expression (New_Then), False);
+ end if;
+
+ New_Else := New_Copy (Par);
+ Set_Sloc (New_Else, Sloc (Elsex));
+ Set_Name (New_Else, New_Copy_Tree (Name (Par)));
+ Set_Expression (New_Else, Relocate_Node (Elsex));
+
+ if Is_Delayed_Conditional_Expression (Expression (New_Else)) then
+ Set_Analyzed (Expression (New_Else), False);
+ end if;
- if Optimize_Return_Stmt then
+ New_If :=
+ Make_Implicit_If_Statement (N,
+ Condition => Relocate_Node (Cond),
+ Then_Statements => New_List (New_Then),
+ Else_Statements => New_List (New_Else));
+
+ -- Preserve the original context for which the if statement is
+ -- being generated. This is needed by the finalization machinery
+ -- to prevent the premature finalization of controlled objects
+ -- found within the if statement.
+
+ Set_From_Conditional_Expression (New_If);
+
+ elsif Optimize_Return_Stmt then
-- When the "then" or "else" expressions involve controlled function
-- calls, generated temporaries are chained on the corresponding list
-- of actions. These temporaries need to be finalized after the if
@@ -6085,9 +6279,9 @@ package body Exp_Ch4 is
Prepend_List (Else_Actions (N), Else_Statements (New_If));
end if;
- -- Rewrite the parent return statement as an if statement
+ -- Rewrite the parent statement as an if statement
- if Optimize_Return_Stmt then
+ if Optimize_Assignment_Stmt or else Optimize_Return_Stmt then
Rewrite (Par, New_If);
Analyze (Par);
@@ -10354,9 +10548,16 @@ package body Exp_Ch4 is
Apply_Constraint_Check (Operand, Target_Type, No_Sliding => True);
- -- Apply possible predicate check
+ -- Apply possible predicate check but, for a delayed aggregate, the
+ -- check is effectively delayed until after the aggregate is expanded
+ -- into a series of assignments. Likewise for a conditional expression
+ -- whose expansion has been delayed.
- Apply_Predicate_Check (Operand, Target_Type);
+ if not Is_Delayed_Aggregate (Operand)
+ and then not Is_Delayed_Conditional_Expression (Operand)
+ then
+ Apply_Predicate_Check (Operand, Target_Type);
+ end if;
if Do_Range_Check (Operand) then
Generate_Range_Check (Operand, Target_Type, CE_Range_Check_Failed);
@@ -464,6 +464,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
(Sy (Expressions, List_Id, Default_No_List),
Sy (Is_Elsif, Flag),
Sm (Do_Overflow_Check, Flag),
+ Sm (Expansion_Delayed, Flag),
Sm (Else_Actions, List_Id),
Sm (Then_Actions, List_Id)));
@@ -513,7 +514,8 @@ begin -- Gen_IL.Gen.Gen_Nodes
Cc (N_Case_Expression, N_Subexpr,
(Sy (Expression, Node_Id, Default_Empty),
Sy (Alternatives, List_Id, Default_No_List),
- Sm (Do_Overflow_Check, Flag)));
+ Sm (Do_Overflow_Check, Flag),
+ Sm (Expansion_Delayed, Flag)));
Cc (N_Delta_Aggregate, N_Subexpr,
(Sy (Expression, Node_Id, Default_Empty),
@@ -1322,6 +1322,8 @@ package Sinfo is
-- assignment or initialization. When the full context is known, the
-- target of the assignment or initialization is used to generate the
-- left-hand side of individual assignment to each subcomponent.
+ -- Also set on conditional expressions whose dependent expressions are
+ -- nested aggregates, in order to avoid creating a temporary for them.
-- Expression_Copy
-- Present in N_Pragma_Argument_Association nodes. Contains a copy of the
@@ -4657,6 +4659,7 @@ package Sinfo is
-- Else_Actions
-- Is_Elsif (set if comes from ELSIF)
-- Do_Overflow_Check
+ -- Expansion_Delayed
-- plus fields for expression
-- Expressions here is a three-element list, whose first element is the
@@ -4695,6 +4698,7 @@ package Sinfo is
-- Alternatives (the case expression alternatives)
-- Etype
-- Do_Overflow_Check
+ -- Expansion_Delayed
----------------------------------------
-- 4.5.7 Case Expression Alternative --