[Ada] Implement static expression functions for Ada 202x (AI12-0075)

2020-06-17  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

	* aspects.ads (type Aspect_Id): Add Aspect_Static as a Boolean
	aspect, and update the Is_Representation_Aspect, Aspect_Names,
	and Aspect_Delay arrays.
	* exp_ch6.adb (Expand_Simple_Function_Return): In the case of a
	return for a static expression function, capture a copy of the
	expression of the return statement before it's expanded and
	reset its Analyzed flags. Then, just before leaving this
	procedure, if the expression was rewritten, set the
	Original_Node of the rewritten expression to the new copy and
	also set the Expression of the associated static expression
	function to designate that copy. This ensures that later copies
	of the expression made via New_Copy_Tree will fully copy all
	nodes of the expression tree.
	* inline.ads (Inline_Static_Expression_Function_Call): New
	procedure to evaluate and produce the result of a static call to
	a static expression function.
	* inline.adb: Add with and use for Sem_Res.
	(Establish_Actual_Mapping_For_Inlined_Call): New procedure
	extracted from code in Expand_Inlined_Call that traverses the
	actuals and formals of an inlined call and in some cases creates
	temporaries for holding the actuals, plus establishes an
	association between formals and actuals (via the Renamed_Object
	fields of the formals).
	(Formal_Is_Used_Once): Function removed from Expand_Inlined_Call
	and now nested in the above procedure.
	(Expand_Inlined_Call): Code for doing the formal/actual
	traversal is moved to Create_Actual_Temporaries and replaced
	with a call to that new procedure.
	(Inline_Static_Expression_Function_Call): New procedure to
	evaluate a static call to a static expression function,
	substituting actuals for their corresponding formals and
	producing a fully folded and static result expression. The
	function has subsidiary functions Replace_Formal and Reset_Sloc
	that take care of doing the mapping of formals to actuals and
	resetting the Slocs of subnodes of the mapped expression to that
	of the call so errors will be flagged on the call rather than
	function.
	* sem_ch6.adb (Analyze_Expression_Function): In the case of a
	static expression function, perform an additional preanalysis of
	the function's expression to ensure that it's a potentially
	static expression (according to the requirements of
	6.8(3.2/5-3.4/5)), and issue an error if it's not. The global
	flag Checking_Potentially_Static_Expression is set and unset
	around this checking.
	* sem_ch13.adb (Analyze_Aspect_Static): New procedure to enforce
	selected requirements of the new aspect Static on expression
	functions, including checking that the language version is
	Ada_2020 and that the entity to which it applies is an
	expression function whose formal parameters are of a static
	subtype and have mode 'in', its result subtype is a static
	subtype, and it has no pre- or postcondition aspects. A ???
	comment is added to indicate the need for adding checking that
	type invariants don't apply to the result type if the function
	is a boundary entity.
	(Analyze_One_Aspect): Call Analyze_Aspect_Static for aspect
	Static.
	* sem_elab.adb (Build_Call_Marker): Return without creating a
	call marker when the subprogram is a static expression function,
	since no ABE checking is needed for such functions.
	* sem_eval.ads (Checking_Potentially_Static_Expression): New
	function to return whether the checking for potentially static
	expressions is enabled.
	(Set_Checking_Potentially_Static_Expression): New procedure to
	enable or disable checking of potentially static expressions.
	* sem_eval.adb (Checking_For_Potentially_Static_Expression): New
	global flag for determining whether preanalysis of potentially
	static expression is being done, which affects the behavior of
	certain static evaluation routines.
	(Checking_Potentially_Static_Expression): New function to return
	whether the checking for potentially static expressions is
	enabled.
	(Eval_Call): When evaluating a call within a static expression
	function with checking of potentially static expression
	functions enabled, substitutes a static value in place of the
	call to allow folding of the expression.
	(Eval_Entity_Name): When evaluating a formal parameter of a
	static expression function with checking of potentially static
	expression functions enabled, substitutes a static value in
	place of the reference to the formal to allow folding of the
	expression.
	(Set_Checking_Potentially_Static_Expression): New procedure to
	enable or disable checking of potentially static expressions.
	* sem_res.adb (Resolve_Call): Test for a recursive call
	occurring within a static expression function and issue an error
	for such a call. Prevent the establishment of a transient scope
	in the case this is a call to a (string-returning) static
	expression function. When calling a static expression function,
	if no error has been posted on the function, call
	Inline_Static_Expression_Function_Call to convert the call into
	its equivalent static value.
	* sem_util.ads (Is_Static_Expression_Function): New function
	returning whether the subprogram entity passed to it is a static
	expression function.
	(Is_Static_Expression_Function_Call): New function to determine
	whether the call node passed to it is a static call to a static
	expression function.
	* sem_util.adb (Compile_Time_Constraint_Error): Suppress
	compile-time Constraint_Error reporting when checking for a
	potentially static expression.
	(Is_Static_Expression_Function): New function returning whether
	the subprogram entity passed to it is a static expression
	function by testing for the presence of aspect Static.
	(Has_All_Static_Actuals): New function in
	Is_Static_Expression_Function_Call that traverses the actual
	parameters of a function call and returns True only when all of
	the actuals are given by static expressions. In the case of a
	string-returning function, we call Resolve on each actual to
	ensure that their Is_Static_Expression flag properly reflects
	whether they're static, to allow suppressing creation of a
	transient scope within Resolve_Call. A prominent ??? comment is
	added to explain this rather unconventional call to Resolve.
	(Is_Static_Expression_Function_Call): New function that
	determines whether a node passed to it is a call to a static
	expression function all of whose actual parameters are given by
	static expressions.

