Commit 3c08de34 by Ed Schonberg Committed by Pierre-Marie de Rodat

[Ada] Prototype implementastion of Ada2020 Map-reduce construct

2019-12-16  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* scng.adb (Scan): In Ada2020, a left-bracket indicates the
	start of an homogenous aggregate.
	* par-ch4.adb (P_Reduction_Attribute_Reference): New procedure.
	(P_Aggregate): Recognize Ada2020 bracket-delimited aggregates.
	(P_Primary): Ditto.
	* par-util.adb (Comma_Present): Return false on a right bracket
	in Ada2020, indicating the end of an aggregate.
	* snames.ads-tmpl: Introduce Name_Reduce and Attribute Reduce.
	* sinfo.ads, sinfo.adb (Is_Homogeneous_Aggregate): New flag on
	aggregates, to designate an Ada2020 array or container aggregate
	that is bracket-delimited in the source.
	* sem_attr.adb (Analyze_Attribute): For attribute Reduce, verify
	that two arguments are present, and verify that the prefix is a
	stream or an object that is iterable (array or contrainer).
	(Resolve_Attribute): For attribute Reduce, resolve initial value
	with the type of the context. Type-checking of element type of
	prefix is performed after expansion.
	* exp_attr.adb (Expand_N_Attribute_Reference): For attribute
	Reduce, expand into a loop: a) If prefix is an aggregate with a
	single iterated component association, use its iterator
	specification to construct a loop, b) If prefix is a name, build
	a loop using an element iterator loop.
	* scans.ads: Add brackets tokens.

