From 72e17c21f2da6a82bcabe9c5fbcb75466761bf66 Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 6 Nov 2012 09:53:42 +0000 Subject: 2012-11-06 Hristian Kirtchev * exp_prag.adb (Expand_Pragma_Loop_Assertion): Update the comment on intended expansion. Reimplement the logic which expands the termination variants. (Process_Increase_Decrease): Update the parameter profile and the comment related to it. Accommodate the new aggregate-like appearance of the termination variants. * sem_prag.adb (Analyze_Pragma): Update the syntax of pragma Loop_Assertion. Reimplement the semantic analysis of the pragma to accommodate the new aggregate-like variant. (Check_Variant): New routine. * snames.ads-tmpl: Change names Name_Decreases and Name_Increases to Name_Decreasing and Name_Increasing respectively. Add name Variant. 2012-11-06 Ed Schonberg * sem_eval.adb: Static evaluation of case expressions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@193216 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 20 +++++++ gcc/ada/exp_prag.adb | 151 +++++++++++++++++++++++++++++++----------------- gcc/ada/sem_eval.adb | 58 ++++++++++++++++--- gcc/ada/sem_prag.adb | 122 ++++++++++++++++++++++++++------------ gcc/ada/snames.ads-tmpl | 5 +- 5 files changed, 256 insertions(+), 100 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e2b1c7e6d1b..632b6030c20 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2012-11-06 Hristian Kirtchev + + * exp_prag.adb (Expand_Pragma_Loop_Assertion): Update the comment + on intended expansion. Reimplement the logic which expands the + termination variants. + (Process_Increase_Decrease): Update the parameter profile and the + comment related to it. Accommodate the new aggregate-like appearance of + the termination variants. + * sem_prag.adb (Analyze_Pragma): Update the syntax of pragma + Loop_Assertion. Reimplement the semantic analysis of the pragma + to accommodate the new aggregate-like variant. + (Check_Variant): New routine. + * snames.ads-tmpl: Change names Name_Decreases and Name_Increases + to Name_Decreasing and Name_Increasing respectively. Add name + Variant. + +2012-11-06 Ed Schonberg + + * sem_eval.adb: Static evaluation of case expressions. + 2012-11-06 Robert Dewar * exp_prag.adb, impunit.adb, exp_ch9.adb, par-ch4.adb, diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 5ce2aa1b985..5ce90974768 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -807,8 +807,8 @@ package body Exp_Prag is -- -- pragma Loop_Assertion -- (Invariant => Invar_Expr, - -- Increases => Incr_Expr, - -- Decreases => Decr_Expr); + -- Variant => (Increasing => Incr_Expr, + -- Decreasing => Decr_Expr)); -- -- end loop; @@ -855,15 +855,20 @@ package body Exp_Prag is Loop_Stmt : Node_Id; Old_Assign : List_Id := No_List; - procedure Process_Increase_Decrease (Arg : Node_Id; Is_Last : Boolean); - -- Process a single increases/decreases expression. Flag Is_Last should - -- be set when the expression is the last argument to be processed. + procedure Process_Increase_Decrease + (Variant : Node_Id; + Is_Last : Boolean); + -- Process a single increasing / decreasing termination variant. Flag + -- Is_Last should be set when processing the last variant. ------------------------------- -- Process_Increase_Decrease -- ------------------------------- - procedure Process_Increase_Decrease (Arg : Node_Id; Is_Last : Boolean) is + procedure Process_Increase_Decrease + (Variant : Node_Id; + Is_Last : Boolean) + is function Make_Op (Loc : Source_Ptr; Curr_Val : Node_Id; @@ -880,26 +885,21 @@ package body Exp_Prag is Curr_Val : Node_Id; Old_Val : Node_Id) return Node_Id is + Modif : constant Node_Id := First (Choices (Variant)); begin - if Chars (Arg) = Name_Increases then - return - Make_Op_Gt (Loc, - Left_Opnd => Curr_Val, - Right_Opnd => Old_Val); - - else pragma Assert (Chars (Arg) = Name_Decreases); - return - Make_Op_Lt (Loc, - Left_Opnd => Curr_Val, - Right_Opnd => Old_Val); + if Chars (Modif) = Name_Increasing then + return Make_Op_Gt (Loc, Curr_Val, Old_Val); + + else pragma Assert (Chars (Modif) = Name_Decreasing); + return Make_Op_Lt (Loc, Curr_Val, Old_Val); end if; end Make_Op; -- Local variables - Expr : constant Node_Id := Expression (Arg); + Expr : constant Node_Id := Expression (Variant); + Loc : constant Source_Ptr := Sloc (Expr); Loop_Loc : constant Source_Ptr := Sloc (Loop_Stmt); - Cond : Node_Id; Curr_Id : Entity_Id; Old_Id : Entity_Id; Prag : Node_Id; @@ -909,7 +909,8 @@ package body Exp_Prag is begin -- All temporaries generated in this routine must be inserted before -- the related loop statement. Ensure that the proper scope is on the - -- stack when analyzing the temporaries. + -- stack when analyzing the temporaries. Note that we also use the + -- Sloc of the related loop. Push_Scope (Scope (Loop_Scop)); @@ -930,6 +931,21 @@ package body Exp_Prag is New_Reference_To (Standard_Boolean, Loop_Loc), Expression => New_Reference_To (Standard_False, Loop_Loc))); + + -- Prevent an unwanted optimization where the Current_Value of + -- the flag eliminates the if statement which stores the variant + -- values coming from the previous iteration. + + -- Flag : Boolean := False; + -- loop + -- if Flag then -- condition rewritten to False + -- Old_N := Curr_N; -- and if statement eliminated + -- end if; + -- . . . + -- Flag := True; + -- end loop; + + Set_Current_Value (Flag_Id, Empty); end if; -- Step 2: Create the temporaries which store the old and current @@ -1008,16 +1024,22 @@ package body Exp_Prag is -- if Curr /= Old then -- ; - Cond := - Make_Op_Ne (Loc, - Left_Opnd => New_Reference_To (Curr_Id, Loc), - Right_Opnd => New_Reference_To (Old_Id, Loc)); - if No (If_Stmt) then - If_Stmt := - Make_If_Statement (Loc, - Condition => Cond, - Then_Statements => New_List (Prag)); + + -- When there is just one termination variant, do not compare the + -- old and current value for equality, just check the pragma. + + if Is_Last then + If_Stmt := Prag; + else + If_Stmt := + Make_If_Statement (Loc, + Condition => + Make_Op_Ne (Loc, + Left_Opnd => New_Reference_To (Curr_Id, Loc), + Right_Opnd => New_Reference_To (Old_Id, Loc)), + Then_Statements => New_List (Prag)); + end if; -- Generate: -- else @@ -1038,31 +1060,24 @@ package body Exp_Prag is Append_To (Elsif_Parts (If_Stmt), Make_Elsif_Part (Loc, - Condition => Cond, + Condition => + Make_Op_Ne (Loc, + Left_Opnd => New_Reference_To (Curr_Id, Loc), + Right_Opnd => New_Reference_To (Old_Id, Loc)), Then_Statements => New_List (Prag))); end if; end Process_Increase_Decrease; -- Local variables - Args : constant List_Id := Pragma_Argument_Associations (N); - Last_Arg : constant Node_Id := Last (Args); - Arg : Node_Id; - Invar : Node_Id := Empty; + Arg : Node_Id; + Invar : Node_Id := Empty; -- Start of processing for Expand_Pragma_Loop_Assertion begin -- Locate the enclosing loop for which this assertion applies - Loop_Scop := Current_Scope; - while Present (Loop_Scop) - and then Loop_Scop /= Standard_Standard - and then Ekind (Loop_Scop) /= E_Loop - loop - Loop_Scop := Scope (Loop_Scop); - end loop; - Loop_Stmt := N; while Present (Loop_Stmt) and then Nkind (Loop_Stmt) /= N_Loop_Statement @@ -1070,14 +1085,35 @@ package body Exp_Prag is Loop_Stmt := Parent (Loop_Stmt); end loop; + Loop_Scop := Entity (Identifier (Loop_Stmt)); + -- Process all pragma arguments - Arg := First (Args); + Arg := First (Pragma_Argument_Associations (N)); while Present (Arg) loop - if Chars (Arg) = Name_Increases - or else Chars (Arg) = Name_Decreases - then - Process_Increase_Decrease (Arg, Is_Last => Arg = Last_Arg); + + -- Termination variants appear as components in an aggregate + + if Chars (Arg) = Name_Variant then + declare + Variants : constant Node_Id := Expression (Arg); + Last_Var : constant Node_Id := + Last (Component_Associations (Variants)); + Variant : Node_Id; + + begin + Variant := First (Component_Associations (Variants)); + while Present (Variant) loop + Process_Increase_Decrease + (Variant => Variant, + Is_Last => Variant = Last_Var); + + Next (Variant); + end loop; + end; + + -- Invariant + else Invar := Expression (Arg); end if; @@ -1088,13 +1124,19 @@ package body Exp_Prag is -- Verify the invariant expression, generate: -- pragma Assert (); + -- Use the Sloc of the invariant for better error reporting + if Present (Invar) then - Insert_Action (N, - Make_Pragma (Loc, - Chars => Name_Assert, - Pragma_Argument_Associations => New_List ( - Make_Pragma_Argument_Association (Loc, - Expression => Relocate_Node (Invar))))); + declare + Invar_Loc : constant Source_Ptr := Sloc (Invar); + begin + Insert_Action (N, + Make_Pragma (Invar_Loc, + Chars => Name_Assert, + Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Invar_Loc, + Expression => Relocate_Node (Invar))))); + end; end if; -- Construct the segment which stores the old values of all expressions. @@ -1135,7 +1177,8 @@ package body Exp_Prag is Expression => New_Reference_To (Standard_True, Loc))))); end if; - -- Need a comment on this final rewrite ??? + -- The original pragma has been transformed into a complex sequence of + -- statements and does not need to remain in the tree. Rewrite (N, Make_Null_Statement (Loc)); Analyze (N); diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index f7e774308fb..42174631ba8 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -1759,21 +1759,63 @@ package body Sem_Eval is -- Eval_Case_Expression -- -------------------------- - -- Right now we do not attempt folding of any case expressions, and the - -- language does not require it, so the only required processing is to - -- do the check for all expressions appearing in the case expression. + -- A conditional expression is static if all its conditions and dependent + -- expressions are static. procedure Eval_Case_Expression (N : Node_Id) is - Alt : Node_Id; + Alt : Node_Id; + Choice : Node_Id; + Is_Static : Boolean; + Result : Node_Id; + Val : Uint; begin - Check_Non_Static_Context (Expression (N)); + Result := Empty; + Is_Static := True; + + if Is_Static_Expression (Expression (N)) then + Val := Expr_Value (Expression (N)); + + else + Check_Non_Static_Context (Expression (N)); + Is_Static := False; + end if; Alt := First (Alternatives (N)); - while Present (Alt) loop - Check_Non_Static_Context (Expression (Alt)); + + Search : while Present (Alt) loop + if not Is_Static + or else not Is_Static_Expression (Expression (Alt)) + then + Check_Non_Static_Context (Expression (Alt)); + Is_Static := False; + + else + Choice := First (Discrete_Choices (Alt)); + while Present (Choice) loop + if Nkind (Choice) = N_Others_Choice then + Result := Expression (Alt); + exit Search; + + elsif Expr_Value (Choice) = Val then + Result := Expression (Alt); + exit Search; + + else + Next (Choice); + end if; + end loop; + end if; + Next (Alt); - end loop; + end loop Search; + + if Is_Static then + Rewrite (N, Relocate_Node (Result)); + + else + Set_Is_Static_Expression (N, False); + end if; end Eval_Case_Expression; ------------------------ diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c2392cb0cbc..325ca0c3bc3 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -11288,18 +11288,71 @@ package body Sem_Prag is -- Loop_Assertion -- -------------------- - -- pragma Loop_Assertion ( - -- [[Invariant =>] boolean_EXPRESSION], - -- {CHANGE_MODE => discrete_EXPRESSION} ); + -- pragma Loop_Assertion + -- ( [Invariant =>] boolean_Expression + -- | [Invariant =>] boolean_Expression , + -- Variant => TERMINATION_VARIANTS + -- | Variant => TERMINATION_VARIANTS ); -- - -- CHANGE_MODE ::= Increases | Decreases + -- TERMINATION_VARIANTS ::= + -- ( TERMINATION_VARIANT {, TERMINATION_VARIANT} ) + -- + -- TERMINATION_VARIANT ::= CHANGE_MODIFIER => discrete_EXPRESSION + -- + -- CHANGE_MODIFIER ::= Increasing | Decreasing when Pragma_Loop_Assertion => Loop_Assertion : declare - Arg : Node_Id; - Expr : Node_Id; - Seen : Boolean := False; + procedure Check_Variant (Arg : Node_Id); + -- Verify the legality of a variant + + ------------------- + -- Check_Variant -- + ------------------- + + procedure Check_Variant (Arg : Node_Id) is + Expr : constant Node_Id := Expression (Arg); + + begin + -- Variants appear in aggregate form + + if Nkind (Expr) = N_Aggregate then + declare + Comp : Node_Id; + Extra : Node_Id; + Modif : Node_Id; + + begin + Comp := First (Component_Associations (Expr)); + while Present (Comp) loop + Modif := First (Choices (Comp)); + Extra := Next (Modif); + + Check_Arg_Is_One_Of + (Modif, Name_Decreasing, Name_Increasing); + + if Present (Extra) then + Error_Pragma_Arg + ("only one modifier allowed in argument", Expr); + end if; + + Preanalyze_And_Resolve + (Expression (Comp), Any_Discrete); + + Next (Comp); + end loop; + end; + else + Error_Pragma_Arg + ("expression on variant must be an aggregate", Expr); + end if; + end Check_Variant; + + -- Local variables + Stmt : Node_Id; + -- Start of processing for Loop_Assertion + begin GNAT_Pragma; S14_Pragma; @@ -11324,46 +11377,43 @@ package body Sem_Prag is end if; Check_At_Least_N_Arguments (1); + Check_At_Most_N_Arguments (2); - -- Process the arguments + -- Process the first argument - Arg := Arg1; - while Present (Arg) loop - Expr := Expression (Arg); + if Chars (Arg1) = Name_Variant then + Check_Variant (Arg1); - -- All expressions are preanalyzed because they will be - -- relocated during expansion and analyzed in their new - -- context. + elsif Chars (Arg1) = No_Name + or else Chars (Arg1) = Name_Invariant + then + Preanalyze_And_Resolve (Expression (Arg1), Any_Boolean); - if Chars (Arg) = Name_Invariant - or else - (Arg_Count = 1 - and then Chars (Arg) /= Name_Increases - and then Chars (Arg) /= Name_Decreases) - then - -- Only one invariant is allowed in the pragma + else + Error_Pragma_Arg ("argument not allowed in pragma %", Arg1); + end if; - if Seen then - Error_Pragma_Arg - ("only one invariant allowed in pragma %", Arg); + -- Process the second argument + + if Present (Arg2) then + if Chars (Arg2) = Name_Variant then + if Chars (Arg1) = Name_Variant then + Error_Pragma ("only one variant allowed in pragma %"); else - Seen := True; - Preanalyze_And_Resolve (Expr, Any_Boolean); + Check_Variant (Arg2); end if; - elsif Chars (Arg) = Name_Increases - or else Chars (Arg) = Name_Decreases - then - Preanalyze_And_Resolve (Expr, Any_Discrete); - - -- Illegal argument + elsif Chars (Arg2) = Name_Invariant then + if Chars (Arg1) = Name_Variant then + Error_Pragma_Arg ("invariant must precede variant", Arg2); + else + Error_Pragma ("only one invariant allowed in pragma %"); + end if; else - Error_Pragma_Arg ("argument not allowed in pragma %", Arg); + Error_Pragma_Arg ("argument not allowed in pragma %", Arg2); end if; - - Next (Arg); - end loop; + end if; end Loop_Assertion; ----------------------- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index f44c6898fa4..be0b7ff7e37 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -671,7 +671,7 @@ package Snames is Name_Component_Size_4 : constant Name_Id := N + $; Name_Copy : constant Name_Id := N + $; Name_D_Float : constant Name_Id := N + $; - Name_Decreases : constant Name_Id := N + $; + Name_Decreasing : constant Name_Id := N + $; Name_Descriptor : constant Name_Id := N + $; Name_Disable : constant Name_Id := N + $; Name_Dot_Replacement : constant Name_Id := N + $; @@ -691,7 +691,7 @@ package Snames is Name_GPL : constant Name_Id := N + $; Name_IEEE_Float : constant Name_Id := N + $; Name_Ignore : constant Name_Id := N + $; - Name_Increases : constant Name_Id := N + $; + Name_Increasing : constant Name_Id := N + $; Name_Info : constant Name_Id := N + $; Name_Internal : constant Name_Id := N + $; Name_Link_Name : constant Name_Id := N + $; @@ -753,6 +753,7 @@ package Snames is Name_Unrestricted : constant Name_Id := N + $; Name_Uppercase : constant Name_Id := N + $; Name_User : constant Name_Id := N + $; + Name_Variant : constant Name_Id := N + $; Name_VAX_Float : constant Name_Id := N + $; Name_VMS : constant Name_Id := N + $; Name_Vtable_Ptr : constant Name_Id := N + $; -- cgit v1.2.1