-- First, climb the parent chain, looking through qualified expressions
-- and dependent expressions of conditional expressions.
- while True loop
+ loop
case Nkind (Parent_Node) is
when N_Case_Expression_Alternative =>
null;
or else Is_Build_In_Place_Aggregate_Return (Parent_Node)
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;
-
+ Set_Expansion_Delayed (N);
+ Delay_Conditional_Expressions_Between (N, Parent_Node);
return;
end if;
-- 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);
+ Unanalyze_Delayed_Conditional_Expression (Expression (Init_Stmt));
end if;
Append_To (Blk_Stmts, Init_Stmt);
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_Static_Dispatch_Table_Aggregate --
----------------------------------------
-- 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 Is_Two_Pass_Aggregate (N : Node_Id) return Boolean;
-- Return True if N is an aggregate that is to be expanded in two passes.
-- This is the case if it consists only of iterated component associations
if not Special_Ret_Obj then
declare
+ Rhs : constant Node_Id := Relocate_Node (Expr);
Assign : constant Node_Id :=
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Def_Id, Loc),
- Expression => Relocate_Node (Expr));
+ Expression => Rhs);
begin
Set_Assignment_OK (Name (Assign));
- Set_Analyzed (Expression (Assign), False);
+ Unanalyze_Delayed_Conditional_Expression (Rhs);
Set_No_Finalize_Actions (Assign);
Insert_Action_After (Init_After, Assign);
Scop : constant Entity_Id := Current_Scope;
Typ : constant Entity_Id := Etype (N);
- Optimize_Return_Stmt : constant Boolean :=
- Nkind (Par) = N_Simple_Return_Statement;
- -- 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
- -- build-in-place functions.
-
function Is_Copy_Type (Typ : Entity_Id) return Boolean;
-- Return True if we can copy objects of this type when expanding a case
-- expression.
-- This makes the expansion much more efficient in the context of an
-- aggregate converted into assignments.
+ Optimize_Return_Stmt : Boolean := False;
+ -- 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
+ -- build-in-place functions.
+
-- Start of processing for Expand_N_Case_Expression
begin
+ -- If the expression is in the context of a simple return statement,
+ -- possibly through intermediate conditional expressions, we delay
+ -- expansion until the (immediate) parent is rewritten as a return
+ -- statement (or is already the return statement).
+
+ if not Expansion_Delayed (N) then
+ declare
+ Uncond_Par : constant Node_Id := Unconditional_Parent (N);
+ begin
+ if Nkind (Uncond_Par) = N_Simple_Return_Statement then
+ Delay_Conditional_Expressions_Between (N, Uncond_Par);
+ end if;
+ end;
+ end if;
+
-- If the expansion of the expression has been delayed, we wait for the
-- rewriting of its parent as an assignment or return statement; when
-- that's done, we optimize the assignment or the return statement (the
if Nkind (Par) = N_Assignment_Statement then
Optimize_Assignment_Stmt := True;
- elsif Optimize_Return_Stmt then
- null;
+ elsif Nkind (Par) = N_Simple_Return_Statement then
+ Optimize_Return_Stmt := True;
else
return;
-- expansion has been delayed, analyze it again and expand it.
if Is_Delayed_Conditional_Expression (Alt_Expr) then
- Set_Analyzed (Alt_Expr, False);
+ Unanalyze_Delayed_Conditional_Expression (Alt_Expr);
end if;
-- Generate:
-- expansion has been delayed, analyze it again and expand it.
if Is_Delayed_Conditional_Expression (Alt_Expr) then
- Set_Analyzed (Alt_Expr, False);
+ Unanalyze_Delayed_Conditional_Expression (Alt_Expr);
end if;
-- Take the unrestricted access of the expression value for non-
Par : constant Node_Id := Parent (N);
Typ : constant Entity_Id := Etype (N);
- Optimize_Return_Stmt : constant Boolean :=
- Nkind (Par) = N_Simple_Return_Statement;
- -- 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
- -- build-in-place functions.
-
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
-- This makes the expansion much more efficient in the context of an
-- aggregate converted into assignments.
+ Optimize_Return_Stmt : Boolean := False;
+ -- 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
+ -- build-in-place functions.
+
-- Start of processing for Expand_N_If_Expression
begin
+ -- If the expression is in the context of a simple return statement,
+ -- possibly through intermediate conditional expressions, we delay
+ -- expansion until the (immediate) parent is rewritten as a return
+ -- statement (or is already the return statement). Note that this
+ -- deals with the case of the elsif part of the if expression.
+
+ if not Expansion_Delayed (N) then
+ declare
+ Uncond_Par : constant Node_Id := Unconditional_Parent (N);
+ begin
+ if Nkind (Uncond_Par) = N_Simple_Return_Statement then
+ Delay_Conditional_Expressions_Between (N, Uncond_Par);
+ end if;
+ end;
+ end if;
+
-- If the expansion of the expression has been delayed, we wait for the
-- rewriting of its parent as an assignment or return statement; when
-- that's done, we optimize the assignment or the return statement (the
if Nkind (Par) = N_Assignment_Statement then
Optimize_Assignment_Stmt := True;
- elsif Optimize_Return_Stmt then
- null;
+ elsif Nkind (Par) = N_Simple_Return_Statement then
+ Optimize_Return_Stmt := True;
else
return;
-- expansion has been delayed, analyze it again and expand it.
if Is_Delayed_Conditional_Expression (Expr) then
- Set_Analyzed (Expr, False);
+ Unanalyze_Delayed_Conditional_Expression (Expr);
end if;
Insert_Actions (N, Actions);
-- expansion has been delayed, analyze it again and expand it.
if Is_Delayed_Conditional_Expression (Expression (New_Then)) then
- Set_Analyzed (Expression (New_Then), False);
+ Unanalyze_Delayed_Conditional_Expression (Expression (New_Then));
end if;
New_Else := New_Copy (Par);
Set_Expression (New_Else, Relocate_Node (Elsex));
if Is_Delayed_Conditional_Expression (Expression (New_Else)) then
- Set_Analyzed (Expression (New_Else), False);
+ Unanalyze_Delayed_Conditional_Expression (Expression (New_Else));
end if;
If_Stmt :=
-- expansion has been delayed, analyze it again and expand it.
if Is_Delayed_Conditional_Expression (New_Then) then
- Set_Analyzed (New_Then, False);
+ Unanalyze_Delayed_Conditional_Expression (New_Then);
end if;
New_Else := Relocate_Node (Elsex);
-- expansion has been delayed, analyze it again and expand it.
if Is_Delayed_Conditional_Expression (New_Else) then
- Set_Analyzed (New_Else, False);
+ Unanalyze_Delayed_Conditional_Expression (New_Else);
end if;
If_Stmt :=
-----------------------------------
procedure Expand_N_Qualified_Expression (N : Node_Id) is
- Operand : constant Node_Id := Expression (N);
- Target_Type : constant Entity_Id := Entity (Subtype_Mark (N));
+ Loc : constant Source_Ptr := Sloc (N);
+ Operand : constant Node_Id := Expression (N);
+ Target_Type : constant Entity_Id := Entity (Subtype_Mark (N));
begin
+ -- Nothing to do if the operand is an identical qualified expression
+
+ if Nkind (Operand) = N_Qualified_Expression
+ and then Entity (Subtype_Mark (Operand)) = Target_Type
+ then
+ Rewrite (N, Relocate_Node (Operand));
+ return;
+
+ -- An allocator expects a qualified expression in all cases
+
+ elsif Nkind (Parent (N)) = N_Allocator then
+ null;
+
+ -- Distribute the qualified expression into the dependent expressions
+ -- of a delayed conditional expression. The goal is to enable further
+ -- optimizations, for example within a return statement, by exposing
+ -- the conditional expression.
+
+ elsif Nkind (Operand) = N_Case_Expression
+ and then Expansion_Delayed (Operand)
+ then
+ declare
+ New_Alts : constant List_Id := New_List;
+ New_Case : constant Node_Id :=
+ Make_Case_Expression (Loc,
+ Expression => Relocate_Node (Expression (Operand)),
+ Alternatives => New_Alts);
+
+ Alt : Node_Id;
+ New_Alt : Node_Id;
+
+ begin
+ Alt := First (Alternatives (Operand));
+ while Present (Alt) loop
+ New_Alt :=
+ Make_Case_Expression_Alternative (Sloc (Alt),
+ Discrete_Choices => Discrete_Choices (Alt),
+ Expression =>
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark => New_Occurrence_Of (Target_Type, Loc),
+ Expression => Relocate_Node (Expression (Alt))));
+ Append_To (New_Alts, New_Alt);
+ Set_Actions (New_Alt, Actions (Alt));
+
+ Next (Alt);
+ end loop;
+
+ Rewrite (N, New_Case);
+ Analyze_And_Resolve (N);
+ return;
+ end;
+
+ elsif Nkind (Operand) = N_If_Expression
+ and then Expansion_Delayed (Operand)
+ then
+ declare
+ Cond : constant Node_Id := First (Expressions (Operand));
+ Thenx : constant Node_Id := Next (Cond);
+ Elsex : constant Node_Id := Next (Thenx);
+ New_If : constant Node_Id :=
+ Make_If_Expression (Loc,
+ Expressions => New_List (
+ Relocate_Node (Cond),
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark => New_Occurrence_Of (Target_Type, Loc),
+ Expression => Relocate_Node (Thenx)),
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark => New_Occurrence_Of (Target_Type, Loc),
+ Expression => Relocate_Node (Elsex))));
+
+ begin
+ Set_Then_Actions (New_If, Then_Actions (Operand));
+ Set_Else_Actions (New_If, Else_Actions (Operand));
+
+ Rewrite (N, New_If);
+ Analyze_And_Resolve (N);
+ return;
+ end;
+ end if;
+
-- Do validity check if validity checking operands
if Validity_Checks_On and Validity_Check_Operands then
-- insert the finalization call after the return statement as
-- this will render it unreachable.
- if Nkind (Fin_Context) = N_Simple_Return_Statement then
+ if Nkind (Fin_Context) = N_Simple_Return_Statement
+ or else Nkind (Parent (Expr)) = N_Simple_Return_Statement
+ then
null;
-- Finalize the object after the context has been evaluated
-- Note that simple return statements are distributed into conditional
-- expressions but we may be invoked before this distribution is done.
- if Nkind (Par) = N_Simple_Return_Statement
- or else (Nkind (Par) = N_If_Expression
- and then Nkind (Parent (Par)) = N_Simple_Return_Statement)
- or else (Nkind (Par) = N_Case_Expression_Alternative
- and then
- Nkind (Parent (Parent (Par))) = N_Simple_Return_Statement)
- then
+ if Nkind (Unconditional_Parent (N)) = N_Simple_Return_Statement then
return;
end if;
return;
end if;
- -- Avoid expansions to catch an error when the function call is on the
+ -- Avoid expansion to catch the error when the function call is on the
-- left-hand side of an assignment.
if Nkind (Par) = N_Assignment_Statement and then N = Name (Par) then
return Decls;
end Current_Sem_Unit_Declarations;
+ -------------------------------------------
+ -- Delay_Conditional_Expressions_Between --
+ -------------------------------------------
+
+ procedure Delay_Conditional_Expressions_Between (From, To : Node_Id) is
+ N : Node_Id := From;
+
+ begin
+ while N /= To loop
+ if Nkind (N) in N_Case_Expression | N_If_Expression then
+ Set_Expansion_Delayed (N);
+ end if;
+
+ N := Parent (N);
+ end loop;
+ end Delay_Conditional_Expressions_Between;
+
-----------------------
-- Duplicate_Subexpr --
-----------------------
Par := N;
Top := N;
while Present (Par) loop
- if Nkind (Original_Node (Par)) in
- N_Case_Expression | N_If_Expression
+ if Nkind (Original_Node (Par)) in N_Case_Expression
+ | N_If_Expression
+ then
+ Top := Par;
+
+ elsif Nkind (Par) in N_Case_Statement
+ | N_If_Statement
+ and then From_Conditional_Expression (Par)
then
Top := Par;
and then Is_Formal (Entity (N)));
end Is_Conversion_Or_Reference_To_Formal;
+ ---------------------------------------
+ -- 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_Expanded_Class_Wide_Interface_Object_Decl --
--------------------------------------------------
end if;
end Type_May_Have_Bit_Aligned_Components;
+ ----------------------------------------------
+ -- Unanalyze_Delayed_Conditional_Expression --
+ ----------------------------------------------
+
+ procedure Unanalyze_Delayed_Conditional_Expression (N : Node_Id) is
+ Expr : Node_Id := N;
+
+ begin
+ -- Is_Delayed_Conditional_Expression looks through qualified expressions
+ -- surrounding conditional expressions, so we need to reset the Analyzed
+ -- flag on them as well.
+
+ loop
+ Set_Analyzed (Expr, False);
+
+ exit when Nkind (Expr) in N_Case_Expression | N_If_Expression;
+
+ pragma Assert (Nkind (Expr) = N_Qualified_Expression);
+ Expr := Expression (Expr);
+ end loop;
+ end Unanalyze_Delayed_Conditional_Expression;
+
+ --------------------------
+ -- Unconditional_Parent --
+ --------------------------
+
+ function Unconditional_Parent (N : Node_Id) return Node_Id is
+ Node : Node_Id := N;
+ Parent_Node : Node_Id := Parent (Node);
+
+ begin
+ loop
+ case Nkind (Parent_Node) is
+ when N_Case_Expression_Alternative =>
+ null;
+
+ when N_Case_Expression =>
+ exit when Node = Expression (Parent_Node);
+
+ when N_If_Expression =>
+ exit when Node = First (Expressions (Parent_Node));
+
+ when N_Qualified_Expression =>
+ null;
+
+ when others =>
+ exit;
+ end case;
+
+ Node := Parent_Node;
+ Parent_Node := Parent (Node);
+ end loop;
+
+ return Parent_Node;
+ end Unconditional_Parent;
+
-------------------------------
-- Update_Primitives_Mapping --
-------------------------------
begin
-- Locate an enclosing case or if expression. Note that these constructs
- -- can be expanded into Expression_With_Actions, hence the test of the
- -- original node.
+ -- can be rewritten as Expression_With_Actions nodes, hence the test of
+ -- the original node. Moreover, we need to take into account conditional
+ -- statements synthesized out of these expressions.
Nod := N;
Par := Parent (Nod);
then
return True;
+ elsif Nkind (Par) = N_Case_Statement
+ and then From_Conditional_Expression (Par)
+ and then Nod /= Expression (Par)
+ then
+ return True;
+
+ elsif Nkind (Par) = N_If_Statement
+ and then From_Conditional_Expression (Par)
+ and then Nod /= Condition (Par)
+ then
+ return True;
+
-- Stop at contexts where temporaries may be contained
elsif Nkind (Par) in N_Aggregate
procedure Insert_Library_Level_Actions (L : List_Id);
-- Similar, but inserts a list of actions
+ ------------------------
+ -- Delayed Expansion --
+ ------------------------
+
+ -- The default, bottom-up expansion of expressions is not appropriate for
+ -- some specific situations, either because it would generate problematic
+ -- constructs in the expanded code, for example temporaries of a limited
+ -- type, or because it would generate superfluous copy operations. These
+ -- situations involve either aggregates or conditional expressions (or a
+ -- combination of them) of composite types:
+
+ -- 1. For aggregates, the default expansion model is to instantiate the
+ -- anonymous object where elaboration is performed, in other words to
+ -- create a temporary. This can be directly avoided if the aggregate
+ -- is the initialization expression of an object, but cannot be if the
+ -- aggregate is nested in another aggregate, or else is the dependent
+ -- expression of a conditional expression.
+
+ -- 2. For (most) conditional expressions of composite types, the default
+ -- expansion model is to take 'Unrestricted_Access of their dependent
+ -- expressions and to replace them with the dereference of the access
+ -- value designating the dependent expression chosen by the condition.
+ -- Now taking 'Unrestricted_Access of an expression, for example again
+ -- an aggregate or a function call, forces the creation of a temporary
+ -- to hold the value of the expression.
+
+ -- In these specific situations, it is desirable, if not required, to delay
+ -- the expansion of the expression until after that of the parent construct
+ -- has started or has completed, so that it can drive this expansion in the
+ -- first case or completely rewrite the expression in the second case.
+
+ -- This is achieved by means of the Expansion_Delayed flag that may be set
+ -- on aggregates and conditional expressions: when the above situations are
+ -- recognized, expansion is blocked, the flag is set, and Expand returns
+ -- after setting the Analyzed flag on the expression as usual, which means
+ -- that it is up to the parent construct either to perform the expansion of
+ -- the expression directly (case of nested aggregates), or to reset the
+ -- Analyzed flag on the expression so that Expand can give it another try
+ -- in a modified context (case of conditional expressions).
+
+ procedure Delay_Conditional_Expressions_Between (From, To : Node_Id);
+ -- Mark all the conditional expressions in the tree between From and To
+ -- as having their expansion delayed (From included, To excluded).
+
+ function Is_Delayed_Conditional_Expression (N : Node_Id) return Boolean;
+ -- Returns True if N is a conditional expression whose Expansion_Delayed
+ -- flag is set.
+
+ procedure Unanalyze_Delayed_Conditional_Expression (N : Node_Id);
+ -- Schedule the reanalysis of the delayed conditional expression N
+
-----------------------
-- Other Subprograms --
-----------------------
-- is conservative, in that a result of False is decisive. A result of True
-- means that such a component may or may not be present.
+ function Unconditional_Parent (N : Node_Id) return Node_Id;
+ -- Return the first parent of arbitrary node N that is not a conditional
+ -- expression, one of whose dependent expressions is N, and that is not
+ -- a qualified expression, whose expression is N, recursively.
+
procedure Update_Primitives_Mapping
(Inher_Id : Entity_Id;
Subp_Id : Entity_Id);
-- 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.
+ -- nested aggregates (recursively), or which are expressions of simple
+ -- return statements (recursively again), in order to avoid creating a
+ -- temporary for them.
-- Expression_Copy
-- Present in N_Pragma_Argument_Association nodes. Contains a copy of the
projects / thirdparty / gcc.git / commitdiff
