From ad110ee8874446d1993a66fee67b9a7c6fd44a7a Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Thu, 7 Oct 2010 12:33:30 +0000 Subject: [PATCH] exp_util.adb (Insert_Actions): Add handling of N_Parametrized_Expression. 2010-10-07 Robert Dewar * 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 --- gcc/ada/ChangeLog | 12 +++++ gcc/ada/exp_util.adb | 18 ++++---- gcc/ada/par-ch4.adb | 2 +- gcc/ada/par-ch6.adb | 127 ++++++++++++++++++++++++++++++++++++++++++--------- gcc/ada/sem.adb | 3 ++ gcc/ada/sem_ch6.adb | 25 ++++++++++ gcc/ada/sem_ch6.ads | 1 + gcc/ada/sinfo.adb | 4 ++ gcc/ada/sinfo.ads | 26 +++++++++++ gcc/ada/sprint.adb | 11 +++++ 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 + * 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 + * 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 <> 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"); -- 2.7.4