OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2015-10-20  Bob Duff  <duff@adacore.com>

	* a-coinve.ads, a-coinve.adb: Do the same efficiency
	improvements that were already done in the definite case
	(Ada.Containers.Vectors, i.e. a-convec). This includes the
	ability to suppress checks, the fast path for Append, inlining
	as appropriate, and special-casing of "for ... of" loops. Reuse
	the tampering machinery that is now in Ada.Containers. Simplify
	many operations.
	* a-convec.ads, a-convec.adb: Change the code to be more similar
	to a-coinve.
	* a-finali.ads, a-finali.adb: Expose the "null"-ness of the
	operations. This may enable optimizations in the future, and
	seems cleaner anyway.

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Is_Operational_Item): Attributes related to
	Ada 2012 iterators are operational items, and can be specified
	on partial views.

From-SVN: r229033
This commit is contained in:
Arnaud Charlet 2015-10-20 11:56:56 +02:00
parent 0489576ce8
commit e9f97e7931
8 changed files with 598 additions and 1238 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/ada/ChangeLog
View File

@ -1,3 +1,24 @@
2015-10-20 Bob Duff <duff@adacore.com>
* a-coinve.ads, a-coinve.adb: Do the same efficiency
improvements that were already done in the definite case
(Ada.Containers.Vectors, i.e. a-convec). This includes the
ability to suppress checks, the fast path for Append, inlining
as appropriate, and special-casing of "for ... of" loops. Reuse
the tampering machinery that is now in Ada.Containers. Simplify
many operations.
* a-convec.ads, a-convec.adb: Change the code to be more similar
to a-coinve.
* a-finali.ads, a-finali.adb: Expose the "null"-ness of the
operations. This may enable optimizations in the future, and
seems cleaner anyway.
2015-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Is_Operational_Item): Attributes related to
Ada 2012 iterators are operational items, and can be specified
on partial views.
2015-10-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Check_Usage): Update the calls to Usage_Error.

1650
gcc/ada/a-coinve.adb
View File

File diff suppressed because it is too large Load Diff

56
gcc/ada/a-coinve.ads
View File

