+2012-11-06 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * sem_eval.adb: Static evaluation of case expressions.
+
2012-11-06 Robert Dewar <dewar@adacore.com>
* exp_prag.adb, impunit.adb, exp_ch9.adb, par-ch4.adb,
-- <preceding source statements>
-- pragma Loop_Assertion
-- (Invariant => Invar_Expr,
- -- Increases => Incr_Expr,
- -- Decreases => Decr_Expr);
+ -- Variant => (Increasing => Incr_Expr,
+ -- Decreasing => Decr_Expr));
-- <succeeding source statements>
-- end loop;
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;
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;
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));
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
-- if Curr /= Old then
-- <Prag>;
- 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
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
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;
-- Verify the invariant expression, generate:
-- pragma Assert (<Invar>);
+ -- 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.
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);
-- 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;
------------------------
-- 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;
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;
-----------------------
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 + $;
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 + $;
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 + $;
projects / platform / upstream / gcc.git / commitdiff