From-SVN: r279431
parent a517d6c1
2019-12-16 Ed Schonberg <schonberg@adacore.com>
* scng.adb (Scan): In Ada2020, a left-bracket indicates the
start of an homogenous aggregate.
* par-ch4.adb (P_Reduction_Attribute_Reference): New procedure.
(P_Aggregate): Recognize Ada2020 bracket-delimited aggregates.
(P_Primary): Ditto.
* par-util.adb (Comma_Present): Return false on a right bracket
in Ada2020, indicating the end of an aggregate.
* snames.ads-tmpl: Introduce Name_Reduce and Attribute Reduce.
* sinfo.ads, sinfo.adb (Is_Homogeneous_Aggregate): New flag on
aggregates, to designate an Ada2020 array or container aggregate
that is bracket-delimited in the source.
* sem_attr.adb (Analyze_Attribute): For attribute Reduce, verify
that two arguments are present, and verify that the prefix is a
stream or an object that is iterable (array or contrainer).
(Resolve_Attribute): For attribute Reduce, resolve initial value
with the type of the context. Type-checking of element type of
prefix is performed after expansion.
* exp_attr.adb (Expand_N_Attribute_Reference): For attribute
Reduce, expand into a loop: a) If prefix is an aggregate with a
single iterated component association, use its iterator
specification to construct a loop, b) If prefix is a name, build
a loop using an element iterator loop.
* scans.ads: Add brackets tokens.
2019-12-16 Eric Botcazou <ebotcazou@adacore.com> 2019-12-16 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to
......
...@@ -5463,6 +5463,97 @@ package body Exp_Attr is ...@@ -5463,6 +5463,97 @@ package body Exp_Attr is
Apply_Universal_Integer_Attribute_Checks (N); Apply_Universal_Integer_Attribute_Checks (N);
end if; end if;
------------
-- Reduce --
------------
when Attribute_Reduce =>
declare
Loc : constant Source_Ptr := Sloc (N);
E1 : constant Node_Id := First (Expressions (N));
E2 : constant Node_Id := Next (E1);
Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
Typ : constant Entity_Id := Etype (N);
New_Loop : Node_Id;
-- If the prefix is an aggregwte, its unique component is sn
-- Iterated_Element, and we create a loop out of its itertor.
begin
if Nkind (Prefix (N)) = N_Aggregate then
declare
Stream : constant Node_Id :=
First (Component_Associations (Prefix (N)));
Id : constant Node_Id := Defining_Identifier (Stream);
Expr : constant Node_Id := Expression (Stream);
Ch : constant Node_Id :=
First (Discrete_Choices (Stream));
begin
New_Loop := Make_Loop_Statement (Loc,
Iteration_Scheme =>
Make_Iteration_Scheme (Loc,
Iterator_Specification => Empty,
Loop_Parameter_Specification =>
Make_Loop_Parameter_Specification (Loc,
Defining_Identifier => New_Copy (Id),
Discrete_Subtype_Definition =>
Relocate_Node (Ch))),
End_Label => Empty,
Statements => New_List (
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Bnn, Loc),
Expression => Make_Function_Call (Loc,
Name => New_Occurrence_Of (Entity (E1), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Bnn, Loc),
Relocate_Node (Expr))))));
end;
else
-- If the prefix is a name we construct an element iterwtor
-- over it. Its expansion will verify that it is an array
-- or a container with the proper aspects.
declare
Iter : Node_Id;
Elem : constant Entity_Id := Make_Temporary (Loc, 'E', N);
begin
Iter :=
Make_Iterator_Specification (Loc,
Defining_Identifier => Elem,
Name => Relocate_Node (Prefix (N)),
Subtype_Indication => Empty);
Set_Of_Present (Iter);
New_Loop := Make_Loop_Statement (Loc,
Iteration_Scheme =>
Make_Iteration_Scheme (Loc,
Iterator_Specification => Iter,
Loop_Parameter_Specification => Empty),
End_Label => Empty,
Statements => New_List (
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Bnn, Loc),
Expression => Make_Function_Call (Loc,
Name => New_Occurrence_Of (Entity (E1), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Bnn, Loc),
New_Occurrence_Of (Elem, Loc))))));
end;
end if;
Rewrite (N,
Make_Expression_With_Actions (Loc,
Actions => New_List (
Make_Object_Declaration (Loc,
Defining_Identifier => Bnn,
Object_Definition =>
New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (E2)), New_Loop),
Expression => New_Occurrence_Of (Bnn, Loc)));
Analyze_And_Resolve (N, Typ);
end;
---------- ----------
-- Read -- -- Read --
---------- ----------
......
...@@ -81,6 +81,8 @@ package body Ch4 is ...@@ -81,6 +81,8 @@ package body Ch4 is
function P_Primary return Node_Id; function P_Primary return Node_Id;
function P_Relation return Node_Id; function P_Relation return Node_Id;
function P_Term return Node_Id; function P_Term return Node_Id;
function P_Reduction_Attribute_Reference (S : Node_Id)
return Node_Id;
function P_Binary_Adding_Operator return Node_Kind; function P_Binary_Adding_Operator return Node_Kind;
function P_Logical_Operator return Node_Kind; function P_Logical_Operator return Node_Kind;
...@@ -1202,12 +1204,48 @@ package body Ch4 is ...@@ -1202,12 +1204,48 @@ package body Ch4 is
return Attr_Node; return Attr_Node;
end P_Range_Attribute_Reference; end P_Range_Attribute_Reference;
-------------------------------------
-- P_Reduction_Attribute_Reference --
-------------------------------------
function P_Reduction_Attribute_Reference (S : Node_Id)
return Node_Id
is
Attr_Node : Node_Id;
Attr_Name : Name_Id;
begin
Attr_Name := Token_Name;
Scan; -- past Reduce
Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
Set_Attribute_Name (Attr_Node, Attr_Name);
if Attr_Name /= Name_Reduce then
Error_Msg ("reduce attribute expected", Prev_Token_Ptr);
end if;
Set_Prefix (Attr_Node, S);
Set_Expressions (Attr_Node, New_List);
T_Left_Paren;
Append (P_Name, Expressions (Attr_Node));
T_Comma;
Append (P_Expression, Expressions (Attr_Node));
T_Right_Paren;
return Attr_Node;
end P_Reduction_Attribute_Reference;
--------------------------------------- ---------------------------------------
-- 4.1.4 Range Attribute Designator -- -- 4.1.4 Range Attribute Designator --
--------------------------------------- ---------------------------------------
-- Parsed by P_Range_Attribute_Reference (4.4) -- Parsed by P_Range_Attribute_Reference (4.4)
---------------------------------------------
-- 4.1.4 (2) Reduction_Attribute_Reference --
---------------------------------------------
-- parsed by P_Reduction_Attribute_Reference
-------------------- --------------------
-- 4.3 Aggregate -- -- 4.3 Aggregate --
-------------------- --------------------
...@@ -1229,6 +1267,7 @@ package body Ch4 is ...@@ -1229,6 +1267,7 @@ package body Ch4 is
if Nkind (Aggr_Node) /= N_Aggregate if Nkind (Aggr_Node) /= N_Aggregate
and then and then
Nkind (Aggr_Node) /= N_Extension_Aggregate Nkind (Aggr_Node) /= N_Extension_Aggregate
and then Ada_Version < Ada_2020
then then
Error_Msg Error_Msg
("aggregate may not have single positional component", Aggr_Sloc); ("aggregate may not have single positional component", Aggr_Sloc);
...@@ -1343,7 +1382,21 @@ package body Ch4 is ...@@ -1343,7 +1382,21 @@ package body Ch4 is
begin begin
Lparen_Sloc := Token_Ptr; Lparen_Sloc := Token_Ptr;
T_Left_Paren; if Token = Tok_Left_Bracket and then Ada_Version >= Ada_2020 then
Scan;
-- Special case for null aggregate in Ada2020.
if Token = Tok_Right_Bracket then
Scan; -- past ]
Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
Set_Expressions (Aggregate_Node, New_List);
Set_Is_Homogeneous_Aggregate (Aggregate_Node);
return Aggregate_Node;
end if;
else
T_Left_Paren;
end if;
-- Note on parentheses count. For cases like an if expression, the -- Note on parentheses count. For cases like an if expression, the
-- parens here really count as real parentheses for the paren count, -- parens here really count as real parentheses for the paren count,
...@@ -1577,6 +1630,14 @@ package body Ch4 is ...@@ -1577,6 +1630,14 @@ package body Ch4 is
Append (Expr_Node, Expr_List); Append (Expr_Node, Expr_List);
elsif Token = Tok_Right_Bracket then
if No (Expr_List) then
Expr_List := New_List;
end if;
Append (Expr_Node, Expr_List);
exit;
-- Anything else is assumed to be a named association -- Anything else is assumed to be a named association
else else
...@@ -1625,7 +1686,19 @@ package body Ch4 is ...@@ -1625,7 +1686,19 @@ package body Ch4 is
-- All component associations (positional and named) have been scanned -- All component associations (positional and named) have been scanned
T_Right_Paren; if Token = Tok_Right_Bracket and then Ada_Version >= Ada_2020 then
Set_Component_Associations (Aggregate_Node, Assoc_List);
Set_Is_Homogeneous_Aggregate (Aggregate_Node);
Scan; -- past right bracket
if Token = Tok_Apostrophe then
Scan;
if Token = Tok_Identifier then
return P_Reduction_Attribute_Reference (Aggregate_Node);
end if;
end if;
else
T_Right_Paren;
end if;
if Nkind (Aggregate_Node) /= N_Delta_Aggregate then if Nkind (Aggregate_Node) /= N_Delta_Aggregate then
Set_Expressions (Aggregate_Node, Expr_List); Set_Expressions (Aggregate_Node, Expr_List);
...@@ -2623,6 +2696,7 @@ package body Ch4 is ...@@ -2623,6 +2696,7 @@ package body Ch4 is
-- | STRING_LITERAL | AGGREGATE -- | STRING_LITERAL | AGGREGATE
-- | NAME | QUALIFIED_EXPRESSION -- | NAME | QUALIFIED_EXPRESSION
-- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
-- | REDUCTION_ATTRIBUTE_REFERENCE
-- Error recovery: can raise Error_Resync -- Error recovery: can raise Error_Resync
...@@ -2715,6 +2789,9 @@ package body Ch4 is ...@@ -2715,6 +2789,9 @@ package body Ch4 is
return Expr; return Expr;
end; end;
when Tok_Left_Bracket =>
return P_Aggregate;
-- Allocator -- Allocator
when Tok_New => when Tok_New =>
......
...@@ -276,8 +276,11 @@ package body Util is ...@@ -276,8 +276,11 @@ package body Util is
-- If we have a right paren, then that is taken as ending the list -- If we have a right paren, then that is taken as ending the list
-- i.e. no comma is present. -- i.e. no comma is present.
-- Ditto for a right bracket in Ada2020.
elsif Token = Tok_Right_Paren then elsif Token = Tok_Right_Paren
or else (Token = Tok_Right_Bracket and then Ada_Version >= Ada_2020)
then
return False; return False;
-- If pragmas, then get rid of them and make a recursive call -- If pragmas, then get rid of them and make a recursive call
......
...@@ -87,11 +87,15 @@ package Scans is ...@@ -87,11 +87,15 @@ package Scans is
-- exception-name". This degrades error recovery slightly, and perhaps -- exception-name". This degrades error recovery slightly, and perhaps
-- we could do better, but not worth the effort. -- we could do better, but not worth the effort.
-- Ada2020 introduces square brackets as delimiters for array and
-- container aggregates.
Tok_Raise, -- RAISE Tok_Raise, -- RAISE
Tok_Dot, -- . Namext Tok_Dot, -- . Namext
Tok_Apostrophe, -- ' Namext Tok_Apostrophe, -- ' Namext
Tok_Left_Bracket, -- [ Namest
Tok_Left_Paren, -- ( Namext, Consk Tok_Left_Paren, -- ( Namext, Consk
Tok_Delta, -- DELTA Atkwd, Sterm, Consk Tok_Delta, -- DELTA Atkwd, Sterm, Consk
...@@ -99,6 +103,7 @@ package Scans is ...@@ -99,6 +103,7 @@ package Scans is
Tok_Range, -- RANGE Atkwd, Sterm, Consk Tok_Range, -- RANGE Atkwd, Sterm, Consk
Tok_Right_Paren, -- ) Sterm Tok_Right_Paren, -- ) Sterm
Tok_Right_Bracket, -- ] Sterm
Tok_Comma, -- , Sterm Tok_Comma, -- , Sterm
Tok_And, -- AND Logop, Sterm Tok_And, -- AND Logop, Sterm
......
...@@ -182,6 +182,7 @@ package body Scng is ...@@ -182,6 +182,7 @@ package body Scng is
| Tok_Integer_Literal | Tok_Integer_Literal
| Tok_Interface | Tok_Interface
| Tok_Is | Tok_Is
| Tok_Left_Bracket
| Tok_Left_Paren | Tok_Left_Paren
| Tok_Less | Tok_Less
| Tok_Less_Equal | Tok_Less_Equal
...@@ -204,6 +205,7 @@ package body Scng is ...@@ -204,6 +205,7 @@ package body Scng is
| Tok_Rem | Tok_Rem
| Tok_Renames | Tok_Renames
| Tok_Reverse | Tok_Reverse
| Tok_Right_Bracket
| Tok_Right_Paren | Tok_Right_Paren
| Tok_Slash | Tok_Slash
| Tok_String_Literal | Tok_String_Literal
...@@ -324,6 +326,7 @@ package body Scng is ...@@ -324,6 +326,7 @@ package body Scng is
| Tok_In | Tok_In
| Tok_Integer_Literal | Tok_Integer_Literal
| Tok_Is | Tok_Is
| Tok_Left_Bracket
| Tok_Left_Paren | Tok_Left_Paren
| Tok_Less | Tok_Less
| Tok_Less_Equal | Tok_Less_Equal
...@@ -340,6 +343,7 @@ package body Scng is ...@@ -340,6 +343,7 @@ package body Scng is
| Tok_Range | Tok_Range
| Tok_Real_Literal | Tok_Real_Literal
| Tok_Rem | Tok_Rem
| Tok_Right_Bracket
| Tok_Right_Paren | Tok_Right_Paren
| Tok_Slash | Tok_Slash
| Tok_String_Literal | Tok_String_Literal
...@@ -1697,6 +1701,11 @@ package body Scng is ...@@ -1697,6 +1701,11 @@ package body Scng is
if Source (Scan_Ptr + 1) = '"' then if Source (Scan_Ptr + 1) = '"' then
goto Scan_Wide_Character; goto Scan_Wide_Character;
elsif Ada_Version = Ada_2020 then
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Left_Bracket;
return;
else else
Error_Msg_S ("illegal character, replaced by ""("""); Error_Msg_S ("illegal character, replaced by ""(""");
Scan_Ptr := Scan_Ptr + 1; Scan_Ptr := Scan_Ptr + 1;
...@@ -2063,6 +2072,7 @@ package body Scng is ...@@ -2063,6 +2072,7 @@ package body Scng is
or else Prev_Token = Tok_Identifier or else Prev_Token = Tok_Identifier
or else Prev_Token = Tok_Project or else Prev_Token = Tok_Project
or else Prev_Token = Tok_Right_Paren or else Prev_Token = Tok_Right_Paren
or else Prev_Token = Tok_Right_Bracket
or else Prev_Token in Token_Class_Literal or else Prev_Token in Token_Class_Literal
then then
Token := Tok_Apostrophe; Token := Tok_Apostrophe;
...@@ -2172,11 +2182,18 @@ package body Scng is ...@@ -2172,11 +2182,18 @@ package body Scng is
return; return;
-- Right bracket or right brace, treated as right paren -- Right bracket or right brace, treated as right paren
-- but proper aggregate delimiter in Ada_2020
when ']' | '}' => when ']' | '}' =>
Error_Msg_S ("illegal character, replaced by "")"""); if Ada_Version >= Ada_2020 then
Token := Tok_Right_Bracket;
else
Error_Msg_S ("illegal character, replaced by "")""");
Token := Tok_Right_Paren;
end if;
Scan_Ptr := Scan_Ptr + 1; Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Right_Paren;
return; return;
-- Slash (can be division operator or first character of not equal) -- Slash (can be division operator or first character of not equal)
......
...@@ -25,6 +25,7 @@ ...@@ -25,6 +25,7 @@
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Aspects; use Aspects;
with Atree; use Atree; with Atree; use Atree;
with Casing; use Casing; with Casing; use Casing;
with Checks; use Checks; with Checks; use Checks;
...@@ -5497,6 +5498,55 @@ package body Sem_Attr is ...@@ -5497,6 +5498,55 @@ package body Sem_Attr is
Check_Discrete_Type; Check_Discrete_Type;
Set_Etype (N, Universal_Integer); Set_Etype (N, Universal_Integer);
------------
-- Reduce --
------------
when Attribute_Reduce =>
Check_E2;
declare
Stream : constant Node_Id := Prefix (N);
Typ : Entity_Id;
begin
if Nkind (Stream) /= N_Aggregate then
-- Prefix is a name, as for other attributes.
-- If the object is a function we asume that it is not
-- overloaded. AI12-242 does not suggest an name resulution
-- rule for that case, but can suppose that the expected
-- type of the reduction is the expected type of the
-- component of the prefix.
Analyze_And_Resolve (Stream);
Typ := Etype (Stream);
-- Verify that prefix can be iterated upon.
if Is_Array_Type (Typ)
or else Present (Find_Aspect (Typ, Aspect_Default_Iterator))
or else Present (Find_Aspect (Typ, Aspect_Iterable))
then
null;
else
Error_Msg_NE
("cannot apply reduce to object of type$", N, Typ);
end if;
elsif Present (Expressions (Stream))
or else No (Component_Associations (Stream))
or else Nkind (First (Component_Associations (Stream))) /=
N_Iterated_Component_Association
then
Error_Msg_N
("Prefix of reduce must be an iterated component", N);
end if;
Analyze (E1);
Analyze (E2);
Set_Etype (N, Etype (E2));
end;
---------- ----------
-- Read -- -- Read --
---------- ----------
...@@ -8241,6 +8291,7 @@ package body Sem_Attr is ...@@ -8241,6 +8291,7 @@ package body Sem_Attr is
| Attribute_Implicit_Dereference | Attribute_Implicit_Dereference
| Attribute_Iterator_Element | Attribute_Iterator_Element
| Attribute_Iterable | Attribute_Iterable
| Attribute_Reduce
| Attribute_Variable_Indexing | Attribute_Variable_Indexing
=> =>
null; null;
...@@ -11651,6 +11702,70 @@ package body Sem_Attr is ...@@ -11651,6 +11702,70 @@ package body Sem_Attr is
return; return;
end Range_Attribute; end Range_Attribute;
-------------
-- Reduce --
-------------
when Attribute_Reduce =>
declare
E1 : constant Node_Id := First (Expressions (N));
E2 : constant Node_Id := Next (E1);
Op : Entity_Id := Empty;
Index : Interp_Index;
It : Interp;
function Proper_Op (Op : Entity_Id) return Boolean;
---------------
-- Proper_Op --
---------------
function Proper_Op (Op : Entity_Id) return Boolean is
F1, F2 : Entity_Id;
begin
F1 := First_Formal (Op);
if No (F1) then
return False;
else
F2 := Next_Formal (F1);
if No (F2)
or else Present (Next_Formal (F2))
then
return False;
else
return
(Ekind (Op) = E_Operator
and then Scope (Op) = Standard_Standard)
or else Covers (Typ, Etype (Op));
end if;
end if;
end Proper_Op;
begin
Resolve (E2, Typ);
if Is_Overloaded (E1) then
Get_First_Interp (E1, Index, It);
while Present (It.Nam) loop
if Proper_Op (It.Nam) then
Op := It.Nam;
Set_Entity (E1, Op);
exit;
end if;
Get_Next_Interp (Index, It);
end loop;
elsif Proper_Op (Entity (E1)) then
Op := Entity (E1);
Set_Etype (N, Typ);
end if;
if No (Op) then
Error_Msg_N ("No visible function for reduction", E1);
end if;
end;
------------ ------------
-- Result -- -- Result --
------------ ------------
......
...@@ -2010,6 +2010,14 @@ package body Sinfo is ...@@ -2010,6 +2010,14 @@ package body Sinfo is
return Flag2 (N); return Flag2 (N);
end Is_Generic_Contract_Pragma; end Is_Generic_Contract_Pragma;
function Is_Homogeneous_Aggregate
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Aggregate);
return Flag14 (N);
end Is_Homogeneous_Aggregate;
function Is_Ignored function Is_Ignored
(N : Node_Id) return Boolean is (N : Node_Id) return Boolean is
begin begin
...@@ -5505,6 +5513,14 @@ package body Sinfo is ...@@ -5505,6 +5513,14 @@ package body Sinfo is
Set_Flag2 (N, Val); Set_Flag2 (N, Val);
end Set_Is_Generic_Contract_Pragma; end Set_Is_Generic_Contract_Pragma;
procedure Set_Is_Homogeneous_Aggregate
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Aggregate);
Set_Flag14 (N, Val);
end Set_Is_Homogeneous_Aggregate;
procedure Set_Is_Ignored procedure Set_Is_Ignored
(N : Node_Id; Val : Boolean := True) is (N : Node_Id; Val : Boolean := True) is
begin begin
......
...@@ -1837,6 +1837,11 @@ package Sinfo is ...@@ -1837,6 +1837,11 @@ package Sinfo is
-- Refined_State -- Refined_State
-- Test_Case -- Test_Case
-- Is_Homogeneous_Aggregate (Flag14)
-- A flag set on an Ada2020 aggregate that uses square brackets as
-- delimiters, and thus denotes an array or container aggregate, or
-- the prefix of a reduction attribute.
-- Is_Ignored (Flag9-Sem) -- Is_Ignored (Flag9-Sem)
-- A flag set in an N_Aspect_Specification or N_Pragma node if there was -- A flag set in an N_Aspect_Specification or N_Pragma node if there was
-- a Check_Policy or Assertion_Policy (or in the case of a Debug_Pragma) -- a Check_Policy or Assertion_Policy (or in the case of a Debug_Pragma)
...@@ -4163,6 +4168,7 @@ package Sinfo is ...@@ -4163,6 +4168,7 @@ package Sinfo is
-- Compile_Time_Known_Aggregate (Flag18-Sem) -- Compile_Time_Known_Aggregate (Flag18-Sem)
-- Expansion_Delayed (Flag11-Sem) -- Expansion_Delayed (Flag11-Sem)
-- Has_Self_Reference (Flag13-Sem) -- Has_Self_Reference (Flag13-Sem)
-- Is_Homogeneous_Aggregate (Flag14)
-- plus fields for expression -- plus fields for expression
-- Note: this structure is used for both record and array aggregates -- Note: this structure is used for both record and array aggregates
...@@ -9855,6 +9861,9 @@ package Sinfo is ...@@ -9855,6 +9861,9 @@ package Sinfo is
function Is_Generic_Contract_Pragma function Is_Generic_Contract_Pragma
(N : Node_Id) return Boolean; -- Flag2 (N : Node_Id) return Boolean; -- Flag2
function Is_Homogeneous_Aggregate
(N : Node_Id) return Boolean; -- Flag14
function Is_Ignored function Is_Ignored
(N : Node_Id) return Boolean; -- Flag9 (N : Node_Id) return Boolean; -- Flag9
...@@ -10967,6 +10976,9 @@ package Sinfo is ...@@ -10967,6 +10976,9 @@ package Sinfo is
procedure Set_Is_Generic_Contract_Pragma procedure Set_Is_Generic_Contract_Pragma
(N : Node_Id; Val : Boolean := True); -- Flag2 (N : Node_Id; Val : Boolean := True); -- Flag2
procedure Set_Is_Homogeneous_Aggregate
(N : Node_Id; Val : Boolean := True); -- Flag14
procedure Set_Is_Ignored procedure Set_Is_Ignored
(N : Node_Id; Val : Boolean := True); -- Flag9 (N : Node_Id; Val : Boolean := True); -- Flag9
...@@ -13521,6 +13533,7 @@ package Sinfo is ...@@ -13521,6 +13533,7 @@ package Sinfo is
pragma Inline (Is_Finalization_Wrapper); pragma Inline (Is_Finalization_Wrapper);
pragma Inline (Is_Folded_In_Parser); pragma Inline (Is_Folded_In_Parser);
pragma Inline (Is_Generic_Contract_Pragma); pragma Inline (Is_Generic_Contract_Pragma);
pragma Inline (Is_Homogeneous_Aggregate);
pragma Inline (Is_Ignored); pragma Inline (Is_Ignored);
pragma Inline (Is_Ignored_Ghost_Pragma); pragma Inline (Is_Ignored_Ghost_Pragma);
pragma Inline (Is_In_Discriminant_Check); pragma Inline (Is_In_Discriminant_Check);
...@@ -13887,6 +13900,7 @@ package Sinfo is ...@@ -13887,6 +13900,7 @@ package Sinfo is
pragma Inline (Set_Is_Finalization_Wrapper); pragma Inline (Set_Is_Finalization_Wrapper);
pragma Inline (Set_Is_Folded_In_Parser); pragma Inline (Set_Is_Folded_In_Parser);
pragma Inline (Set_Is_Generic_Contract_Pragma); pragma Inline (Set_Is_Generic_Contract_Pragma);
pragma Inline (Set_Is_Homogeneous_Aggregate);
pragma Inline (Set_Is_Ignored); pragma Inline (Set_Is_Ignored);
pragma Inline (Set_Is_Ignored_Ghost_Pragma); pragma Inline (Set_Is_Ignored_Ghost_Pragma);
pragma Inline (Set_Is_In_Discriminant_Check); pragma Inline (Set_Is_In_Discriminant_Check);
......
...@@ -1002,6 +1002,7 @@ package Snames is ...@@ -1002,6 +1002,7 @@ package Snames is
Name_Priority : constant Name_Id := N + $; -- Ada 05 Name_Priority : constant Name_Id := N + $; -- Ada 05
Name_Range : constant Name_Id := N + $; Name_Range : constant Name_Id := N + $;
Name_Range_Length : constant Name_Id := N + $; -- GNAT Name_Range_Length : constant Name_Id := N + $; -- GNAT
Name_Reduce : constant Name_Id := N + $;
Name_Ref : constant Name_Id := N + $; -- GNAT Name_Ref : constant Name_Id := N + $; -- GNAT
Name_Restriction_Set : constant Name_Id := N + $; -- GNAT Name_Restriction_Set : constant Name_Id := N + $; -- GNAT
Name_Result : constant Name_Id := N + $; -- GNAT Name_Result : constant Name_Id := N + $; -- GNAT
...@@ -1674,6 +1675,7 @@ package Snames is ...@@ -1674,6 +1675,7 @@ package Snames is
Attribute_Priority, Attribute_Priority,
Attribute_Range, Attribute_Range,
Attribute_Range_Length, Attribute_Range_Length,
Attribute_Reduce,
Attribute_Ref, Attribute_Ref,
Attribute_Restriction_Set, Attribute_Restriction_Set,
Attribute_Result, Attribute_Result,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment