Patchwork [Ada] Implement Ada 2012 AI-0177 Parametrized Expressions

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 7, 2010, 12:34 p.m.
Message ID <20101007123422.GA19395@adacore.com>
Download mbox | patch
Permalink /patch/67046/
State New
Headers show

Comments

Arnaud Charlet - Oct. 7, 2010, 12:34 p.m.
This patch implements the new Ada 2012 notion of parametrized
expressions. The form is FUNCTION SPECIFICATION IS EXPRESSION.
This is equivalent to the corresponding function body that
returns the expression, but it can appear in a package spec.
The following compiles clean with -gnat2012 and outputs 102.

package ParamExpr is
   F : Integer := 1;
   function Squarep1 (A : Integer) return Integer is A * A + F;
end;

with ParamExpr; use ParamExpr;
with Text_IO; use Text_IO;
procedure ParamExprM is
begin
   F := 2;
   Put_Line (Squarep1 (10)'Img);
end ParamExprM;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-07  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb (Insert_Actions): Add handling of
	N_Parametrized_Expression.
	* par-ch6.adb (P_Subprogram): Add parsing of parametrized expression
	* sem.adb: Add entry for N_Parametrized_Expression
	* sem_ch6.adb (Analyze_Parametrized_Expression): New procedure
	* sem_ch6.ads (Analyze_Parametrized_Expression): New procedure
	* sinfo.ads, sinfo.adb: Add N_Parametrized_Expression
	* sprint.adb (Sprint_Node): Add handling for N_Parametrized_Expression

Patch

Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 165097)
+++ exp_util.adb	(working copy)
@@ -2592,6 +2592,7 @@  package body Exp_Util is
                N_Package_Declaration                    |
                N_Package_Instantiation                  |
                N_Package_Renaming_Declaration           |
+               N_Parametrized_Expression                |
                N_Private_Extension_Declaration          |
                N_Private_Type_Declaration               |
                N_Procedure_Instantiation                |
@@ -4583,15 +4584,14 @@  package body Exp_Util is
 
       function Side_Effect_Free (N : Node_Id) return Boolean is
       begin
-         --  Note on checks that could raise Constraint_Error. Strictly, if
-         --  we take advantage of 11.6, these checks do not count as side
-         --  effects. However, we would just as soon consider that they are
-         --  side effects, since the backend CSE does not work very well on
-         --  expressions which can raise Constraint_Error. On the other
-         --  hand, if we do not consider them to be side effect free, then
-         --  we get some awkward expansions in -gnato mode, resulting in
-         --  code insertions at a point where we do not have a clear model
-         --  for performing the insertions.
+         --  Note on checks that could raise Constraint_Error. Strictly, if we
+         --  take advantage of 11.6, these checks do not count as side effects.
+         --  However, we would prefer to consider that they are side effects,
+         --  since the backend CSE does not work very well on expressions which
+         --  can raise Constraint_Error. On the other hand if we don't consider
+         --  them to be side effect free, then we get some awkward expansions
+         --  in -gnato mode, resulting in code insertions at a point where we
+         --  do not have a clear model for performing the insertions.
 
          --  Special handling for entity names
 
Index: sinfo.adb
===================================================================
--- sinfo.adb	(revision 165080)
+++ sinfo.adb	(working copy)
@@ -1191,6 +1191,7 @@  package body Sinfo is
         or else NT (N).Nkind = N_Number_Declaration
         or else NT (N).Nkind = N_Object_Declaration
         or else NT (N).Nkind = N_Parameter_Specification
+        or else NT (N).Nkind = N_Parametrized_Expression
         or else NT (N).Nkind = N_Pragma_Argument_Association
         or else NT (N).Nkind = N_Qualified_Expression
         or else NT (N).Nkind = N_Raise_Statement
@@ -2681,6 +2682,7 @@  package body Sinfo is
         or else NT (N).Nkind = N_Generic_Package_Declaration
         or else NT (N).Nkind = N_Generic_Subprogram_Declaration
         or else NT (N).Nkind = N_Package_Declaration
