+2014-02-19 Robert Dewar <dewar@adacore.com>
+
+ * exp_attr.adb (Expand_Min_Max_Attribute): New procedure
+ (Expand_N_Attribute_Reference): Use this procedure for Min and Max.
+ * exp_ch4.adb (Expand_N_Expression_With_Actions): Remove object
+ declarations from list of actions.
+ * output.ads, output.adb (Delete_Last_Char): New procedure.
+ * sinfo.ads: Document handling of Mod and expression with actions
+ in Modify_Tree_For_C mode.
+
+2014-02-19 Ed Schonberg <schonberg@adacore.com>
+
+ * par-ch9.adb (P_Task): Add a null statement to produce a
+ well-formed task body when due to a previous syntax error the
+ statement list is empty.
+
+2014-02-19 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_prag.adb (Check_Dependency_Clause): Account
+ for the case where a state with a non-null refinement matches a
+ null output list. Comment reformatting.
+ (Inputs_Match): Copy a solitary input to avoid an assertion failure
+ when trying to match the same input in multiple clauses.
+
+2014-02-19 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_attr.adb: Minor typo fix.
+
2014-02-18 Robert Dewar <dewar@adacore.com>
* cstand.adb (Build_Signed_Integer_Type): Minor change of formal
-- Handle the expansion of attribute 'Loop_Entry. As a result, the related
-- loop may be converted into a conditional block. See body for details.
+ procedure Expand_Min_Max_Attribute (N : Node_Id);
+ -- Handle the expansion of attributes 'Max and 'Min, including expanding
+ -- then out if we are in Modify_Tree_For_C mode.
+
procedure Expand_Pred_Succ_Attribute (N : Node_Id);
-- Handles expansion of Pred or Succ attributes for case of non-real
-- operand with overflow checking required.
end if;
end Expand_Loop_Entry_Attribute;
+ ------------------------------
+ -- Expand_Min_Max_Attribute --
+ ------------------------------
+
+ procedure Expand_Min_Max_Attribute (N : Node_Id) is
+ begin
+ -- Min and Max are handled by the back end (except that static cases
+ -- have already been evaluated during semantic processing, although the
+ -- back end should not count on this). The one bit of special processing
+ -- required in the normal case is that these two attributes typically
+ -- generate conditionals in the code, so check the relevant restriction.
+
+ Check_Restriction (No_Implicit_Conditionals, N);
+
+ -- In Modify_Tree_For_C mode, we rewrite as an if expression
+
+ if Modify_Tree_For_C then
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Typ : constant Entity_Id := Etype (N);
+ Expr : constant Node_Id := First (Expressions (N));
+ Left : constant Node_Id := Relocate_Node (Expr);
+ Right : constant Node_Id := Relocate_Node (Next (Expr));
+ Ltyp : constant Entity_Id := Etype (Left);
+ Rtyp : constant Entity_Id := Etype (Right);
+
+ function Make_Compare (Left, Right : Node_Id) return Node_Id;
+ -- Returns Left >= Right for Max, Left <= Right for Min
+
+ ------------------
+ -- Make_Compare --
+ ------------------
+
+ function Make_Compare (Left, Right : Node_Id) return Node_Id is
+ begin
+ if Attribute_Name (N) = Name_Max then
+ return
+ Make_Op_Ge (Loc,
+ Left_Opnd => Left,
+ Right_Opnd => Right);
+ else
+ return
+ Make_Op_Le (Loc,
+ Left_Opnd => Left,
+ Right_Opnd => Right);
+ end if;
+ end Make_Compare;
+
+ -- Start of processing for Min_Max
+
+ begin
+ -- If both Left and Right are simple entity names, then we can
+ -- just use Duplicate_Expr to duplicate the references and return
+
+ -- (if Left >=|<= Right then Left else Right)
+
+ if Is_Entity_Name (Left) and then Is_Entity_Name (Right) then
+ Rewrite (N,
+ Make_If_Expression (Loc,
+ Expressions => New_List (
+ Make_Compare (Left, Right),
+ Duplicate_Subexpr_No_Checks (Left),
+ Duplicate_Subexpr_No_Checks (Right))));
+
+ -- Otherwise we wrap things in an expression with actions. You
+ -- might think we could just use the approach above, but there
+ -- are problems, in particular with escaped discriminants. In
+ -- this case we generate:
+
+ -- do
+ -- T1 : constant typ := Left;
+ -- T2 : constant typ := Right;
+ -- in
+ -- (if T1 >=|<= T2 then T1 else T2)
+ -- end;
+
+ else
+ declare
+ T1 : constant Entity_Id := Make_Temporary (Loc, 'T', Left);
+ T2 : constant Entity_Id := Make_Temporary (Loc, 'T', Left);
+
+ begin
+ Rewrite (N,
+ Make_Expression_With_Actions (Loc,
+ Actions => New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => T1,
+ Object_Definition => New_Occurrence_Of (Ltyp, Loc),
+ Expression => Left),
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => T2,
+ Object_Definition => New_Occurrence_Of (Rtyp, Loc),
+ Expression => Right)),
+
+ Expression =>
+ Make_If_Expression (Loc,
+ Expressions => New_List (
+ Make_Compare
+ (New_Occurrence_Of (T1, Loc),
+ New_Occurrence_Of (T2, Loc)),
+ New_Occurrence_Of (T1, Loc),
+ New_Occurrence_Of (T2, Loc)))));
+ end;
+ end if;
+
+ Analyze_And_Resolve (N, Typ);
+ end;
+ end if;
+ end Expand_Min_Max_Attribute;
+
----------------------------------
-- Expand_N_Attribute_Reference --
----------------------------------
---------
when Attribute_Max =>
-
- -- Max is handled by the back end (except that static cases have
- -- already been evaluated during semantic processing, but anyway
- -- the back end should not count on this). The one bit of special
- -- processing required in the normal case is that this attribute
- -- typically generates conditionals in the code, so we must check
- -- the relevant restriction.
-
- Check_Restriction (No_Implicit_Conditionals, N);
-
- -- In Modify_Tree_For_C mode, we rewrite as an if expression
-
- if Modify_Tree_For_C then
- declare
- Loc : constant Source_Ptr := Sloc (N);
- Typ : constant Entity_Id := Etype (N);
- Expr : constant Node_Id := First (Expressions (N));
- Left : constant Node_Id := Relocate_Node (Expr);
- Right : constant Node_Id := Relocate_Node (Next (Expr));
-
- begin
- Rewrite (N,
- Make_If_Expression (Loc,
- Expressions => New_List (
- Make_Op_Ge (Loc,
- Left_Opnd => Left,
- Right_Opnd => Right),
- Duplicate_Subexpr_No_Checks (Left),
- Duplicate_Subexpr_No_Checks (Right))));
- Analyze_And_Resolve (N, Typ);
- end;
- end if;
+ Expand_Min_Max_Attribute (N);
----------------------------------
-- Max_Size_In_Storage_Elements --
when Attribute_Mechanism_Code =>
- -- We must replace the prefix in the renamed case
+ -- We must replace the prefix i the renamed case
if Is_Entity_Name (Pref)
and then Present (Alias (Entity (Pref)))
---------
when Attribute_Min =>
-
- -- Min is handled by the back end (except that static cases have
- -- already been evaluated during semantic processing, but anyway
- -- the back end should not count on this). The one bit of special
- -- processing required in the normal case is that this attribute
- -- typically generates conditionals in the code, so we must check
- -- the relevant restriction.
-
- Check_Restriction (No_Implicit_Conditionals, N);
-
- -- In Modify_Tree_For_C mode, we rewrite as an if expression
-
- if Modify_Tree_For_C then
- declare
- Loc : constant Source_Ptr := Sloc (N);
- Typ : constant Entity_Id := Etype (N);
- Expr : constant Node_Id := First (Expressions (N));
- Left : constant Node_Id := Relocate_Node (Expr);
- Right : constant Node_Id := Relocate_Node (Next (Expr));
-
- begin
- Rewrite (N,
- Make_If_Expression (Loc,
- Expressions => New_List (
- Make_Op_Le (Loc,
- Left_Opnd => Left,
- Right_Opnd => Right),
- Duplicate_Subexpr_No_Checks (Left),
- Duplicate_Subexpr_No_Checks (Right))));
- Analyze_And_Resolve (N, Typ);
- end;
- end if;
+ Expand_Min_Max_Attribute (N);
---------
-- Mod --
-- Local variables
+ Loc : Source_Ptr;
Act : Node_Id;
+ Def : Entity_Id;
+ Exp : Node_Id;
+ Nxt : Node_Id;
-- Start of processing for Expand_N_Expression_With_Actions
begin
+ -- Process the actions as described above
+
Act := First (Actions (N));
+ while Present (Act) loop
+ Process_Single_Action (Act);
+ Next (Act);
+ end loop;
+
+ -- In Modify_Tree_For_C, we have trouble in C with object declarations
+ -- in the actions list (expressions are fine). So if we have an object
+ -- declaration, insert it higher in the tree, if necessary replacing it
+ -- with an assignment to capture initialization.
+
+ if Modify_Tree_For_C then
+ Act := First (Actions (N));
+ while Present (Act) loop
+ if Nkind (Act) = N_Object_Declaration then
+ Def := Defining_Identifier (Act);
+ Exp := Expression (Act);
+ Set_Constant_Present (Act, False);
+ Set_Expression (Act, Empty);
+ Insert_Action (N, Relocate_Node (Act));
+
+ Loc := Sloc (Act);
+
+ -- Expression present, rewrite as assignment, get next action
+
+ if Present (Exp) then
+ Rewrite (Act,
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Def, Loc),
+ Expression => Exp));
+ Next (Act);
+
+ -- No expression, remove action and move to next
+
+ else
+ Nxt := Next (Act);
+ Remove (Act);
+ Act := Nxt;
+ end if;
+
+ -- Not an object declaration, move to next action
+
+ else
+ Next (Act);
+ end if;
+ end loop;
+ end if;
-- Deal with case where there are no actions. In this case we simply
-- rewrite the node with its expression since we don't need the actions
-- tree in cases like this. This raises a whole lot of issues of whether
-- we have problems elsewhere, which will be addressed in the future???
- if No (Act) then
+ if Is_Empty_List (Actions (N)) then
Rewrite (N, Relocate_Node (Expression (N)));
-
- -- Otherwise process the actions as described above
-
- else
- loop
- Process_Single_Action (Act);
- Next (Act);
- exit when No (Act);
- end loop;
end if;
end Expand_N_Expression_With_Actions;
return Pos (Next_Col);
end Column;
+ ----------------------
+ -- Delete_Last_Char --
+ ----------------------
+
+ procedure Delete_Last_Char is
+ begin
+ if Next_Col /= 1 then
+ Next_Col := Next_Col - 1;
+ end if;
+ end Delete_Last_Char;
+
------------------
-- Flush_Buffer --
------------------
-- Returns last character written on the current line, or null if the
-- current line is (so far) empty.
+ procedure Delete_Last_Char;
+ -- Deletes last character written on the current line, no effect if the
+ -- current line is (so far) empty.
+
function Column return Pos;
pragma Inline (Column);
-- Returns the number of the column about to be written (e.g. a value of 1
end if;
Parse_Decls_Begin_End (Task_Node);
+
+ -- The statement list of a task body needs to include at least a
+ -- null statement, so if a parsing error produces an empty list,
+ -- patch it now.
+
+ if
+ No (First (Statements (Handled_Statement_Sequence (Task_Node))))
+ then
+ Set_Statements (Handled_Statement_Sequence (Task_Node),
+ New_List (Make_Null_Statement (Token_Ptr)));
+ end if;
end if;
return Task_Node;
-- Entities mentioned within the prefix of attribute 'Old must
-- be global to the related postcondition. If this is not the
- -- case, then the scope of the local entity is be nested within
+ -- case, then the scope of the local entity is nested within
-- that of the subprogram.
elsif Nkind (Nod) = N_Identifier
elsif Has_Non_Null_Refinement (Dep_Id) then
Has_Refined_State := True;
- if Is_Entity_Name (Ref_Output) then
- Ref_Id := Entity_Of (Ref_Output);
+ -- Account for the case where a state with a non-null
+ -- refinement matches a null output list:
+
+ -- Refined_State => (State_1 => (C1, C2),
+ -- State_2 => (C3, C4))
+ -- Depends => (State_1 => State_2)
+ -- Refined_Depends => (null => C3)
+
+ if Nkind (Ref_Output) = N_Null
+ and then Inputs_Match
+ (Dep_Clause => Dep_Clause,
+ Ref_Clause => Ref_Clause,
+ Post_Errors => False)
+ then
+ Has_Constituent := True;
- -- The output of the refinement clause is a valid
- -- constituent of the state. Remove the clause from
- -- the pool of candidates if both input lists match.
- -- Note that the search continues because one clause
- -- may have been normalized into multiple clauses as
- -- per the example above.
+ -- Note that the search continues after the clause is
+ -- removed from the pool of candidates because it may
+ -- have been normalized into multiple simple clauses.
+
+ Remove (Ref_Clause);
+
+ -- Otherwise the output of the refinement clause must be
+ -- a valid constituent of the state:
+
+ -- Refined_State => (State => (C1, C2))
+ -- Depends => (State => <input>)
+ -- Refined_Depends => (C1 => <input>)
+
+ elsif Is_Entity_Name (Ref_Output) then
+ Ref_Id := Entity_Of (Ref_Output);
if Ekind_In (Ref_Id, E_Abstract_State, E_Variable)
and then Present (Encapsulating_State (Ref_Id))
Post_Errors => False)
then
Has_Constituent := True;
+
+ -- Note that the search continues after the clause
+ -- is removed from the pool of candidates because
+ -- it may have been normalized into multiple simple
+ -- clauses.
+
Remove (Ref_Clause);
end if;
end if;
begin
-- Construct a list of all refinement inputs. Note that the input
-- list is copied because the algorithm modifies its contents and
- -- this should not be visible in Refined_Depends.
+ -- this should not be visible in Refined_Depends. The same applies
+ -- for a solitary input.
if Nkind (Inputs) = N_Aggregate then
Ref_Inputs := New_Copy_List (Expressions (Inputs));
else
- Ref_Inputs := New_List (Inputs);
+ Ref_Inputs := New_List (New_Copy (Inputs));
end if;
-- Depending on whether the original dependency clause mentions
-- Min and Max attributes are expanded into equivalent if expressions,
-- dealing properly with side effect issues.
+ -- Mod for signed integer types is expanded into equivalent expressions
+ -- using Rem (which is % in C) and other C-available operators.
+
+ -- The Actions list of an Expression_With_Actions node has any object
+ -- declarations removed, so that it is composed only of expressions
+ -- (so that DO X,... Y IN Z can be represented as (X, .. Y, Z) in C).
+
------------------------------------
-- Description of Semantic Fields --
------------------------------------
-- and we are running in ELIMINATED mode, the operator node will be
-- changed to be a call to the appropriate routine in System.Bignums.
+ -- Note: In Modify_Tree_For_C mode, we do not generate an N_Op_Mod node
+ -- for signed integer types (since there is no equivalent operator in
+ -- C). Instead we rewrite such an operation in terms of REM (which is
+ -- % in C) and other C-available operators.
+
------------------------------------
-- 4.5.7 Conditional Expressions --
------------------------------------
-- not a proper expression), and in the long term all cases of this
-- idiom should instead use a new node kind N_Compound_Statement.
+ -- Note: In Modify_Tree_For_C, we eliminate declarations from the list
+ -- of actions, inserting them at the outer level. If we move an object
+ -- declaration with an initialization expression in this manner, then
+ -- the action is replaced by an appropriate assignment, otherwise it is
+ -- removed from the list of actions.
+
--------------------
-- Free Statement --
--------------------
projects / gcc.git / commitdiff