[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

10 files changed, 371 insertions, 5 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0630436..79d2042 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+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>
 
 	* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 8c5981a..f35fa73 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5463,6 +5463,97 @@ package body Exp_Attr is
             Apply_Universal_Integer_Attribute_Checks (N);
          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 --
       ----------
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 986d128..355aeb8 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -81,6 +81,8 @@ package body Ch4 is
    function P_Primary                                 return Node_Id;
    function P_Relation                                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_Logical_Operator                        return Node_Kind;
@@ -1202,12 +1204,48 @@ package body Ch4 is
       return Attr_Node;
    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 --
    ---------------------------------------
 
    --  Parsed by P_Range_Attribute_Reference (4.4)
 
+   ---------------------------------------------
+   -- 4.1.4 (2) Reduction_Attribute_Reference --
+   ---------------------------------------------
+
+   --  parsed by P_Reduction_Attribute_Reference
+
    --------------------
    -- 4.3  Aggregate --
    --------------------
@@ -1229,6 +1267,7 @@ package body Ch4 is
       if Nkind (Aggr_Node) /= N_Aggregate
            and then
          Nkind (Aggr_Node) /= N_Extension_Aggregate
+         and then Ada_Version < Ada_2020
       then
          Error_Msg
            ("aggregate may not have single positional component", Aggr_Sloc);
@@ -1343,7 +1382,21 @@ package body Ch4 is
 
    begin
       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
       --  parens here really count as real parentheses for the paren count,
@@ -1577,6 +1630,14 @@ package body Ch4 is
 
             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
 
          else
@@ -1625,7 +1686,19 @@ package body Ch4 is
 
       --  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
          Set_Expressions (Aggregate_Node, Expr_List);
@@ -2623,6 +2696,7 @@ package body Ch4 is
    --  | STRING_LITERAL   | AGGREGATE
    --  | NAME             | QUALIFIED_EXPRESSION
    --  | ALLOCATOR        | (EXPRESSION) | QUANTIFIED_EXPRESSION
+   --  | REDUCTION_ATTRIBUTE_REFERENCE
 
    --  Error recovery: can raise Error_Resync
 
@@ -2715,6 +2789,9 @@ package body Ch4 is
                   return Expr;
                end;
 
+            when Tok_Left_Bracket =>
+               return P_Aggregate;
+
             --  Allocator
 
             when Tok_New =>
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index 1c32a42..6379c4a 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -276,8 +276,11 @@ package body Util is
 
       --  If we have a right paren, then that is taken as ending the list
       --  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;
 
       --  If pragmas, then get rid of them and make a recursive call
diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads
index abee591..530da54 100644
--- a/gcc/ada/scans.ads
+++ b/gcc/ada/scans.ads
@@ -87,11 +87,15 @@ package Scans is
       --  exception-name". This degrades error recovery slightly, and perhaps
       --  we could do better, but not worth the effort.
 
+      --  Ada2020 introduces square brackets as delimiters for array and
+      --  container aggregates.
+
       Tok_Raise,           -- RAISE
 
       Tok_Dot,             -- .            Namext
       Tok_Apostrophe,      -- '            Namext
 
+      Tok_Left_Bracket,    -- [            Namest
       Tok_Left_Paren,      -- (            Namext, Consk
 
       Tok_Delta,           -- DELTA        Atkwd, Sterm, Consk
@@ -99,6 +103,7 @@ package Scans is
       Tok_Range,           -- RANGE        Atkwd, Sterm, Consk
 
       Tok_Right_Paren,     -- )            Sterm
+      Tok_Right_Bracket,   -- ]            Sterm
       Tok_Comma,           -- ,            Sterm
 
       Tok_And,             -- AND          Logop, Sterm
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 2d290b8..d4c1916 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -182,6 +182,7 @@ package body Scng is
             | Tok_Integer_Literal
             | Tok_Interface
             | Tok_Is
+            | Tok_Left_Bracket
             | Tok_Left_Paren
             | Tok_Less
             | Tok_Less_Equal
@@ -204,6 +205,7 @@ package body Scng is
             | Tok_Rem
             | Tok_Renames
             | Tok_Reverse
+            | Tok_Right_Bracket
             | Tok_Right_Paren
             | Tok_Slash
             | Tok_String_Literal
@@ -324,6 +326,7 @@ package body Scng is
             | Tok_In
             | Tok_Integer_Literal
             | Tok_Is
+            | Tok_Left_Bracket
             | Tok_Left_Paren
             | Tok_Less
             | Tok_Less_Equal
@@ -340,6 +343,7 @@ package body Scng is
             | Tok_Range
             | Tok_Real_Literal
             | Tok_Rem
+            | Tok_Right_Bracket
             | Tok_Right_Paren
             | Tok_Slash
             | Tok_String_Literal
@@ -1697,6 +1701,11 @@ package body Scng is
             if Source (Scan_Ptr + 1) = '"' then
                goto Scan_Wide_Character;
 
+            elsif Ada_Version = Ada_2020 then
+               Scan_Ptr := Scan_Ptr + 1;
+               Token := Tok_Left_Bracket;
+               return;
+
             else
                Error_Msg_S ("illegal character, replaced by ""(""");
                Scan_Ptr := Scan_Ptr + 1;
@@ -2063,6 +2072,7 @@ package body Scng is
               or else Prev_Token = Tok_Identifier
               or else Prev_Token = Tok_Project
               or else Prev_Token = Tok_Right_Paren
+              or else Prev_Token = Tok_Right_Bracket
               or else Prev_Token in Token_Class_Literal
             then
                Token := Tok_Apostrophe;
@@ -2172,11 +2182,18 @@ package body Scng is
             return;
 
          --  Right bracket or right brace, treated as right paren
+         --  but proper aggregate delimiter in Ada_2020
 
          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;
-            Token := Tok_Right_Paren;
             return;
 
          --  Slash (can be division operator or first character of not equal)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index dcc40d2..72729ec 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -25,6 +25,7 @@
 
 with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Casing;   use Casing;
 with Checks;   use Checks;
@@ -5497,6 +5498,55 @@ package body Sem_Attr is
          Check_Discrete_Type;
          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 --
       ----------
@@ -8241,6 +8291,7 @@ package body Sem_Attr is
          | Attribute_Implicit_Dereference
          | Attribute_Iterator_Element
          | Attribute_Iterable
+         | Attribute_Reduce
          | Attribute_Variable_Indexing
       =>
          null;
@@ -11651,6 +11702,70 @@ package body Sem_Attr is
             return;
          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 --
          ------------
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index b99a32d..41cb8c8 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2010,6 +2010,14 @@ package body Sinfo is
       return Flag2 (N);
    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
       (N : Node_Id) return Boolean is
    begin
@@ -5505,6 +5513,14 @@ package body Sinfo is
       Set_Flag2 (N, Val);
    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
       (N : Node_Id; Val : Boolean := True) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 5e04772..706007b 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1837,6 +1837,11 @@ package Sinfo is
    --      Refined_State
    --      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)
    --    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)
