[Ada] Inlining of expression function returning controlled object
Arnaud Charlet
charlet@adacore.com
Fri Jan 13 11:17:00 GMT 2017
Pragma Inline_Always has been extended to support inlining of calls
to expression functions that return a controlled object if the
expression function fulfills all the following requirements:
1. Has pragma/aspect Inline_Always
2. Has no formals
3. Has no contracts
4. Has no dispatching primitive
5. Its result subtype is controlled (or with controlled components)
6. Its result subtype not subject to type-invariant checks
7. Its result subtype not a class-wide type
8. Its return expression naming an object global to the function
9. The nominal subtype of the returned object statically compatible with
the result subtype of the expression function.
After this enhancement, using the following sources, the call to the
expression function Ada_Exception_Trace is now inlined.
with Ada.Finalization;
package Param is
type T is abstract tagged private;
private
type T is abstract new Ada.Finalization.Controlled with null record;
procedure Initialize (Obj : in out T);
procedure Adjust (Obj : in out T);
procedure Finalize (Obj : in out T);
end;
package Param.Debug is
type T is private;
function Value (Parameter : T) return Boolean with Inline_Always;
function Ada_Exception_Trace return T with Inline_Always;
procedure Do_Test;
private
type Comp_T is new Param.T with record
Value : Boolean := True;
end record;
type T is record
Component : Comp_T;
end record;
function Value (Parameter : T) return Boolean
is (Parameter.Component.Value);
Private_Ada_Exception_Trace : T;
function Ada_Exception_Trace return T -- Test
is (Private_Ada_Exception_Trace);
end Param.Debug;
with Ada.Text_IO; use Ada.Text_IO;
package body Param is
procedure Initialize (Obj : in out T) is
begin
Put_Line ("Initialize()");
end;
procedure Adjust (Obj : in out T) is
begin
Put_Line ("Adjust()");
end;
procedure Finalize (Obj : in out T) is
begin
Put_Line ("Finalize()");
end;
end;
with Ada.Text_IO; use Ada.Text_IO;
package body Param.Debug is
procedure Do_Test is
begin
if Value (Ada_Exception_Trace) then -- Test
Put_Line ("Do_Test()");
end if;
end;
end;
with Param.Debug;
procedure Main is
begin
Param.Debug.Do_Test;
end;
Command: gnatmake main.adb; ./main
Output:
Initialize()
Do_Test()
Finalize()
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-01-13 Javier Miranda <miranda@adacore.com>
* sem_res.adb (Resolve_Call): Do not establish a transient scope
for a call to inlinable expression function (since the call will
be replaced by its returned object).
* exp_ch6.ads (Is_Inlinable_Expression_Function): New subprogram.
* exp_ch6.adb (Expression_Of_Expression_Function): New subprogram.
(Expand_Call): For inlinable expression function call replace the
call by its returned object.
(Is_Inlinable_Expression_Function): New subprogram.
-------------- next part --------------
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 244418)
+++ sem_res.adb (working copy)
@@ -6260,7 +6260,10 @@
-- within the specialized Exp_Ch6 procedures for expanding those
-- build-in-place calls.
- -- e) If the subprogram is marked Inline_Always, then even if it returns
+ -- e) Calls to inlinable expression functions do not use the secondary
+ -- stack (since the call will be replaced by its returned object).
+
+ -- f) If the subprogram is marked Inline_Always, then even if it returns
-- an unconstrained type the call does not require use of the secondary
-- stack. However, inlining will only take place if the body to inline
-- is already present. It may not be available if e.g. the subprogram is
@@ -6281,6 +6284,7 @@
elsif Ekind (Nam) = E_Enumeration_Literal
or else Is_Build_In_Place_Function (Nam)
or else Is_Intrinsic_Subprogram (Nam)
+ or else Is_Inlinable_Expression_Function (Nam)
then
null;
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 244418)
+++ exp_ch6.adb (working copy)
@@ -219,6 +219,10 @@
-- reference to the object itself, and the call becomes a call to the
-- corresponding protected subprogram.
+ function Expression_Of_Expression_Function
+ (Subp : Entity_Id) return Node_Id;
+ -- Return the expression of the expression function Subp
+
function Has_Unconstrained_Access_Discriminants
(Subtyp : Entity_Id) return Boolean;
-- Returns True if the given subtype is unconstrained and has one
@@ -3938,6 +3942,14 @@
if not Is_Inlined (Subp) then
null;
+ -- Frontend inlining of expression functions (performed also when
+ -- backend inlining is enabled)
+
+ elsif Is_Inlinable_Expression_Function (Subp) then
+ Rewrite (N, New_Copy (Expression_Of_Expression_Function (Subp)));
+ Analyze (N);
+ return;
+
-- Handle frontend inlining
elsif not Back_End_Inlining then
@@ -6958,6 +6970,36 @@
end if;
end Expand_Simple_Function_Return;
+ ---------------------------------------
+ -- Expression_Of_Expression_Function --
+ ---------------------------------------
+
+ function Expression_Of_Expression_Function
+ (Subp : Entity_Id) return Node_Id
+ is
+ Expr_Func : Node_Id;
+
+ begin
+ pragma Assert (Is_Expression_Function_Or_Completion (Subp));
+
+ if Nkind (Original_Node (Subprogram_Spec (Subp)))
+ = N_Expression_Function
+ then
+ Expr_Func := Original_Node (Subprogram_Spec (Subp));
+
+ elsif Nkind (Original_Node (Subprogram_Body (Subp)))
+ = N_Expression_Function
+ then
+ Expr_Func := Original_Node (Subprogram_Body (Subp));
+
+ else
+ pragma Assert (False);
+ null;
+ end if;
+
+ return Original_Node (Expression (Expr_Func));
+ end Expression_Of_Expression_Function;
+
--------------------------------------------
-- Has_Unconstrained_Access_Discriminants --
--------------------------------------------
@@ -7285,6 +7327,39 @@
end if;
end Freeze_Subprogram;
+ --------------------------------------
+ -- Is_Inlinable_Expression_Function --
+ --------------------------------------
+
+ function Is_Inlinable_Expression_Function (Subp : Entity_Id) return Boolean
+ is
+ Return_Expr : Node_Id;
+
+ begin
+ if Is_Expression_Function_Or_Completion (Subp)
+ and then Has_Pragma_Inline_Always (Subp)
+ and then Needs_No_Actuals (Subp)
+ and then No (Contract (Subp))
+ and then not Is_Dispatching_Operation (Subp)
+ and then Needs_Finalization (Etype (Subp))
+ and then not Is_Class_Wide_Type (Etype (Subp))
+ and then not (Has_Invariants (Etype (Subp)))
+ and then Present (Subprogram_Body (Subp))
+ and then Was_Expression_Function (Subprogram_Body (Subp))
+ then
+ Return_Expr := Expression_Of_Expression_Function (Subp);
+
+ -- The returned object must not have a qualified expression and its
+ -- nominal subtype must be statically compatible with the result
+ -- subtype of the expression function.
+
+ return Nkind (Return_Expr) = N_Identifier
+ and then Etype (Return_Expr) = Etype (Subp);
+ end if;
+
+ return False;
+ end Is_Inlinable_Expression_Function;
+
-----------------------
-- Is_Null_Procedure --
-----------------------
Index: exp_ch6.ads
===================================================================
--- exp_ch6.ads (revision 244418)
+++ exp_ch6.ads (working copy)
@@ -137,6 +137,20 @@
-- that requires handling as a build-in-place call or is a qualified
-- expression applied to such a call; otherwise returns False.
+ function Is_Inlinable_Expression_Function (Subp : Entity_Id) return Boolean;
+ -- Return True if Subp is an expression function that fulfills all the
+ -- following requirements for inlining:
+ -- 1. pragma/aspect Inline_Always
+ -- 2. No formals
+ -- 3. No contracts
+ -- 4. No dispatching primitive
+ -- 5. Result subtype controlled (or with controlled components)
+ -- 6. Result subtype not subject to type-invariant checks
+ -- 7. Result subtype not a class-wide type
+ -- 8. Return expression naming an object global to the function
+ -- 9. Nominal subtype of the returned object statically compatible
+ -- with the result subtype of the expression function.
+
function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
-- Predicate to recognize stubbed procedures and null procedures, which
-- can be inlined unconditionally in all cases.
More information about the Gcc-patches
mailing list