+        or else NT (N).Nkind = N_Parametrized_Expression
         or else NT (N).Nkind = N_Subprogram_Body
         or else NT (N).Nkind = N_Subprogram_Body_Stub
         or else NT (N).Nkind = N_Subprogram_Declaration
@@ -4094,6 +4096,7 @@  package body Sinfo is
         or else NT (N).Nkind = N_Number_Declaration
         or else NT (N).Nkind = N_Object_Declaration
         or else NT (N).Nkind = N_Parameter_Specification
+        or else NT (N).Nkind = N_Parametrized_Expression
         or else NT (N).Nkind = N_Pragma_Argument_Association
         or else NT (N).Nkind = N_Qualified_Expression
         or else NT (N).Nkind = N_Raise_Statement
@@ -5584,6 +5587,7 @@  package body Sinfo is
         or else NT (N).Nkind = N_Generic_Package_Declaration
         or else NT (N).Nkind = N_Generic_Subprogram_Declaration
         or else NT (N).Nkind = N_Package_Declaration
+        or else NT (N).Nkind = N_Parametrized_Expression
         or else NT (N).Nkind = N_Subprogram_Body
         or else NT (N).Nkind = N_Subprogram_Body_Stub
         or else NT (N).Nkind = N_Subprogram_Declaration
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 165080)
+++ sinfo.ads	(working copy)
@@ -4427,6 +4427,24 @@  package Sinfo is
       --  Was_Originally_Stub (Flag13-Sem)
       --  Has_Relative_Deadline_Pragma (Flag9-Sem)
 
+      -----------------------------
+      -- Parametrized Expression --
+      -----------------------------
+
+      --  This is an Ada 2012 extension, we put it here for now, to be labeled
+      --  and put in its proper section when we know exactly where that is!
+
+      --  PARAMETRIZED_EXPRESSION ::=
+      --    FUNCTION SPECIFICATION IS EXPRESSION;
+
+      --  Note: there are no separate nodes for the profiles, instead the
+      --  information appears directly in the following nodes.
+
+      --  N_Parametrized_Expression
+      --  Sloc points to FUNCTION
+      --  Specification (Node1)
+      --  Expression (Node3)
+
       -----------------------------------
       -- 6.4  Procedure Call Statement --
       -----------------------------------
@@ -7314,6 +7332,7 @@  package Sinfo is
       N_Incomplete_Type_Declaration,
       N_Loop_Parameter_Specification,
       N_Object_Declaration,
+      N_Parametrized_Expression,
       N_Protected_Type_Declaration,
       N_Private_Extension_Declaration,
       N_Private_Type_Declaration,
@@ -10422,6 +10441,13 @@  package Sinfo is
         4 => True,    --  Handled_Statement_Sequence (Node4)
         5 => False),  --  Corresponding_Spec (Node5-Sem)
 