@@ -4163,6 +4168,7 @@ package Sinfo is
       --  Compile_Time_Known_Aggregate (Flag18-Sem)
       --  Expansion_Delayed (Flag11-Sem)
       --  Has_Self_Reference (Flag13-Sem)
+      --  Is_Homogeneous_Aggregate (Flag14)
       --  plus fields for expression
 
       --  Note: this structure is used for both record and array aggregates
@@ -9855,6 +9861,9 @@ package Sinfo is
    function Is_Generic_Contract_Pragma
      (N : Node_Id) return Boolean;    -- Flag2
 
+   function Is_Homogeneous_Aggregate
+     (N : Node_Id) return Boolean;    -- Flag14
+
    function Is_Ignored
      (N : Node_Id) return Boolean;    -- Flag9
 
@@ -10967,6 +10976,9 @@ package Sinfo is
    procedure Set_Is_Generic_Contract_Pragma
      (N : Node_Id; Val : Boolean := True);    -- Flag2
 
+   procedure Set_Is_Homogeneous_Aggregate
+     (N : Node_Id; Val : Boolean := True);    -- Flag14
+
    procedure Set_Is_Ignored
      (N : Node_Id; Val : Boolean := True);    -- Flag9
 
@@ -13521,6 +13533,7 @@ package Sinfo is
    pragma Inline (Is_Finalization_Wrapper);
    pragma Inline (Is_Folded_In_Parser);
    pragma Inline (Is_Generic_Contract_Pragma);
+   pragma Inline (Is_Homogeneous_Aggregate);
    pragma Inline (Is_Ignored);
    pragma Inline (Is_Ignored_Ghost_Pragma);
    pragma Inline (Is_In_Discriminant_Check);
@@ -13887,6 +13900,7 @@ package Sinfo is
    pragma Inline (Set_Is_Finalization_Wrapper);
    pragma Inline (Set_Is_Folded_In_Parser);
    pragma Inline (Set_Is_Generic_Contract_Pragma);
+   pragma Inline (Set_Is_Homogeneous_Aggregate);
    pragma Inline (Set_Is_Ignored);
    pragma Inline (Set_Is_Ignored_Ghost_Pragma);
    pragma Inline (Set_Is_In_Discriminant_Check);
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 985a19f..9d8f13b 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -1002,6 +1002,7 @@ package Snames is
    Name_Priority                       : constant Name_Id := N + $; -- Ada 05
    Name_Range                          : constant Name_Id := N + $;
    Name_Range_Length                   : constant Name_Id := N + $; -- GNAT
+   Name_Reduce                         : constant Name_Id := N + $;
    Name_Ref                            : constant Name_Id := N + $; -- GNAT
    Name_Restriction_Set                : constant Name_Id := N + $; -- GNAT
    Name_Result                         : constant Name_Id := N + $; -- GNAT
@@ -1674,6 +1675,7 @@ package Snames is
       Attribute_Priority,
       Attribute_Range,
       Attribute_Range_Length,
+      Attribute_Reduce,
       Attribute_Ref,
       Attribute_Restriction_Set,
       Attribute_Result,