1 files changed, 75 insertions, 1 deletions

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 43bffc9..5f15107 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5846,7 +5846,14 @@ package body Sem_Util is
          --  will happen when something is evaluated if it never will be
          --  evaluated.
 
-         if not Is_Statically_Unevaluated (N) then
+         --  Suppress error reporting when checking that the expression of a
+         --  static expression function is a potentially static expression,
+         --  because we don't want additional errors being reported during the
+         --  preanalysis of the expression (see Analyze_Expression_Function).
+
+         if not Is_Statically_Unevaluated (N)
+           and then not Checking_Potentially_Static_Expression
+         then
             if Present (Ent) then
                Error_Msg_NEL (Msgc (1 .. Msgl), N, Ent, Eloc);
             else
@@ -18442,6 +18449,73 @@ package body Sem_Util is
           or else Nkind (N) = N_Procedure_Call_Statement;
    end Is_Statement;
 
+   ------------------------------------
+   --  Is_Static_Expression_Function --
+   ------------------------------------
+
+   function Is_Static_Expression_Function (Subp : Entity_Id) return Boolean is
+   begin
+      return Is_Expression_Function (Subp)
+        and then Has_Aspect (Subp, Aspect_Static)
+        and then
+          (No (Find_Value_Of_Aspect (Subp, Aspect_Static))
+            or else Is_True (Static_Boolean
+                               (Find_Value_Of_Aspect (Subp, Aspect_Static))));
+   end Is_Static_Expression_Function;
+
+   -----------------------------------------
+   --  Is_Static_Expression_Function_Call --
+   -----------------------------------------
+
+   function Is_Static_Expression_Function_Call (Call : Node_Id) return Boolean
+   is
+
+      function Has_All_Static_Actuals (Call : Node_Id) return Boolean;
+      --  Return whether all actual parameters of Call are static expressions
+
+      function Has_All_Static_Actuals (Call : Node_Id) return Boolean is
+         Actual        : Node_Id := First_Actual (Call);
+         String_Result : constant Boolean :=
+                           Is_String_Type (Etype (Entity (Name (Call))));
+
+      begin
+         while Present (Actual) loop
+            if not Is_Static_Expression (Actual) then
+
+               --  ??? In the string-returning case we want to avoid a call
+               --  being made to Establish_Transient_Scope in Resolve_Call,
+               --  but at the point where that's tested for (which now includes
+               --  a call to test Is_Static_Expression_Function_Call), the
+               --  actuals of the call haven't been resolved, so expressions
+               --  of the actuals may not have been marked Is_Static_Expression
+               --  yet, so we force them to be resolved here, so we can tell if
+               --  they're static. Calling Resolve here is admittedly a kludge,
+               --  and we limit this call to string-returning cases. ???
+
+               if String_Result then
+                  Resolve (Actual);
+               end if;
+
+               --  Test flag again in case it's now True due to above Resolve
+
+               if not Is_Static_Expression (Actual) then
+                  return False;
+               end if;
+            end if;
+
+            Next_Actual (Actual);
+         end loop;
+
+         return True;
+      end Has_All_Static_Actuals;
+
+   begin
+      return Nkind (Call) = N_Function_Call
+        and then Is_Entity_Name (Name (Call))
+        and then Is_Static_Expression_Function (Entity (Name (Call)))
+        and then Has_All_Static_Actuals (Call);
+   end Is_Static_Expression_Function_Call;
+
    ----------------------------------------
    --  Is_Subcomponent_Of_Atomic_Object  --
    ----------------------------------------