+     N_Parametrized_Expression =>
+       (1 => True,    --  Specification (Node1)
+        2 => False,   --  unused
+        3 => True,    --  Expression (Node3)
+        4 => False,   --  unused
+        5 => False),  --  unused
+
      N_Procedure_Call_Statement =>
        (1 => False,   --  Controlling_Argument (Node1-Sem)
         2 => True,    --  Name (Node2)
Index: sem.adb
===================================================================
--- sem.adb	(revision 165080)
+++ sem.adb	(working copy)
@@ -437,6 +437,9 @@  package body Sem is
          when N_Parameter_Association =>
             Analyze_Parameter_Association (N);
 
+         when N_Parametrized_Expression =>
+            Analyze_Parametrized_Expression (N);
+
          when N_Pragma =>
             Analyze_Pragma (N);
 
Index: par-ch6.adb
===================================================================
--- par-ch6.adb	(revision 165080)
+++ par-ch6.adb	(working copy)
@@ -82,6 +82,7 @@  package body Ch6 is
 
    --  This routine scans out a subprogram declaration, subprogram body,
    --  subprogram renaming declaration or subprogram generic instantiation.
+   --  It also handles the new Ada 2012 parametrized expression form
 
    --  SUBPROGRAM_DECLARATION ::= SUBPROGRAM_SPECIFICATION;
 
@@ -122,6 +123,9 @@  package body Ch6 is
    --  is classified as a basic declarative item, but it is parsed here, with
    --  other subprogram constructs.
 
+   --  PARAMETRIZED_EXPRESSION ::=
+   --    FUNCTION SPECIFICATION IS EXPRESSION;
+
    --  The value in Pf_Flags indicates which of these possible declarations
    --  is acceptable to the caller:
 
@@ -579,7 +583,7 @@  package body Ch6 is
          end if;
       end if;
 
-      --  Processing for subprogram body
+      --  Processing for subprogram body or parametrized expression
 
       <<Subprogram_Body>>
          if not Pf_Flags.Pbod then
@@ -607,29 +611,110 @@  package body Ch6 is
             TF_Semicolon;
             return Stub_Node;
 
-         --  Subprogram body case
+         --  Subprogram body or parametrized expression case
 
          else
-            --  Here is the test for a suspicious IS (i.e. one that looks
-            --  like it might more properly be a semicolon). See separate
-            --  section discussing use of IS instead of semicolon in
-            --  package Parse.
-
-            if (Token in Token_Class_Declk
-                  or else
-                Token = Tok_Identifier)
-              and then Start_Column <= Scope.Table (Scope.Last).Ecol
-              and then Scope.Last /= 1
-            then
-               Scope.Table (Scope.Last).Etyp := E_Suspicious_Is;
-               Scope.Table (Scope.Last).S_Is := Prev_Token_Ptr;
-            end if;
+            --  Here we must distinguish a body and a parametrized expression
+
+            Parse_Body_Or_Parametrized_Expression : declare
+               function Is_Parametrized_Expression return Boolean;
+               --  Returns True if we have case of parametrized epression
+
+               --------------------------------
+               -- Is_Parametrized_Expression --
+               --------------------------------
+
+               function Is_Parametrized_Expression return Boolean is
+               begin
+                  --  Parametrized expression only allowed in Ada 2012
+
+                  if Ada_Version < Ada_12 then
+                     return False;
+
+                  --  If currently pointing to BEGIN or a declaration keyword
+                  --  or a pragma then we definitely do not have a parametrized
+                  --  expression.
+
+                  elsif Token in Token_Class_Declk
+                    or else Token = Tok_Begin
+                    or else Token = Tok_Pragma
+                  then
+                     return False;
+
+                  --  A common error case, missing BEGIN before RETURN
+
+                  elsif Token = Tok_Return then
+                     return False;
+
+                  --  Anything other than an identifier must be a parametrized
+                  --  expression at this stage. Probably we could do a little
+                  --  better job of distingushing some more error cases.
+
+                  elsif Token /= Tok_Identifier then
+                     return True;
+
+                  --  For identifier we have to scan ahead if identifier is
+                  --  followed by a colon or a comma, it is a declaration and
+                  --  hence we have a subprogram body. Otherwise we have an
+                  --  expression.
+
+                  else
+                     declare
+                        Scan_State : Saved_Scan_State;
+                        Tok        : Token_Type;
+                     begin
+                        Save_Scan_State (Scan_State);
+                        Scan; -- past identifier
+                        Tok := Token;
+                        Restore_Scan_State (Scan_State);
+                        return Tok /= Tok_Colon and then Tok /= Tok_Comma;
+                     end;
+                  end if;
+               end Is_Parametrized_Expression;
+
+            --  Start of processing for Parse_Body_Or_Parametrized_Expression
+
+            begin
+               --  Parametrized_Expression case, parse expression
+
+               if Is_Parametrized_Expression then
+                  Body_Node :=
+                    New_Node
+                      (N_Parametrized_Expression, Sloc (Specification_Node));
+                  Set_Specification (Body_Node, Specification_Node);
+                  Set_Expression (Body_Node, P_Expression);
+                  T_Semicolon;
+                  Pop_Scope_Stack;
+
+               --  Subprogram body case
+
+               else
+                  --  Here is the test for a suspicious IS (i.e. one that looks
+                  --  like it might more properly be a semicolon). See separate
+                  --  section discussing use of IS instead of semicolon in
+                  --  package Parse.
+
+                  if (Token in Token_Class_Declk
+                        or else
+                      Token = Tok_Identifier)
+                    and then Start_Column <= Scope.Table (Scope.Last).Ecol
+                    and then Scope.Last /= 1
+                  then
+                     Scope.Table (Scope.Last).Etyp := E_Suspicious_Is;
+                     Scope.Table (Scope.Last).S_Is := Prev_Token_Ptr;
+                  end if;
+
+                  --  Build and return subprogram body, parsing declarations
+                  --  an statement sequence that belong to the body.
+
+                  Body_Node :=
+                    New_Node (N_Subprogram_Body, Sloc (Specification_Node));
+                  Set_Specification (Body_Node, Specification_Node);
+                  Parse_Decls_Begin_End (Body_Node);
+               end if;
 
-            Body_Node :=
-              New_Node (N_Subprogram_Body, Sloc (Specification_Node));
-            Set_Specification (Body_Node, Specification_Node);
-            Parse_Decls_Begin_End (Body_Node);
-            return Body_Node;
+               return Body_Node;
+            end Parse_Body_Or_Parametrized_Expression;
          end if;
 
       --  Processing for subprogram declaration
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 165080)
+++ sem_ch6.adb	(working copy)
@@ -1038,6 +1038,31 @@  package body Sem_Ch6 is
       Analyze (Explicit_Actual_Parameter (N));
    end Analyze_Parameter_Association;
 
