exp_util.adb (Insert_Actions): Add handling of N_Parametrized_Expression.

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
	* par-ch4.adb: Minor reformatting.

From-SVN: r165098

10 files changed, 198 insertions, 31 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2901a1c..4ed46f1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,17 @@
 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
+	* par-ch4.adb: Minor reformatting.
+
+2010-10-07  Robert Dewar  <dewar@adacore.com>
+
 	* scng.adb (Skip_Other_Format_Characters): New procedure
 	(Start_Of_Wide_Character): New procedure
 	(Scan): Use Start_Of_Wide_Character where appropriate
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 112fe04..0a7e5ae 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -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
 
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 2d388f6..a7952c5 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -2634,7 +2634,7 @@ package body Ch4 is
 
    --  Error_Recovery: cannot raise Error_Resync
 
-   function  P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
+   function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
       Qual_Node : Node_Id;
    begin
       Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 3632110..2c979cf 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -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
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 32ad831..a23bd46 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -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);
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 8478b7e..c178840 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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 --
    ----------------------------
diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads
index 242d561..cb3a91a 100644
--- a/gcc/ada/sem_ch6.ads
+++ b/gcc/ada/sem_ch6.ads
@@ -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);
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index c43e0b4..bf587dd 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -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
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 707bf64..573759d 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -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)
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 60aad67..f7aceea 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -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");