From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Eric Botcazou <ebotcazou@adacore.com>
Subject: [COMMITTED 13/30] ada: Extend expansion delaying mechanism to conditional expressions
Date: Mon, 20 May 2024 09:48:39 +0200 [thread overview]
Message-ID: <20240520074858.222435-13-poulhies@adacore.com> (raw)
In-Reply-To: <20240520074858.222435-1-poulhies@adacore.com>
From: Eric Botcazou <ebotcazou@adacore.com>
When an aggregate that needs to be converted into a series of assignments is
present in an expression of a parent aggregate, or in the expression of an
allocator, an object declaration, or an assignment in very specific cases,
its expansion is delayed until its parent itself is expanded. This makes
it possible to avoid creating a superfluous temporary for the aggregate.
This change extends the delaying mechanism in the case of record aggregates
to intermediate conditional expressions, that is to say, to the conditional
expressions that are present between the parent and the aggregate, provided
that the aggregate be a dependent expression, directly or recursively. This
again makes it possible to avoid creating a temporary for the aggregate.
gcc/ada/
* exp_aggr.ads (Is_Delayed_Conditional_Expression): New predicate.
* exp_aggr.adb (Convert_To_Assignments.Known_Size): Likewise.
(Convert_To_Assignments): Climb the parent chain, looking through
qualified expressions and dependent expressions of conditional
expressions, to find out whether the expansion may be delayed.
Call Known_Size for this in the case of an object declaration.
If so, set Expansion_Delayed on the aggregate as well as all the
intermediate conditional expressions.
(Initialize_Component): Reset the Analyzed flag on an initialization
expression that is a conditional expression whose expansion has been
delayed.
(Is_Delayed_Conditional_Expression): New predicate.
* exp_ch3.adb (Expand_N_Object_Declaration): Handle initialization
expressions that are conditional expressions whose expansion has
been delayed.
* exp_ch4.adb (Build_Explicit_Assignment): New procedure.
(Expand_Allocator_Expression): Handle initialization expressions
that are conditional expressions whose expansion has been delayed.
(Expand_N_Case_Expression): Deal with expressions whose expansion
has been delayed by waiting for the rewriting of their parent as
an assignment statement and then optimizing the assignment.
(Expand_N_If_Expression): Likewise.
(Expand_N_Qualified_Expression): Do not apply a predicate check to
an operand that is a delayed aggregate or conditional expression.
* gen_il-gen-gen_nodes.adb (N_If_Expression): Add Expansion_Delayed
semantic flag.
(N_Case_Expression): Likewise.
* sinfo.ads (Expansion_Delayed): Document extended usage.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 201 ++++++++++++-----
gcc/ada/exp_aggr.ads | 4 +
gcc/ada/exp_ch3.adb | 38 ++++
gcc/ada/exp_ch4.adb | 363 ++++++++++++++++++++++++-------
gcc/ada/gen_il-gen-gen_nodes.adb | 4 +-
gcc/ada/sinfo.ads | 4 +
6 files changed, 479 insertions(+), 135 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 6208b49ffd9..a386aa85ae4 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -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 --
--------------------------------
diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads
index a9eb0518d7a..17fa38b7ca3 100644
--- a/gcc/ada/exp_aggr.ads
+++ b/gcc/ada/exp_aggr.ads
@@ -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
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index f6314dff285..8ddae1eb1be 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -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
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 69a042115c9..6ceffdf8302 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -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);
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index a7021dc49bb..580723666c5 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -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),
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 7cad6cf1d29..228082eb823 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -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 --
--
2.43.2
next prev parent reply other threads:[~2024-05-20 7:49 UTC|newest]
Thread overview: 30+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-05-20 7:48 [COMMITTED 01/30] ada: Rework and augment documentation on strict aliasing Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 02/30] ada: Small cleanup in System.Finalization_Primitives unit Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 03/30] ada: Implement representation aspect Max_Entry_Queue_Length Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 04/30] ada: Detect only conflict with synomyms of max queue length Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 05/30] ada: One more adjustment coming from aliasing considerations Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 06/30] ada: Reject too-strict alignment specifications Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 07/30] ada: Use System.Address for address computation in System.Pool_Global Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 08/30] ada: Fix for attribute Width on enumeration types with Discard_Name Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 09/30] ada: Fix static 'Img for enumeration type with Discard_Names Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 10/30] ada: Another small cleanup about allocators and aggregates Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 11/30] ada: Fix incorrect free with Task_Info pragma Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 12/30] ada: Resolve ACATS compilation and execution issues with container aggregates Marc Poulhiès
2024-05-20 7:48 ` Marc Poulhiès [this message]
2024-05-20 7:48 ` [COMMITTED 14/30] ada: Tweak handling of thread ID on POSIX Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 15/30] ada: Fix style in list of implementation-defined attributes Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 16/30] ada: Use discrete choice list in declaration of universal type attributes Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 17/30] ada: Remove repeated condition in check for implementation attributes Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 18/30] ada: Apply restriction No_Implementation_Attributes to source nodes only Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 19/30] ada: Fix list of attributes defined by Ada 2012 Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 20/30] ada: Fix list of implementation-defined attributes Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 21/30] ada: Further refine 'Super attribute Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 22/30] ada: Handle accessibility calculations for 'First and 'Last Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 23/30] ada: Error on instantiation of generic containing legal container aggregate Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 24/30] " Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 25/30] ada: Add Is_Base_Type predicate to C interface Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 26/30] ada: Formal package comment corrections in sinfo.ads Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 27/30] ada: Get rid of secondary stack for indefinite record types with size clause Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 28/30] ada: Fix internal error on nested aggregate in conditional expression Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 29/30] ada: Add direct workaround for limitations of RTSfind mechanism Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 30/30] ada: Allow 'others' in formal packages with overloaded formals Marc Poulhiès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20240520074858.222435-13-poulhies@adacore.com \
--to=poulhies@adacore.com \
--cc=ebotcazou@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).