@ -343,6 +343,7 @@ package Ada.Containers.Indefinite_Vectors is
private
pragma Inline (Append);
pragma Inline (First_Index);
pragma Inline (Last_Index);
pragma Inline (Element);
@ -351,35 +352,37 @@ private
pragma Inline (Query_Element);
pragma Inline (Update_Element);
pragma Inline (Replace_Element);
pragma Inline (Is_Empty);
pragma Inline (Contains);
pragma Inline (Next);
pragma Inline (Previous);
package Implementation is new Generic_Implementation;
use Implementation;
type Element_Access is access Element_Type;
type Elements_Array is array (Index_Type range <>) of Element_Access;
function "=" (L, R : Elements_Array) return Boolean is abstract;
type Elements_Type (Last : Index_Type) is limited record
type Elements_Type (Last : Extended_Index) is limited record
EA : Elements_Array (Index_Type'First .. Last);
end record;
type Elements_Access is access Elements_Type;
type Elements_Access is access all Elements_Type;
type Vector is new Ada.Finalization.Controlled with record
Elements : Elements_Access;
use Finalization;
use Streams;
type Vector is new Controlled with record
Elements : Elements_Access := null;
Last : Extended_Index := No_Index;
Busy : Natural := 0;
Lock : Natural := 0;
TC : aliased Tamper_Counts;
end record;
overriding procedure Adjust (Container : in out Vector);
overriding procedure Finalize (Container : in out Vector);
use Ada.Finalization;
use Ada.Streams;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Container : Vector);
@ -412,16 +415,8 @@ private
for Cursor'Write use Write;
type Reference_Control_Type is
new Controlled with record
Container : Vector_Access;
end record;
overriding procedure Adjust (Control : in out Reference_Control_Type);
pragma Inline (Adjust);
overriding procedure Finalize (Control : in out Reference_Control_Type);
pragma Inline (Finalize);
subtype Reference_Control_Type is Implementation.Reference_Control_Type;
-- It is necessary to rename this here, so that the compiler can find it
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
@ -467,16 +462,33 @@ private
for Reference_Type'Read use Read;
Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
-- Three operations are used to optimize in the expansion of "for ... of"
-- loops: the Next(Cursor) procedure in the visible part, and the following
-- Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
-- details.
function Pseudo_Reference
(Container : aliased Vector'Class) return Reference_Control_Type;
pragma Inline (Pseudo_Reference);
-- Creates an object of type Reference_Control_Type pointing to the
-- container, and increments the Lock. Finalization of this object will
-- decrement the Lock.
function Get_Element_Access
(Position : Cursor) return not null Element_Access;
-- Returns a pointer to the element designated by Position.
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
Empty_Vector : constant Vector := (Controlled with others => <>);
type Iterator is new Limited_Controlled and
Vector_Iterator_Interfaces.Reversible_Iterator with
record
Container : Vector_Access;
Index : Index_Type'Base;
end record;
end record
with Disable_Controlled => not T_Check;
overriding procedure Finalize (Object : in out Iterator);

26
gcc/ada/a-convec.adb
View File

@ -450,9 +450,9 @@ package body Ada.Containers.Vectors is
return;
end if;
-- There are some elements aren't being deleted (the requested count was
-- less than the available count), so we must slide them down to
-- Index. We first calculate the index values of the respective array
-- There are some elements that aren't being deleted (the requested
-- count was less than the available count), so we must slide them down
-- to Index. We first calculate the index values of the respective array
-- slices, using the wider of Index_Type'Base and Count_Type'Base as the
-- type for intermediate calculations. For the elements that slide down,
-- index value New_Last is the last index value of their new home, and
@ -583,9 +583,9 @@ package body Ada.Containers.Vectors is
begin
if Checks and then Index > Container.Last then
raise Constraint_Error with "Index is out of range";
else
return Container.Elements.EA (Index);
end if;
return Container.Elements.EA (Index);
end Element;
function Element (Position : Cursor) return Element_Type is
@ -692,9 +692,9 @@ package body Ada.Containers.Vectors is
begin
if Is_Empty (Container) then
return No_Element;
else
return (Container'Unrestricted_Access, Index_Type'First);
end if;
return (Container'Unrestricted_Access, Index_Type'First);
end First;
function First (Object : Iterator) return Cursor is
@ -1030,7 +1030,6 @@ package body Ada.Containers.Vectors is
-- handled above).
if Index_Type'Last - No_Index >= Count_Type_Last then
-- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the
-- maximum number of items that are allowed.
@ -1655,7 +1654,6 @@ package body Ada.Containers.Vectors is
-- acceptable, then we compute the new last index from that.
if Index_Type'Base'Last >= Count_Type_Last then
-- We have to handle the case when there might be more values in the
-- range of Index_Type than in the range of Count_Type.
@ -1690,7 +1688,6 @@ package body Ada.Containers.Vectors is
-- handled above).
if Index_Type'Last - No_Index >= Count_Type_Last then
-- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the
-- maximum number of items that are allowed.
@ -1965,7 +1962,7 @@ package body Ada.Containers.Vectors is
Index := Before.Index;
end if;
Insert_Space (Container, Index, Count => Count);
Insert_Space (Container, Index, Count);
Position := (Container'Unrestricted_Access, Index);
end Insert_Space;
@ -2022,7 +2019,7 @@ package body Ada.Containers.Vectors is
function Iterate
(Container : Vector;
Start : Cursor)
return Vector_Iterator_Interfaces.Reversible_Iterator'class
return Vector_Iterator_Interfaces.Reversible_Iterator'Class
is
V : constant Vector_Access := Container'Unrestricted_Access;
begin
@ -2911,6 +2908,7 @@ package body Ada.Containers.Vectors is
---------------------
-- Reverse_Iterate --
---------------------
procedure Reverse_Iterate
(Container : Vector;
Process : not null access procedure (Position : Cursor))
@ -3119,7 +3117,7 @@ package body Ada.Containers.Vectors is
Elements := new Elements_Type (Last);
return Vector'(Controlled with Elements, Last, others => <>);
return Vector'(Controlled with Elements, Last, TC => <>);
end To_Vector;
function To_Vector
@ -3211,7 +3209,7 @@ package body Ada.Containers.Vectors is
Elements := new Elements_Type'(Last, EA => (others => New_Item));
return Vector'(Controlled with Elements, Last, others => <>);
return (Controlled with Elements, Last, TC => <>);
end To_Vector;
--------------------

2
gcc/ada/a-convec.ads
View File

@ -487,7 +487,7 @@ private
(Position : Cursor) return not null Element_Access;
-- Returns a pointer to the element designated by Position.
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
Empty_Vector : constant Vector := (Controlled with others => <>);

50
gcc/ada/a-finali.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -29,48 +29,8 @@
-- --
------------------------------------------------------------------------------
package body Ada.Finalization is
-- This package does not require a body. We provide a dummy file containing a
-- No_Body pragma so that previous versions of the body (which did exist) will
-- not interfere.
------------
-- Adjust --
------------
procedure Adjust (Object : in out Controlled) is
pragma Warnings (Off, Object);
begin
null;
end Adjust;
--------------
-- Finalize --
--------------
procedure Finalize (Object : in out Controlled) is
pragma Warnings (Off, Object);
begin
null;
end Finalize;
procedure Finalize (Object : in out Limited_Controlled) is
pragma Warnings (Off, Object);
begin
null;
end Finalize;
----------------
-- Initialize --
----------------
procedure Initialize (Object : in out Controlled) is
pragma Warnings (Off, Object);
begin
null;
end Initialize;
procedure Initialize (Object : in out Limited_Controlled) is
pragma Warnings (Off, Object);
begin
null;
end Initialize;
end Ada.Finalization;
pragma No_Body;

12
gcc/ada/a-finali.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -43,15 +43,15 @@ package Ada.Finalization is
type Controlled is abstract tagged private;
pragma Preelaborable_Initialization (Controlled);
procedure Initialize (Object : in out Controlled);
procedure Adjust (Object : in out Controlled);
procedure Finalize (Object : in out Controlled);
procedure Initialize (Object : in out Controlled) is null;
procedure Adjust (Object : in out Controlled) is null;
procedure Finalize (Object : in out Controlled) is null;
type Limited_Controlled is abstract tagged limited private;
pragma Preelaborable_Initialization (Limited_Controlled);
procedure Initialize (Object : in out Limited_Controlled);
procedure Finalize (Object : in out Limited_Controlled);
procedure Initialize (Object : in out Limited_Controlled) is null;
procedure Finalize (Object : in out Limited_Controlled) is null;
private
package SFR renames System.Finalization_Root;

19
gcc/ada/sem_ch13.adb
View File

@ -2036,8 +2036,8 @@ package body Sem_Ch13 is
Analyze_And_Resolve (Expr, Standard_Integer);
-- Interrupt_Priority aspect not allowed for main
-- subprograms. ARM D.1 does not forbid this explicitly,
-- but ARM J.15.11 (6/3) does not permit pragma
-- subprograms. RM D.1 does not forbid this explicitly,
-- but RM J.15.11(6/3) does not permit pragma
-- Interrupt_Priority for subprograms.
if A_Id = Aspect_Interrupt_Priority then
@ -2060,7 +2060,7 @@ package body Sem_Ch13 is
(Specification (N)))
or else not Is_Compilation_Unit (Defining_Entity (N))
then
-- See ARM D.1 (14/3) and D.16 (12/3)
-- See RM D.1(14/3) and D.16(12/3)
Error_Msg_N
("aspect applied to subprogram other than the "
@ -11419,9 +11419,20 @@ package body Sem_Ch13 is
declare
Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
begin
return Id = Attribute_Input
-- List of operational items is given in RM 13.1(8.mm/1).
-- It is clearly incomplete, as it does not include iterator
-- aspects, among others.
return Id = Attribute_Constant_Indexing
or else Id = Attribute_Default_Iterator
or else Id = Attribute_Implicit_Dereference
or else Id = Attribute_Input
or else Id = Attribute_Iterator_Element
or else Id = Attribute_Iterable
or else Id = Attribute_Output
or else Id = Attribute_Read
or else Id = Attribute_Variable_Indexing
or else Id = Attribute_Write
or else Id = Attribute_External_Tag;
end;