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
N_Package_Declaration |
N_Package_Instantiation |
N_Package_Renaming_Declaration |
+ N_Parametrized_Expression |
N_Private_Extension_Declaration |
N_Private_Type_Declaration |
N_Procedure_Instantiation |
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
-- 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);
-- 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;
-- 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:
end if;
end if;
- -- Processing for subprogram body
+ -- Processing for subprogram body or parametrized expression
<<Subprogram_Body>>
if not Pf_Flags.Pbod then
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
when N_Parameter_Association =>
Analyze_Parameter_Association (N);
+ when N_Parametrized_Expression =>
+ Analyze_Parametrized_Expression (N);
+
when N_Pragma =>
Analyze_Pragma (N);
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 --
----------------------------
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);
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
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
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
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
-- 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 --
-----------------------------------
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,
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)
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");
projects / platform / upstream / gcc.git / commitdiff