+   -------------------------------------
+   -- Analyze_Parametrized_Expression --
+   -------------------------------------
+
+   procedure Analyze_Parametrized_Expression (N : Node_Id) is
+      Loc  : constant Source_Ptr := Sloc (N);
+      LocX : constant Source_Ptr := Sloc (Expression (N));
+
+   begin
+      --  This is one of the occasions on which we write things during semantic
+      --  analysis. We transform the parametrized expression into an equivalent
+      --  subprogram body, and then analyze that.
+
+      Rewrite (N,
+        Make_Subprogram_Body (Loc,
+          Specification              => Specification (N),
+          Declarations               => Empty_List,
+          Handled_Statement_Sequence =>
+            Make_Handled_Sequence_Of_Statements (LocX,
+              Statements => New_List (
+                Make_Simple_Return_Statement (LocX,
+                  Expression => Expression (N))))));
+      Analyze (N);
+   end Analyze_Parametrized_Expression;
+
    ----------------------------
    -- Analyze_Procedure_Call --
    ----------------------------
Index: sem_ch6.ads
===================================================================
--- sem_ch6.ads	(revision 165080)
+++ sem_ch6.ads	(working copy)
@@ -39,6 +39,7 @@  package Sem_Ch6 is
    procedure Analyze_Function_Call                   (N : Node_Id);
    procedure Analyze_Operator_Symbol                 (N : Node_Id);
    procedure Analyze_Parameter_Association           (N : Node_Id);
+   procedure Analyze_Parametrized_Expression         (N : Node_Id);
    procedure Analyze_Procedure_Call                  (N : Node_Id);
    procedure Analyze_Simple_Return_Statement         (N : Node_Id);
    procedure Analyze_Subprogram_Declaration          (N : Node_Id);
Index: sprint.adb
===================================================================
--- sprint.adb	(revision 165080)
+++ sprint.adb	(working copy)
@@ -2388,6 +2388,17 @@  package body Sprint is
                Write_Str (", ");
             end if;
 
+         when N_Parametrized_Expression =>
+            Write_Indent;
+            Sprint_Node_Sloc (Specification (Node));
+
+            Write_Str (" is");
+            Indent_Begin;
+            Write_Indent;
+            Sprint_Node (Expression (Node));
+            Write_Char (';');
+            Indent_End;
+
          when N_Pop_Constraint_Error_Label =>
             Write_Indent_Str ("%pop_constraint_error_label");