* [Ada] Ada_2020: Add aspect Aggregate to standard container units
@ 2020-10-15 9:40 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2020-10-15 9:40 UTC (permalink / raw)
To: gcc-patches; +Cc: Ed Schonberg
[-- Attachment #1: Type: text/plain, Size: 1322 bytes --]
This patch adds the Ada_2020 aspect Aggregate to standard containers
(vectors, maps, and sets) that support the new construct. This patch
also refines the resolution of record vs. container aggregates, and the
resolution of the aggregate primitive Add_Indexed when the given name
corresponds to an existing overloaded primitive.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* exp_aggr.adb (Expand_N_Aggregate): A record aggregate requires
a non-private type.
* sem_ch13.adb (Valid_Assign_Indexed): New subprogram local to
Resolve_Aspect_Aggregate, to handle the case when the
corresponding name appearing in the aspect specification for an
indexed aggregate is an overloaded operation.
* libgnat/a-convec.ads, libgnat/a-convec.adb,
libgnat/a-coinve.ads, libgnat/a-coinve.adb,
libgnat/a-cobove.ads, libgnat/a-cobove.adb,
libgnat/a-cdlili.ads, libgnat/a-cdlili.adb,
libgnat/a-cbdlli.ads, libgnat/a-cbdlli.adb,
libgnat/a-cohama.ads, libgnat/a-cihama.ads,
libgnat/a-cbhama.ads, libgnat/a-cborma.ads,
libgnat/a-ciorma.ads, libgnat/a-coorma.ads,
libgnat/a-cihase.ads, libgnat/a-cohase.ads,
libgnat/a-cbhase.ads, libgnat/a-cborse.ads,
libgnat/a-ciorse.ads, libgnat/a-coorse.ads: Add Ada_2020 aspect
Aggregate to types declared in standard containers, as well as
new subprograms where required.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 19229 bytes --]
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6758,7 +6758,9 @@ package body Exp_Aggr is
begin
-- Record aggregate case
- if Is_Record_Type (Etype (N)) then
+ if Is_Record_Type (Etype (N))
+ and then not Is_Private_Type (Etype (N))
+ then
Expand_Record_Aggregate (N);
elsif Has_Aspect (Etype (N), Aspect_Aggregate) then
diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb
--- a/gcc/ada/libgnat/a-cbdlli.adb
+++ b/gcc/ada/libgnat/a-cbdlli.adb
@@ -204,6 +204,18 @@ is
Insert (Container, No_Element, New_Item, Count);
end Append;
+ ---------------
+ -- Append_One --
+ ---------------
+
+ procedure Append_One
+ (Container : in out List;
+ New_Item : Element_Type)
+ is
+ begin
+ Insert (Container, No_Element, New_Item, 1);
+ end Append_One;
+
------------
-- Assign --
------------
diff --git a/gcc/ada/libgnat/a-cbdlli.ads b/gcc/ada/libgnat/a-cbdlli.ads
--- a/gcc/ada/libgnat/a-cbdlli.ads
+++ b/gcc/ada/libgnat/a-cbdlli.ads
@@ -54,8 +54,9 @@ is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
-
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_List,
+ Add_Unnamed => Append_One);
pragma Preelaborable_Initialization (List);
type Cursor is private;
@@ -149,6 +150,10 @@ is
New_Item : Element_Type;
Count : Count_Type := 1);
+ procedure Append_One
+ (Container : in out List;
+ New_Item : Element_Type);
+
procedure Delete
(Container : in out List;
Position : in out Cursor;
diff --git a/gcc/ada/libgnat/a-cbhama.ads b/gcc/ada/libgnat/a-cbhama.ads
--- a/gcc/ada/libgnat/a-cbhama.ads
+++ b/gcc/ada/libgnat/a-cbhama.ads
@@ -56,7 +56,9 @@ is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Map,
+ Add_Named => Insert);
pragma Preelaborable_Initialization (Map);
diff --git a/gcc/ada/libgnat/a-cbhase.ads b/gcc/ada/libgnat/a-cbhase.ads
--- a/gcc/ada/libgnat/a-cbhase.ads
+++ b/gcc/ada/libgnat/a-cbhase.ads
@@ -58,7 +58,9 @@ is
type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged private
with Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Set,
+ Add_Unnamed => Include);
pragma Preelaborable_Initialization (Set);
diff --git a/gcc/ada/libgnat/a-cborma.ads b/gcc/ada/libgnat/a-cborma.ads
--- a/gcc/ada/libgnat/a-cborma.ads
+++ b/gcc/ada/libgnat/a-cborma.ads
@@ -57,7 +57,9 @@ is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Map,
+ Add_Named => Insert);
pragma Preelaborable_Initialization (Map);
diff --git a/gcc/ada/libgnat/a-cborse.ads b/gcc/ada/libgnat/a-cborse.ads
--- a/gcc/ada/libgnat/a-cborse.ads
+++ b/gcc/ada/libgnat/a-cborse.ads
@@ -56,7 +56,9 @@ is
type Set (Capacity : Count_Type) is tagged private
with Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Set,
+ Add_Unnamed => Include);
pragma Preelaborable_Initialization (Set);
diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb
--- a/gcc/ada/libgnat/a-cdlili.adb
+++ b/gcc/ada/libgnat/a-cdlili.adb
@@ -163,6 +163,18 @@ is
Insert (Container, No_Element, New_Item, Count);
end Append;
+ ---------------
+ -- Append_One --
+ ---------------
+
+ procedure Append_One
+ (Container : in out List;
+ New_Item : Element_Type)
+ is
+ begin
+ Insert (Container, No_Element, New_Item, 1);
+ end Append_One;
+
------------
-- Assign --
------------
diff --git a/gcc/ada/libgnat/a-cdlili.ads b/gcc/ada/libgnat/a-cdlili.ads
--- a/gcc/ada/libgnat/a-cdlili.ads
+++ b/gcc/ada/libgnat/a-cdlili.ads
@@ -55,7 +55,9 @@ is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_List,
+ Add_Unnamed => Append_One);
pragma Preelaborable_Initialization (List);
@@ -152,6 +154,10 @@ is
New_Item : Element_Type;
Count : Count_Type := 1);
+ procedure Append_One
+ (Container : in out List;
+ New_Item : Element_Type);
+
procedure Delete
(Container : in out List;
Position : in out Cursor;
diff --git a/gcc/ada/libgnat/a-cihama.ads b/gcc/ada/libgnat/a-cihama.ads
--- a/gcc/ada/libgnat/a-cihama.ads
+++ b/gcc/ada/libgnat/a-cihama.ads
@@ -56,7 +56,9 @@ is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Map,
+ Add_Named => Insert);
pragma Preelaborable_Initialization (Map);
diff --git a/gcc/ada/libgnat/a-cihase.ads b/gcc/ada/libgnat/a-cihase.ads
--- a/gcc/ada/libgnat/a-cihase.ads
+++ b/gcc/ada/libgnat/a-cihase.ads
@@ -58,7 +58,9 @@ is
type Set is tagged private
with Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Set,
+ Add_Unnamed => Include);
pragma Preelaborable_Initialization (Set);
diff --git a/gcc/ada/libgnat/a-ciorma.ads b/gcc/ada/libgnat/a-ciorma.ads
--- a/gcc/ada/libgnat/a-ciorma.ads
+++ b/gcc/ada/libgnat/a-ciorma.ads
@@ -57,7 +57,9 @@ is
with Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Map,
+ Add_Named => Insert);
pragma Preelaborable_Initialization (Map);
diff --git a/gcc/ada/libgnat/a-ciorse.ads b/gcc/ada/libgnat/a-ciorse.ads
--- a/gcc/ada/libgnat/a-ciorse.ads
+++ b/gcc/ada/libgnat/a-ciorse.ads
@@ -56,7 +56,9 @@ is
type Set is tagged private with
Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Set,
+ Add_Unnamed => Include);
pragma Preelaborable_Initialization (Set);
diff --git a/gcc/ada/libgnat/a-cobove.adb b/gcc/ada/libgnat/a-cobove.adb
--- a/gcc/ada/libgnat/a-cobove.adb
+++ b/gcc/ada/libgnat/a-cobove.adb
@@ -350,6 +350,17 @@ package body Ada.Containers.Bounded_Vectors is
Container.Insert (Container.Last + 1, New_Item, Count);
end Append;
+ ----------------
+ -- Append_One --
+ ----------------
+
+ procedure Append_One (Container : in out Vector;
+ New_Item : Element_Type)
+ is
+ begin
+ Insert (Container, Last_Index (Container) + 1, New_Item, 1);
+ end Append_One;
+
--------------
-- Capacity --
--------------
@@ -824,6 +835,16 @@ package body Ada.Containers.Bounded_Vectors is
return Index_Type'First;
end First_Index;
+ -----------------
+ -- New_Vector --
+ -----------------
+
+ function New_Vector (First, Last : Index_Type) return Vector
+ is
+ begin
+ return (To_Vector (Count_Type (Last - First + 1)));
+ end New_Vector;
+
---------------------
-- Generic_Sorting --
---------------------
diff --git a/gcc/ada/libgnat/a-cobove.ads b/gcc/ada/libgnat/a-cobove.ads
--- a/gcc/ada/libgnat/a-cobove.ads
+++ b/gcc/ada/libgnat/a-cobove.ads
@@ -58,7 +58,11 @@ package Ada.Containers.Bounded_Vectors is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Vector,
+ Add_Unnamed => Append_One,
+ New_Indexed => New_Vector,
+ Assign_Indexed => Replace_Element);
pragma Preelaborable_Initialization (Vector);
@@ -76,6 +80,10 @@ package Ada.Containers.Bounded_Vectors is
overriding function "=" (Left, Right : Vector) return Boolean;
+ function New_Vector (First, Last : Index_Type) return Vector
+ with Pre => First = Index_Type'First;
+ -- Ada_2020 aggregate operation.
+
function To_Vector (Length : Count_Type) return Vector;
function To_Vector
@@ -243,6 +251,10 @@ package Ada.Containers.Bounded_Vectors is
New_Item : Element_Type;
Count : Count_Type := 1);
+ procedure Append_One (Container : in out Vector;
+ New_Item : Element_Type);
+ -- Ada_2020 aggregate operation.
+
procedure Insert_Space
(Container : in out Vector;
Before : Extended_Index;
diff --git a/gcc/ada/libgnat/a-cohama.ads b/gcc/ada/libgnat/a-cohama.ads
--- a/gcc/ada/libgnat/a-cohama.ads
+++ b/gcc/ada/libgnat/a-cohama.ads
@@ -100,7 +100,9 @@ is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Map,
+ Add_Named => Insert);
pragma Preelaborable_Initialization (Map);
diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads
--- a/gcc/ada/libgnat/a-cohase.ads
+++ b/gcc/ada/libgnat/a-cohase.ads
@@ -59,7 +59,9 @@ is
with
Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Set,
+ Add_Unnamed => Include);
pragma Preelaborable_Initialization (Set);
diff --git a/gcc/ada/libgnat/a-coinve.adb b/gcc/ada/libgnat/a-coinve.adb
--- a/gcc/ada/libgnat/a-coinve.adb
+++ b/gcc/ada/libgnat/a-coinve.adb
@@ -228,6 +228,17 @@ is
end if;
end Append;
+ ----------------
+ -- Append_One --
+ ----------------
+
+ procedure Append_One (Container : in out Vector;
+ New_Item : Element_Type)
+ is
+ begin
+ Insert (Container, Last_Index (Container) + 1, New_Item, 1);
+ end Append_One;
+
----------------------
-- Append_Slow_Path --
----------------------
@@ -872,6 +883,16 @@ is
end First_Element;
-----------------
+ -- New_Vector --
+ -----------------
+
+ function New_Vector (First, Last : Index_Type) return Vector
+ is
+ begin
+ return (To_Vector (Count_Type (Last - First + 1)));
+ end New_Vector;
+
+ -----------------
-- First_Index --
-----------------
diff --git a/gcc/ada/libgnat/a-coinve.ads b/gcc/ada/libgnat/a-coinve.ads
--- a/gcc/ada/libgnat/a-coinve.ads
+++ b/gcc/ada/libgnat/a-coinve.ads
@@ -61,7 +61,11 @@ is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Vector,
+ Add_Unnamed => Append_One,
+ New_Indexed => New_Vector,
+ Assign_Indexed => Replace_Element);
pragma Preelaborable_Initialization (Vector);
@@ -79,6 +83,9 @@ is
overriding function "=" (Left, Right : Vector) return Boolean;
+ function New_Vector (First, Last : Index_Type) return Vector
+ with Pre => First = Index_Type'First;
+
function To_Vector (Length : Count_Type) return Vector;
function To_Vector
@@ -238,6 +245,9 @@ is
New_Item : Element_Type;
Count : Count_Type := 1);
+ procedure Append_One (Container : in out Vector;
+ New_Item : Element_Type);
+
procedure Insert_Space
(Container : in out Vector;
Before : Extended_Index;
diff --git a/gcc/ada/libgnat/a-convec.adb b/gcc/ada/libgnat/a-convec.adb
--- a/gcc/ada/libgnat/a-convec.adb
+++ b/gcc/ada/libgnat/a-convec.adb
@@ -210,6 +210,17 @@ is
end if;
end Append;
+ ----------------
+ -- Append_One --
+ ----------------
+
+ procedure Append_One (Container : in out Vector;
+ New_Item : Element_Type)
+ is
+ begin
+ Insert (Container, Last_Index (Container) + 1, New_Item, 1);
+ end Append_One;
+
----------------------
-- Append_Slow_Path --
----------------------
@@ -742,6 +753,16 @@ is
return Index_Type'First;
end First_Index;
+ -----------------
+ -- New_Vector --
+ -----------------
+
+ function New_Vector (First, Last : Index_Type) return Vector
+ is
+ begin
+ return (To_Vector (Count_Type (Last - First + 1)));
+ end New_Vector;
+
---------------------
-- Generic_Sorting --
---------------------
diff --git a/gcc/ada/libgnat/a-convec.ads b/gcc/ada/libgnat/a-convec.ads
--- a/gcc/ada/libgnat/a-convec.ads
+++ b/gcc/ada/libgnat/a-convec.ads
@@ -93,7 +93,12 @@ is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Vector,
+ Add_Unnamed => Append_One,
+ New_Indexed => New_Vector,
+ Assign_Indexed => Replace_Element);
+
pragma Preelaborable_Initialization (Vector);
-- Vector type, to be instantiated by users of this package. If an object
-- of type Vector is not otherwise initialized, it is initialized to
@@ -323,6 +328,10 @@ is
-- Source is removed from Source and inserted into Target in the original
-- order. The length of Source is 0 after a successful call to Move.
+ function New_Vector (First, Last : Index_Type) return Vector
+ with Pre => First = Index_Type'First;
+ -- Ada_2020 aggregate operation.
+
procedure Insert
(Container : in out Vector;
Before : Extended_Index;
@@ -438,6 +447,10 @@ is
-- Equivalent to Insert (Container, Last_Index (Container) + 1, New_Item,
-- Count).
+ procedure Append_One (Container : in out Vector;
+ New_Item : Element_Type);
+ -- Ada_2020 aggregate operation.
+
procedure Insert_Space
(Container : in out Vector;
Before : Extended_Index;
diff --git a/gcc/ada/libgnat/a-coorma.ads b/gcc/ada/libgnat/a-coorma.ads
--- a/gcc/ada/libgnat/a-coorma.ads
+++ b/gcc/ada/libgnat/a-coorma.ads
@@ -57,7 +57,9 @@ is
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Iterator_Element => Element_Type,
+ Aggregate => (Empty => Empty_Map,
+ Add_Named => Insert);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
diff --git a/gcc/ada/libgnat/a-coorse.ads b/gcc/ada/libgnat/a-coorse.ads
--- a/gcc/ada/libgnat/a-coorse.ads
+++ b/gcc/ada/libgnat/a-coorse.ads
@@ -57,6 +57,8 @@ is
with Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
+ -- Aggregate => (Empty => Empty_Set,
+ -- Add_Unnamed => Include);
pragma Preelaborable_Initialization (Set);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -15142,19 +15142,33 @@ package body Sem_Ch13 is
-- Predicates that establish the legality of each possible operation in
-- an Aggregate aspect.
- function Valid_Empty (E : Entity_Id) return Boolean;
- function Valid_Add_Named (E : Entity_Id) return Boolean;
- function Valid_Add_Unnamed (E : Entity_Id) return Boolean;
- function Valid_New_Indexed (E : Entity_Id) return Boolean;
-
- -- Note: The legality rules for Assign_Indexed are the same as for
- -- Add_Named.
+ function Valid_Empty (E : Entity_Id) return Boolean;
+ function Valid_Add_Named (E : Entity_Id) return Boolean;
+ function Valid_Add_Unnamed (E : Entity_Id) return Boolean;
+ function Valid_New_Indexed (E : Entity_Id) return Boolean;
+ function Valid_Assign_Indexed (E : Entity_Id) return Boolean;
generic
with function Pred (Id : Node_Id) return Boolean;
procedure Resolve_Operation (Subp_Id : Node_Id);
-- Common processing to resolve each aggregate operation.
+ ------------------------
+ -- Valid_Assign_Index --
+ ------------------------
+
+ function Valid_Assign_Indexed (E : Entity_Id) return Boolean is
+ begin
+ -- The profile must be the same as for Add_Named, with the added
+ -- requirement that the key_type be a discrete type.
+
+ if Valid_Add_Named (E) then
+ return Is_Discrete_Type (Etype (Next_Formal (First_Formal (E))));
+ else
+ return False;
+ end if;
+ end Valid_Assign_Indexed;
+
-----------------
-- Valid_Emoty --
-----------------
@@ -15278,7 +15292,8 @@ package body Sem_Ch13 is
procedure Resolve_Named is new Resolve_Operation (Valid_Add_Named);
procedure Resolve_Indexed is new Resolve_Operation (Valid_New_Indexed);
procedure Resolve_Assign_Indexed
- is new Resolve_Operation (Valid_Add_Named);
+ is new Resolve_Operation
+ (Valid_Assign_Indexed);
begin
Assoc := First (Component_Associations (Expr));
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-10-15 9:40 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-10-15 9:40 [Ada] Ada_2020: Add aspect Aggregate to standard container units Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).