[Ada] Write Itype values in dg listing
Arnaud Charlet
charlet@adacore.com
Fri Dec 9 17:29:00 GMT 2005
Tested on i686-linux, committed on trunk
This patch implements handling of record types in the new routine to
write output Itype values. There are two cases, with and without an
explicitly built declaration. Both are now handled.
A test program is:
with Ada.Text_IO; use Ada.Text_IO;
package body Pak2 is
function F (Whence : Day) return Pak1.Ptr is
begin
return new Derived_Data'(Whence => Whence, X => 123);
end F;
X : Pak1.Ptr;
Y : aliased Derived_Data := (Whence => Sun, X => 456);
begin
Put_Line ("From function return:");
X := F (Wed);
if X.Kind'Valid then
Put_Line ("X.Kind = " & X.Kind'Img);
else
Put_Line ("X.Kind has invalid representation");
end if;
Put_Line ("From aliased initialized object:");
X := Y'Access;
if X.Kind'Valid then
Put_Line ("X.Kind = " & X.Kind'Img);
else
Put_Line ("X.Kind has invalid representation");
end if;
end Pak2;
This patch also implements an enhancement to the output of reconstructed
expanded source listings (-gnatD/G switch output). This output now
includes a representation of itypes (internally generated types for
which no type declaration is present in the tree). A test program is
procedure Q is
R : String (1 .. 10);
type H is new String (1 .. 10);
type HH is access H;
HHH : HH;
begin
R (1 .. 5) := R (6 .. 10);
HHH := new H'("Abcdeabcde");
end;
which, compiled with -gnatG -gnatws, generates:
Source recreated from tree for Q (body)
---------------------------------------
procedure q is
subtype q__TrS is string (1 .. 10);
r : string (1 .. 10);
[type q__ThB is array (positive range <>) of character]
subtype q__h is q__ThB (1 .. 10);
type q__hh is access q__h;
hhh : q__hh := null;
begin
r ({1 .. 5}) := r ({6 .. 10});
hhh := new q__h'("Abcdeabcde");
return;
end q;
Here the line listing q__ThB is the new output
Protected types that have interface progenitors are tagged types, but
they are not limited records, so a separate check must be made to allow
private components that are themselves limited.
the following must compile quietly:
gcc -c -gnatc -gnat05 p-c.ads
--
package P is
type Timer is synchronized interface;
procedure Await_Alarm (This : in out Timer) is abstract;
end P;
--
package P.C is
type L is limited null record;
protected type Alarm is new Timer with
overriding entry Await_Alarm;
private
X : L; -- compiler complains about this decl
end Alarm;
end P.C;
If the parent of the full-view is an interface we perform a transformation
of the tree to ensure that it has the same parent than the partial-view.
This work is needed because the list of interfaces of the full-view can
be given in any order. After this change the following test must compile
without errors:
--
procedure do_test is
package Pkg is
type A is interface;
type B is interface and A;
type D is new B with private;
private
type D is new A and B with null record;
end Pkg;
--
begin
null;
end do_test;
2005-12-05 Robert Dewar <dewar@adacore.com>
Ed Schonberg <schonberg@adacore.com>
Gary Dismukes <dismukes@adacore.com>
Javier Miranda <miranda@adacore.com>
Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb (Itype_Printed): New flag
(Is_Limited_Type): Derived types do not inherit limitedness from
interface progenitors.
(Is_Return_By_Reference_Type): Predicate does not apply to limited
interfaces.
* einfo.ads (Itype_Printed): New flag
Move Is_Wrapper_Package to proper section
Add missing Inline for Is_Volatile
* output.ads, output.adb (Write_Erase_Char): New procedure
(Save/Restore_Output_Buffer): New procedures
(Save/Restore_Output_Buffer): New procedures
* sprint.ads, sprint.adb (Write_Itype): Handle case of record itypes
Add missing support for anonymous access type
(Write_Id): Insert calls to Write_Itype
(Write_Itype): New procedure to output itypes
* par-ch12.adb (P_Formal_Derived_Type_Definition): In Ada 2005, handle
use of "limited" in declaration.
* sinfo.ads, sinfo.adb:
Formal derived types can carry an explicit "limited" indication.
* sem_ch3.adb: Add with and use of Targparm.
(Create_Component): If Frontend_Layout_On_Target is True and the
copied component does not have a known static Esize, then reset
the size and positional fields of the new component.
(Analyze_Component_Declaration): A limited component is
legal within a protected type that implements an interface.
(Collect_Interfaces): Do not add to the list the interfaces that
are implemented by the ancestors.
(Derived_Type_Declaration): If the parent of the full-view is an
interface perform a transformation of the tree to ensure that it has
the same parent than the partial-view. This simplifies the job of the
expander in order to generate the correct object layout, and it is
needed because the list of interfaces of the full-view can be given in
any order.
(Process_Full_View): The parent of the full-view does not need to be
a descendant of the parent of the partial view if both parents are
interfaces.
(Analyze_Private_Extension_Declaration): If declaration has an explicit
"limited" the parent must be a limited type.
(Build_Derived_Record_Type): A derived type that is explicitly limited
must have limited ancestor and progenitors.
(Build_Derived_Type): Ditto.
(Process_Full_View): Verify that explicit uses of "limited" in partial
and full declarations are consistent.
(Find_Ancestor_Interface): Remove function.
(Collect_Implemented_Interfaces): New procedure used to gather all
implemented interfaces by a type.
(Contain_Interface): New function used to check whether an interface is
present in a list.
(Find_Hidden_Interface): New function used to determine whether two
lists of interfaces constitute a set equality. If not, the first
differing interface is returned.
(Process_Full_View): Improve the check for the "no hidden interface"
rule as defined by AI-396.
-------------- next part --------------
Index: einfo.adb
===================================================================
--- einfo.adb (revision 108280)
+++ einfo.adb (working copy)
@@ -452,8 +452,8 @@
-- Is_Task_Interface Flag200
-- Has_Anon_Block_Suffix Flag201
+ -- Itype_Printed Flag202
- -- (unused) Flag202
-- (unused) Flag203
-- (unused) Flag204
-- (unused) Flag205
@@ -1877,6 +1877,7 @@
function Is_Volatile (Id : E) return B is
begin
pragma Assert (Nkind (Id) in N_Entity);
+
if Is_Type (Id) then
return Flag16 (Base_Type (Id));
else
@@ -1884,6 +1885,12 @@
end if;
end Is_Volatile;
+ function Itype_Printed (Id : E) return B is
+ begin
+ pragma Assert (Is_Itype (Id));
+ return Flag202 (Id);
+ end Itype_Printed;
+
function Kill_Elaboration_Checks (Id : E) return B is
begin
return Flag32 (Id);
@@ -4016,6 +4023,12 @@
Set_Flag16 (Id, V);
end Set_Is_Volatile;
+ procedure Set_Itype_Printed (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Itype (Id));
+ Set_Flag202 (Id, V);
+ end Set_Itype_Printed;
+
procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is
begin
Set_Flag32 (Id, V);
@@ -5722,6 +5735,7 @@
function Is_Limited_Type (Id : E) return B is
Btype : constant E := Base_Type (Id);
+ Rtype : constant E := Root_Type (Btype);
begin
if not Is_Type (Id) then
@@ -5744,11 +5758,17 @@
return False;
elsif Is_Record_Type (Btype) then
- if Is_Limited_Record (Root_Type (Btype)) then
- return True;
+ -- AI-419: limitedness is not inherited from a limited interface
+
+ if Is_Limited_Record (Rtype) then
+ return not Is_Interface (Rtype)
+ or else Is_Protected_Interface (Rtype)
+ or else Is_Synchronized_Interface (Rtype)
+ or else Is_Task_Interface (Rtype);
+
elsif Is_Class_Wide_Type (Btype) then
- return Is_Limited_Type (Root_Type (Btype));
+ return Is_Limited_Type (Rtype);
else
declare
@@ -5813,6 +5833,8 @@
-- Is_Return_By_Reference_Type --
---------------------------------
+ -- Note: this predicate has disappeared from Ada 2005: see AI-318-2
+
function Is_Return_By_Reference_Type (Id : E) return B is
Btype : constant Entity_Id := Base_Type (Id);
@@ -5820,7 +5842,6 @@
if Is_Private_Type (Btype) then
declare
Utyp : constant Entity_Id := Underlying_Type (Btype);
-
begin
if No (Utyp) then
return False;
@@ -5834,7 +5855,10 @@
elsif Is_Record_Type (Btype) then
if Is_Limited_Record (Btype) then
- return True;
+ return not Is_Interface (Btype)
+ or else Is_Protected_Interface (Btype)
+ or else Is_Synchronized_Interface (Btype)
+ or else Is_Task_Interface (Btype);
elsif Is_Class_Wide_Type (Btype) then
return Is_Return_By_Reference_Type (Root_Type (Btype));
@@ -6700,6 +6724,7 @@
W ("Is_Valued_Procedure", Flag127 (Id));
W ("Is_Visible_Child_Unit", Flag116 (Id));
W ("Is_Volatile", Flag16 (Id));
+ W ("Itype_Printed", Flag202 (Id));
W ("Kill_Elaboration_Checks", Flag32 (Id));
W ("Kill_Range_Checks", Flag33 (Id));
W ("Kill_Tag_Checks", Flag34 (Id));
Index: einfo.ads
===================================================================
--- einfo.ads (revision 108280)
+++ einfo.ads (working copy)
@@ -2469,6 +2469,10 @@
-- Present in package entities. Indicates that the package has been
-- created as a wrapper for a subprogram instantiation.
+-- Itype_Printed (Flag202)
+-- Set in Itypes if the Itype has been printed by Sprint. This is used to
+-- avoid printing an Itype more than once.
+
-- Kill_Elaboration_Checks (Flag32)
-- Present in all entities. Set by the expander to kill elaboration
-- checks which are known not to be needed. Equivalent in effect to
@@ -4166,6 +4170,7 @@
-- Is_Tagged_Type (Flag55)
-- Is_Unsigned_Type (Flag144)
-- Is_Volatile (Flag16)
+ -- Itype_Printed (Flag202) (itypes only)
-- Must_Be_On_Byte_Boundary (Flag183)
-- Size_Depends_On_Discriminant (Flag177)
-- Size_Known_At_Compile_Time (Flag92)
@@ -5363,7 +5368,6 @@
function Is_Potentially_Use_Visible (Id : E) return B;
function Is_Preelaborated (Id : E) return B;
function Is_Primitive_Wrapper (Id : E) return B;
-
function Is_Private_Composite (Id : E) return B;
function Is_Private_Descendant (Id : E) return B;
function Is_Protected_Interface (Id : E) return B;
@@ -5387,7 +5391,7 @@
function Is_Valued_Procedure (Id : E) return B;
function Is_Visible_Child_Unit (Id : E) return B;
function Is_Volatile (Id : E) return B;
- function Is_Wrapper_Package (Id : E) return B;
+ function Itype_Printed (Id : E) return B;
function Kill_Elaboration_Checks (Id : E) return B;
function Kill_Range_Checks (Id : E) return B;
function Kill_Tag_Checks (Id : E) return B;
@@ -5567,6 +5571,7 @@
function Is_Return_By_Reference_Type (Id : E) return B;
function Is_String_Type (Id : E) return B;
function Is_Task_Record_Type (Id : E) return B;
+ function Is_Wrapper_Package (Id : E) return B;
function Next_Component (Id : E) return E;
function Next_Discriminant (Id : E) return E;
function Next_Formal (Id : E) return E;
@@ -5890,6 +5895,7 @@
procedure Set_Is_Valued_Procedure (Id : E; V : B := True);
procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True);
procedure Set_Is_Volatile (Id : E; V : B := True);
+ procedure Set_Itype_Printed (Id : E; V : B := True);
procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True);
procedure Set_Kill_Range_Checks (Id : E; V : B := True);
procedure Set_Kill_Tag_Checks (Id : E; V : B := True);
@@ -6445,7 +6451,6 @@
pragma Inline (Is_Potentially_Use_Visible);
pragma Inline (Is_Preelaborated);
pragma Inline (Is_Primitive_Wrapper);
-
pragma Inline (Is_Private_Composite);
pragma Inline (Is_Private_Descendant);
pragma Inline (Is_Private_Type);
@@ -6477,6 +6482,7 @@
pragma Inline (Is_VMS_Exception);
pragma Inline (Is_Valued_Procedure);
pragma Inline (Is_Visible_Child_Unit);
+ pragma Inline (Itype_Printed);
pragma Inline (Kill_Elaboration_Checks);
pragma Inline (Kill_Range_Checks);
pragma Inline (Kill_Tag_Checks);
@@ -6788,7 +6794,6 @@
pragma Inline (Set_Is_Potentially_Use_Visible);
pragma Inline (Set_Is_Preelaborated);
pragma Inline (Set_Is_Primitive_Wrapper);
-
pragma Inline (Set_Is_Private_Composite);
pragma Inline (Set_Is_Private_Descendant);
pragma Inline (Set_Is_Protected_Interface);
@@ -6812,6 +6817,7 @@
pragma Inline (Set_Is_Valued_Procedure);
pragma Inline (Set_Is_Visible_Child_Unit);
pragma Inline (Set_Is_Volatile);
+ pragma Inline (Set_Itype_Printed);
pragma Inline (Set_Kill_Elaboration_Checks);
pragma Inline (Set_Kill_Range_Checks);
pragma Inline (Set_Kill_Tag_Checks);
@@ -6909,6 +6915,7 @@
-- access/set format that can be handled by xeinfo.
pragma Inline (Is_Package_Or_Generic_Package);
+ pragma Inline (Is_Volatile);
pragma Inline (Is_Wrapper_Package);
pragma Inline (Known_RM_Size);
pragma Inline (Known_Static_Component_Bit_Offset);
Index: output.ads
===================================================================
--- output.ads (revision 108280)
+++ output.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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- --
@@ -35,7 +35,8 @@
-- for writing error messages and informational output. It is also used
-- by the debug source file output routines (see Sprintf.Print_Eol).
-with Types; use Types;
+with Hostparm; use Hostparm;
+with Types; use Types;
package Output is
pragma Elaborate_Body;
@@ -86,6 +87,9 @@
-- Write one character to the standard output file. Note that the
-- character should not be LF or CR (use Write_Eol for end of line)
+ procedure Write_Erase_Char (C : Character);
+ -- If last character in buffer matches C, erase it, otherwise no effect
+
procedure Write_Eol;
-- Write an end of line (whatever is required by the system in use,
-- e.g. CR/LF for DOS, or LF for Unix) to the standard output file.
@@ -106,11 +110,30 @@
procedure Write_Line (S : String);
-- Equivalent to Write_Str (S) followed by Write_Eol;
- function Column return Nat;
+ function Column return Pos;
pragma Inline (Column);
-- Returns the number of the column about to be written (e.g. a value
-- of 1 means the current line is empty).
+ -------------------------
+ -- Buffer Save/Restore --
+ -------------------------
+
+ -- This facility allows the current line buffer to be saved and restored
+
+ type Saved_Output_Buffer is private;
+ -- Type used for Save/Restore_Buffer
+
+ Buffer_Max : constant := Hostparm.Max_Line_Length;
+ -- Maximal size of a buffered output line
+
+ function Save_Output_Buffer return Saved_Output_Buffer;
+ -- Save current line buffer and reset line buffer to empty
+
+ procedure Restore_Output_Buffer (S : Saved_Output_Buffer);
+ -- Restore previously saved output buffer. The value in S is not affected
+ -- so it is legtimate to restore a buffer more than once.
+
--------------------------
-- Debugging Procedures --
--------------------------
@@ -144,4 +167,28 @@
procedure w (L : String; B : Boolean);
-- Dump contents of string followed by blank, Boolean, line return
+private
+ -- Note: the following buffer and column position are maintained by the
+ -- subprograms defined in this package, and cannot be directly modified or
+ -- accessed by a client.
+
+ Buffer : String (1 .. Buffer_Max + 1);
+ for Buffer'Alignment use 4;
+ -- Buffer used to build output line. We do line buffering because it
+ -- is needed for the support of the debug-generated-code option (-gnatD).
+ -- Historically it was first added because on VMS, line buffering is
+ -- needed with certain file formats. So in any case line buffering must
+ -- be retained for this purpose, even if other reasons disappear. Note
+ -- any attempt to write more output to a line than can fit in the buffer
+ -- will be silently ignored. The alignment clause improves the efficiency
+ -- of the save/restore procedures.
+
+ Next_Col : Positive range 1 .. Buffer'Length + 1 := 1;
+ -- Column about to be written
+
+ type Saved_Output_Buffer is record
+ Buffer : String (1 .. Buffer_Max + 1);
+ Next_Col : Positive;
+ end record;
+
end Output;
Index: output.adb
===================================================================
--- output.adb (revision 108280)
+++ output.adb (working copy)
@@ -42,29 +42,6 @@
-- Record argument to last call to Set_Special_Output. If this is
-- non-null, then we are in special output mode.
- -------------------------
- -- Line Buffer Control --
- -------------------------
-
- -- Note: the following buffer and column position are maintained by
- -- the subprograms defined in this package, and are not normally
- -- directly modified or accessed by a client. However, a client is
- -- permitted to modify these values, using the knowledge that only
- -- Write_Eol actually generates any output.
-
- Buffer_Max : constant := 8192;
- Buffer : String (1 .. Buffer_Max + 1);
- -- Buffer used to build output line. We do line buffering because it
- -- is needed for the support of the debug-generated-code option (-gnatD).
- -- Historically it was first added because on VMS, line buffering is
- -- needed with certain file formats. So in any case line buffering must
- -- be retained for this purpose, even if other reasons disappear. Note
- -- any attempt to write more output to a line than can fit in the buffer
- -- will be silently ignored.
-
- Next_Column : Pos range 1 .. Buffer'Length + 1 := 1;
- -- Column about to be written
-
-----------------------
-- Local_Subprograms --
-----------------------
@@ -86,7 +63,7 @@
------------------
procedure Flush_Buffer is
- Len : constant Natural := Natural (Next_Column - 1);
+ Len : constant Natural := Next_Col - 1;
begin
if Len /= 0 then
@@ -111,7 +88,7 @@
else
Current_FD := Standerr;
- Next_Column := 1;
+ Next_Col := 1;
Write_Line ("fatal error: disk full");
OS_Exit (2);
end if;
@@ -119,7 +96,7 @@
-- Buffer is now empty
- Next_Column := 1;
+ Next_Col := 1;
end if;
end Flush_Buffer;
@@ -127,12 +104,35 @@
-- Column --
------------
- function Column return Nat is
+ function Column return Pos is
begin
- return Next_Column;
+ return Pos (Next_Col);
end Column;
+ ---------------------------
+ -- Restore_Output_Buffer --
+ ---------------------------
+
+ procedure Restore_Output_Buffer (S : Saved_Output_Buffer) is
+ begin
+ Next_Col := S.Next_Col;
+ Buffer (1 .. Next_Col - 1) := S.Buffer (1 .. Next_Col - 1);
+ end Restore_Output_Buffer;
+
------------------------
+ -- Save_Output_Buffer --
+ ------------------------
+
+ function Save_Output_Buffer return Saved_Output_Buffer is
+ S : Saved_Output_Buffer;
+ begin
+ S.Buffer (1 .. Next_Col - 1) := Buffer (1 .. Next_Col - 1);
+ S.Next_Col := Next_Col;
+ Next_Col := 1;
+ return S;
+ end Save_Output_Buffer;
+
+ ------------------------
-- Set_Special_Output --
------------------------
@@ -149,7 +149,7 @@
begin
if Special_Output_Proc = null then
Flush_Buffer;
- Next_Column := 1;
+ Next_Col := 1;
end if;
Current_FD := Standerr;
@@ -163,7 +163,7 @@
begin
if Special_Output_Proc = null then
Flush_Buffer;
- Next_Column := 1;
+ Next_Col := 1;
end if;
Current_FD := Standout;
@@ -236,12 +236,12 @@
procedure Write_Char (C : Character) is
begin
- if Next_Column = Buffer'Length then
+ if Next_Col = Buffer'Length then
Write_Eol;
end if;
- Buffer (Natural (Next_Column)) := C;
- Next_Column := Next_Column + 1;
+ Buffer (Next_Col) := C;
+ Next_Col := Next_Col + 1;
end Write_Char;
---------------
@@ -250,11 +250,22 @@
procedure Write_Eol is
begin
- Buffer (Natural (Next_Column)) := ASCII.LF;
- Next_Column := Next_Column + 1;
+ Buffer (Next_Col) := ASCII.LF;
+ Next_Col := Next_Col + 1;
Flush_Buffer;
end Write_Eol;
+ ----------------------
+ -- Write_Erase_Char --
+ ----------------------
+
+ procedure Write_Erase_Char (C : Character) is
+ begin
+ if Next_Col /= 1 and then Buffer (Next_Col - 1) = C then
+ Next_Col := Next_Col - 1;
+ end if;
+ end Write_Erase_Char;
+
---------------
-- Write_Int --
---------------
Index: sprint.ads
===================================================================
--- sprint.ads (revision 108280)
+++ sprint.ads (working copy)
@@ -58,6 +58,7 @@
-- Freeze entity with freeze actions freeze entityname [ actions ]
-- Interpretation interpretation type [, entity]
-- Intrinsic calls function-name!(arg, arg, arg)
+ -- Itype declaration [(sub)type declaration without ;]
-- Itype reference reference itype
-- Label declaration labelname : label
-- Mod wi Treat_Fixed_As_Integer x #mod y
Index: sprint.adb
===================================================================
--- sprint.adb (revision 108280)
+++ sprint.adb (working copy)
@@ -193,7 +193,7 @@
-- declarations that can have discriminants.
procedure Write_Ekind (E : Entity_Id);
- -- Write the String corresponding to the Ekind without "E_".
+ -- Write the String corresponding to the Ekind without "E_"
procedure Write_Id (N : Node_Id);
-- N is a node with a Chars field. This procedure writes the name that
@@ -203,7 +203,8 @@
-- the name associated with the entity (since it may have been encoded).
-- One other special case is that an entity has an active external name
-- (i.e. an external name present with no address clause), then this
- -- external name is output.
+ -- external name is output. This procedure also deals with outputting
+ -- declarations of referenced itypes, if not output earlier.
function Write_Identifiers (Node : Node_Id) return Boolean;
-- Handle node where the grammar has a list of defining identifiers, but
@@ -238,6 +239,10 @@
-- the Sloc of the current node is set to the first non-blank character
-- in the string S.
+ procedure Write_Itype (Typ : Entity_Id);
+ -- If Typ is an Itype that has not been written yet, write it. If Typ is
+ -- any other kind of entity or tree node, the call is ignored.
+
procedure Write_Name_With_Col_Check (N : Name_Id);
-- Write name (using Write_Name) with initial column check, and possible
-- initial Write_Indent (to get new line) if current line is too full.
@@ -272,6 +277,11 @@
-- Like Write_Str_WIth_Col_Check, but sets debug Sloc of current debug
-- node to first non-blank character if a current debug node is active.
+ procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format);
+ -- Write Uint (using UI_Write) with initial column check, and possible
+ -- initial Write_Indent (to get new line) if current line is too full.
+ -- The format parameter determines the output format (see UI_Write).
+
procedure Write_Uint_With_Col_Check_Sloc (U : Uint; Format : UI_Format);
-- Write Uint (using UI_Write) with initial column check, and possible
-- initial Write_Indent (to get new line) if current line is too full.
@@ -417,7 +427,7 @@
Write_Eol;
end Underline;
- -- Start of processing for Tree_Dump.
+ -- Start of processing for Tree_Dump
begin
Dump_Generated_Only := Debug_Flag_G or
@@ -1078,7 +1088,6 @@
Condition : constant Node_Id := First (Expressions (Node));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : constant Node_Id := Next (Then_Expr);
-
begin
Write_Str_With_Col_Check_Sloc ("(if ");
Sprint_Node (Condition);
@@ -2344,7 +2353,6 @@
declare
Alt_Node : Node_Id;
-
begin
Alt_Node := First (Select_Alternatives (Node));
loop
@@ -2607,7 +2615,6 @@
declare
Node1 : Node_Id;
-
begin
Node1 := First (Subtype_Marks (Node));
loop
@@ -2808,9 +2815,7 @@
if Dump_Original_Only then
N := First (List);
-
while Present (N) loop
-
if not Is_Rewrite_Insertion (N) then
Node_Exists := True;
exit;
@@ -2944,6 +2949,19 @@
procedure Write_Id (N : Node_Id) is
begin
+ -- Deal with outputting Itype
+
+ -- Note: if we are printing the full tree with -gnatds, then we may
+ -- end up picking up the Associated_Node link from a generic template
+ -- here which overlaps the Entity field, but as documented, Write_Itype
+ -- is defended against junk calls.
+
+ if Nkind (N) in N_Entity then
+ Write_Itype (N);
+ elsif Nkind (N) in N_Has_Entity then
+ Write_Itype (Entity (N));
+ end if;
+
-- Case of a defining identifier
if Nkind (N) = N_Defining_Identifier then
@@ -3022,7 +3040,6 @@
Write_Str_With_Col_Check (" (");
Ind := First_Index (E);
-
while Present (Ind) loop
Sprint_Node (Ind);
Next_Index (Ind);
@@ -3153,6 +3170,266 @@
Write_Str_Sloc (S);
end Write_Indent_Str_Sloc;
+ -----------------
+ -- Write_Itype --
+ -----------------
+
+ procedure Write_Itype (Typ : Entity_Id) is
+
+ procedure Write_Header (T : Boolean := True);
+ -- Write type if T is True, subtype if T is false
+
+ ------------------
+ -- Write_Header --
+ ------------------
+
+ procedure Write_Header (T : Boolean := True) is
+ begin
+ if T then
+ Write_Str ("[type ");
+ else
+ Write_Str ("[subtype ");
+ end if;
+
+ Write_Name_With_Col_Check (Chars (Typ));
+ Write_Str (" is ");
+ end Write_Header;
+
+ -- Start of processing for Write_Itype
+
+ begin
+ if Nkind (Typ) in N_Entity
+ and then Is_Itype (Typ)
+ and then not Itype_Printed (Typ)
+ then
+ -- Itype to be printed
+
+ declare
+ B : constant Node_Id := Etype (Typ);
+ X : Node_Id;
+ P : constant Node_Id := Parent (Typ);
+
+ S : constant Saved_Output_Buffer := Save_Output_Buffer;
+ -- Save current output buffer
+
+ begin
+ -- Write indentation at start of line
+
+ for J in 1 .. Indent loop
+ Write_Char (' ');
+ end loop;
+
+ -- If we have a constructed declaration, print it
+
+ if Present (P) and then Nkind (P) in N_Declaration then
+
+ -- We must set Itype_Printed true before the recursive call to
+ -- print the node, otherwise we get an infinite recursion!
+
+ Set_Itype_Printed (Typ, True);
+
+ -- Write the declaration enclosed in [], avoiding new line
+ -- at start of declaration, and semicolon at end.
+
+ Write_Char ('[');
+ Indent_Annull_Flag := True;
+ Sprint_Node (P);
+ Write_Erase_Char (';');
+
+ -- If no constructed declaration, then we have to concoct the
+ -- source corresponding to the type entity that we have at hand.
+
+ else
+ case Ekind (Typ) is
+
+ -- Access types and subtypes
+
+ when Access_Kind =>
+ Write_Header (Ekind (Typ) = E_Access_Type);
+ Write_Str ("access ");
+
+ if Is_Access_Constant (Typ) then
+ Write_Str ("constant ");
+ elsif Can_Never_Be_Null (Typ) then
+ Write_Str ("not null ");
+ end if;
+
+ Write_Id (Directly_Designated_Type (Typ));
+
+ -- Array types and string types
+
+ when E_Array_Type | E_String_Type =>
+ Write_Header;
+ Write_Str ("array (");
+
+ X := First_Index (Typ);
+ loop
+ Sprint_Node (X);
+
+ if not Is_Constrained (Typ) then
+ Write_Str (" range <>");
+ end if;
+
+ Next_Index (X);
+ exit when No (X);
+ Write_Str (", ");
+ end loop;
+
+ Write_Str (") of ");
+ Sprint_Node (Component_Type (Typ));
+
+ -- Array subtypes and string subtypes
+
+ when E_Array_Subtype | E_String_Subtype =>
+ Write_Header (False);
+ Write_Id (Etype (Typ));
+ Write_Str (" (");
+
+ X := First_Index (Typ);
+ loop
+ Sprint_Node (X);
+ Next_Index (X);
+ exit when No (X);
+ Write_Str (", ");
+ end loop;
+
+ Write_Char (')');
+
+ -- Signed integer types, and modular integer subtypes
+
+ when E_Signed_Integer_Type |
+ E_Signed_Integer_Subtype |
+ E_Modular_Integer_Subtype =>
+
+ Write_Header (Ekind (Typ) = E_Signed_Integer_Type);
+
+ if Ekind (Typ) = E_Signed_Integer_Type then
+ Write_Str ("new ");
+ end if;
+
+ Write_Id (B);
+
+ -- Print bounds if not different from base type
+
+ declare
+ L : constant Node_Id := Type_Low_Bound (Typ);
+ H : constant Node_Id := Type_High_Bound (Typ);
+ LE : constant Node_Id := Type_Low_Bound (B);
+ HE : constant Node_Id := Type_High_Bound (B);
+
+ begin
+ if Nkind (L) = N_Integer_Literal
+ and then Nkind (H) = N_Integer_Literal
+ and then Nkind (LE) = N_Integer_Literal
+ and then Nkind (HE) = N_Integer_Literal
+ and then UI_Eq (Intval (L), Intval (LE))
+ and then UI_Eq (Intval (H), Intval (HE))
+ then
+ null;
+
+ else
+ Write_Str (" range ");
+ Sprint_Node (Type_Low_Bound (Typ));
+ Write_Str (" .. ");
+ Sprint_Node (Type_High_Bound (Typ));
+ end if;
+ end;
+
+ -- Modular integer types
+
+ when E_Modular_Integer_Type =>
+ Write_Header;
+ Write_Str (" mod ");
+ Write_Uint_With_Col_Check (Modulus (Typ), Auto);
+
+ -- Floating point types and subtypes
+
+ when E_Floating_Point_Type |
+ E_Floating_Point_Subtype =>
+
+ Write_Header (Ekind (Typ) = E_Floating_Point_Type);
+
+ if Ekind (Typ) = E_Floating_Point_Type then
+ Write_Str ("new ");
+ end if;
+
+ Write_Id (Etype (Typ));
+
+ if Digits_Value (Typ) /= Digits_Value (Etype (Typ)) then
+ Write_Str (" digits ");
+ Write_Uint_With_Col_Check
+ (Digits_Value (Typ), Decimal);
+ end if;
+
+ -- Print bounds if not different from base type
+
+ declare
+ L : constant Node_Id := Type_Low_Bound (Typ);
+ H : constant Node_Id := Type_High_Bound (Typ);
+ LE : constant Node_Id := Type_Low_Bound (B);
+ HE : constant Node_Id := Type_High_Bound (B);
+
+ begin
+ if Nkind (L) = N_Real_Literal
+ and then Nkind (H) = N_Real_Literal
+ and then Nkind (LE) = N_Real_Literal
+ and then Nkind (HE) = N_Real_Literal
+ and then UR_Eq (Realval (L), Realval (LE))
+ and then UR_Eq (Realval (H), Realval (HE))
+ then
+ null;
+
+ else
+ Write_Str (" range ");
+ Sprint_Node (Type_Low_Bound (Typ));
+ Write_Str (" .. ");
+ Sprint_Node (Type_High_Bound (Typ));
+ end if;
+ end;
+
+ -- Record subtypes
+
+ when E_Record_Subtype =>
+ Write_Header (False);
+ Write_Str ("record");
+ Indent_Begin;
+
+ declare
+ C : Entity_Id;
+ begin
+ C := First_Entity (Typ);
+ while Present (C) loop
+ Write_Indent;
+ Write_Id (C);
+ Write_Str (" : ");
+ Write_Id (Etype (C));
+ Next_Entity (C);
+ end loop;
+ end;
+
+ Indent_End;
+ Write_Indent_Str (" end record");
+
+ -- For all other Itypes, print ??? (fill in later)
+
+ when others =>
+ Write_Header (True);
+ Write_Str ("???");
+
+ end case;
+ end if;
+
+ -- Add terminating bracket and restore output buffer
+
+ Write_Char (']');
+ Write_Eol;
+ Restore_Output_Buffer (S);
+ end;
+
+ Set_Itype_Printed (Typ);
+ end if;
+ end Write_Itype;
+
-------------------------------
-- Write_Name_With_Col_Check --
-------------------------------
@@ -3167,7 +3444,6 @@
-- name by three dots (e.g. R7b becomes R...b).
if Debug_Flag_II and then Name_Buffer (1) in 'A' .. 'Z' then
-
J := 2;
while J < Name_Len loop
exit when Name_Buffer (J) not in 'A' .. 'Z';
@@ -3355,6 +3631,16 @@
end if;
end Write_Str_With_Col_Check_Sloc;
+ -------------------------------
+ -- Write_Uint_With_Col_Check --
+ -------------------------------
+
+ procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format) is
+ begin
+ Col_Check (UI_Decimal_Digits_Hi (U));
+ UI_Write (U, Format);
+ end Write_Uint_With_Col_Check;
+
------------------------------------
-- Write_Uint_With_Col_Check_Sloc --
------------------------------------
Index: par-ch12.adb
===================================================================
--- par-ch12.adb (revision 108280)
+++ par-ch12.adb (working copy)
@@ -519,6 +519,9 @@
-- exception is ABSTRACT, where we have to scan ahead to see if we
-- have a formal derived type or a formal private type definition.
+ -- In addition, in Ada 2005 LIMITED may appear after abstract, so
+ -- that the lookahead must be extended by one more token.
+
when Tok_Abstract =>
Save_Scan_State (Scan_State);
Scan; -- past ABSTRACT
@@ -527,6 +530,18 @@
Restore_Scan_State (Scan_State); -- to ABSTRACT
return P_Formal_Derived_Type_Definition;
+ elsif Token = Tok_Limited then
+ Scan; -- past LIMITED
+
+ if Token = Tok_New then
+ Restore_Scan_State (Scan_State); -- to ABSTRACT
+ return P_Formal_Derived_Type_Definition;
+
+ else
+ Restore_Scan_State (Scan_State); -- to ABSTRACT
+ return P_Formal_Private_Type_Definition;
+ end if;
+
else
Restore_Scan_State (Scan_State); -- to ABSTRACT
return P_Formal_Private_Type_Definition;
@@ -560,7 +575,25 @@
Set_Limited_Present (Typedef_Node);
return Typedef_Node;
+ elsif Token = Tok_New then
+ Restore_Scan_State (Scan_State); -- to LIMITED
+ return P_Formal_Derived_Type_Definition;
+
else
+ if Token = Tok_Abstract then
+ Error_Msg_SC ("ABSTRACT must come before LIMITED");
+ Scan; -- past improper ABSTRACT
+
+ if Token = Tok_New then
+ Restore_Scan_State (Scan_State); -- to LIMITED
+ return P_Formal_Derived_Type_Definition;
+
+ else
+ Restore_Scan_State (Scan_State);
+ return P_Formal_Private_Type_Definition;
+ end if;
+ end if;
+
Restore_Scan_State (Scan_State);
return P_Formal_Private_Type_Definition;
end if;
@@ -666,6 +699,20 @@
Scan; -- past LIMITED
end if;
+ if Token = Tok_Abstract then
+ if Prev_Token = Tok_Tagged then
+ Error_Msg_SC ("ABSTRACT must come before TAGGED");
+ elsif Prev_Token = Tok_Limited then
+ Error_Msg_SC ("ABSTRACT must come before LIMITED");
+ end if;
+
+ Resync_Past_Semicolon;
+
+ elsif Token = Tok_Tagged then
+ Error_Msg_SC ("TAGGED must come before LIMITED");
+ Resync_Past_Semicolon;
+ end if;
+
Set_Sloc (Def_Node, Token_Ptr);
T_Private;
return Def_Node;
@@ -676,9 +723,11 @@
--------------------------------------------
-- FORMAL_DERIVED_TYPE_DEFINITION ::=
- -- [abstract] new SUBTYPE_MARK [[AND interface_list] with private]
+ -- [abstract] [limited]
+ -- new SUBTYPE_MARK [[AND interface_list] with private]
- -- The caller has checked the initial token(s) is/are NEW or ASTRACT NEW
+ -- The caller has checked the initial token(s) is/are NEW, ASTRACT NEW
+ -- LIMITED NEW, or ABSTRACT LIMITED NEW
-- Error recovery: cannot raise Error_Resync
@@ -693,6 +742,22 @@
Scan; -- past ABSTRACT
end if;
+ if Token = Tok_Limited then
+ Set_Limited_Present (Def_Node);
+ Scan; -- past Limited
+
+ if Ada_Version < Ada_05 then
+ Error_Msg_SP
+ ("LIMITED in derived type is an Ada 2005 extension");
+ Error_Msg_SP
+ ("\unit must be compiled with -gnat05 switch");
+ end if;
+
+ if Token = Tok_Abstract then
+ Scan; -- past ABSTRACT. diagnosed already in caller.
+ end if;
+ end if;
+
Scan; -- past NEW;
Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
No_Constraint;
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 108280)
+++ sinfo.ads (working copy)
@@ -32,8 +32,8 @@
------------------------------------------------------------------------------
-- This package defines the structure of the abstract syntax tree. The Tree
--- package provides a basic tree structure. Sinfo describes how this
--- structure is used to represent the syntax of an Ada program.
+-- package provides a basic tree structure. Sinfo describes how this structure
+-- is used to represent the syntax of an Ada program.
-- Note: the grammar used here is taken from Version 5.95 of the RM, dated
-- November 1994. The grammar in the RM is followed very closely in the tree
@@ -43,12 +43,12 @@
-- program, but also the results of semantic analysis. In particular, the
-- nodes for defining identifiers, defining character literals and defining
-- operator symbols, collectively referred to as entities, represent what
--- would normally be regarded as the symbol table information. In addition
--- a number of the tree nodes contain semantic information.
+-- would normally be regarded as the symbol table information. In addition a
+-- number of the tree nodes contain semantic information.
--- WARNING: There is a C version of this package. Any changes to this
--- source file must be properly reflected in this C header file sinfo.h
--- which is created automatically from sinfo.ads using xsinfo.adb.
+-- WARNING: There is a C version of this package. Any changes to this source
+-- file must be properly reflected in this C header file sinfo.h which is
+-- created automatically from sinfo.ads using xsinfo.adb.
with Types; use Types;
with Uintp; use Uintp;
@@ -61,8 +61,8 @@
---------------------------------
-- If changes are made to this file, a number of related steps must be
- -- carried out to ensure consistency. First, if a field access function
- -- is added, it appears in seven places:
+ -- carried out to ensure consistency. First, if a field access function is
+ -- added, it appears in seven places:
-- The documentation associated with the node
-- The spec of the access function in sinfo.ads
@@ -72,9 +72,9 @@
-- The body of the set procedure in sinfo.adb
-- The pragma Inline at the end of sinfo.ads for the set procedure
- -- The field chosen must be consistent in all places, and, for a node
- -- that is a subexpression, must not overlap any of the standard
- -- expression fields.
+ -- The field chosen must be consistent in all places, and, for a node that
+ -- is a subexpression, must not overlap any of the standard expression
+ -- fields.
-- In addition, if any of the standard expression fields is changed, then
-- the utiliy program which creates the Treeprs spec (in file treeprs.ads)
@@ -99,52 +99,52 @@
-- Finally, four utility programs must be run:
- -- Run CSinfo to check that you have made the changes consistently.
- -- It checks most of the rules given above, with clear error messages.
- -- This utility reads sinfo.ads and sinfo.adb and generates a report
- -- to standard output.
+ -- Run CSinfo to check that you have made the changes consistently. It
+ -- checks most of the rules given above, with clear error messages. This
+ -- utility reads sinfo.ads and sinfo.adb and generates a report to
+ -- standard output.
-- Run XSinfo to create a-sinfo.h, the corresponding C header. This
- -- utility reads sinfo.ads and generates a-sinfo.h. Note that it
- -- does not need to read sinfo.adb, since the contents of the body
- -- are algorithmically determinable from the spec.
+ -- utility reads sinfo.ads and generates a-sinfo.h. Note that it does
+ -- not need to read sinfo.adb, since the contents of the body are
+ -- algorithmically determinable from the spec.
- -- Run XTreeprs to create treeprs.ads, an updated version of
- -- the module that is used to drive the tree print routine. This
- -- utility reads (but does not modify) treeprs.adt, the template
- -- that provides the basic structure of the file, and then fills
- -- in the data from the comments in sinfo.ads.
+ -- Run XTreeprs to create treeprs.ads, an updated version of the module
+ -- that is used to drive the tree print routine. This utility reads (but
+ -- does not modify) treeprs.adt, the template that provides the basic
+ -- structure of the file, and then fills in the data from the comments
+ -- in sinfo.ads.
- -- Run XNmake to create nmake.ads and nmake.adb, the package body
- -- and spec of the Nmake package which contains functions for
- -- constructing nodes.
+ -- Run XNmake to create nmake.ads and nmake.adb, the package body and
+ -- spec of the Nmake package which contains functions for constructing
+ -- nodes.
- -- Note: sometime we could write a utility that actually generated the
- -- body of sinfo from the spec instead of simply checking it, since, as
- -- noted above, the contents of the body can be determined from the spec.
+ -- Note: sometime we could write a utility that actually generated the body
+ -- of sinfo from the spec instead of simply checking it, since, as noted
+ -- above, the contents of the body can be determined from the spec.
--------------------------------
-- Implicit Nodes in the Tree --
--------------------------------
- -- Generally the structure of the tree very closely follows the grammar
- -- as defined in the RM. However, certain nodes are omitted to save
- -- space and simplify semantic processing. Two general classes of such
- -- omitted nodes are as follows:
+ -- Generally the structure of the tree very closely follows the grammar as
+ -- defined in the RM. However, certain nodes are omitted to save space and
+ -- simplify semantic processing. Two general classes of such omitted nodes
+ -- are as follows:
-- If the only possibilities for a non-terminal are one or more other
- -- non terminals (i.e. the rule is a "skinny" rule), then usually the
+ -- non-terminals (i.e. the rule is a "skinny" rule), then usually the
-- corresponding node is omitted from the tree, and the target construct
- -- appears directly. For example, a real type definition is either a
- -- floating point definition or a fixed point definition. No explicit
- -- node appears for real type definition. Instead either the floating
- -- point definition or fixed point definition appears directly.
+ -- appears directly. For example, a real type definition is either
+ -- floating point definition or a fixed point definition. No explicit node
+ -- appears for real type definition. Instead either the floating point
+ -- definition or fixed point definition appears directly.
-- If a non-terminal corresponds to a list of some other non-terminal
- -- (possibly with separating punctuation), then usually it is omitted
- -- from the tree, and a list of components appears instead. For
- -- example, sequence of statements does not appear explicitly in the
- -- tree. Instead a list of statements appears directly.
+ -- (possibly with separating punctuation), then usually it is omitted from
+ -- the tree, and a list of components appears instead. For example,
+ -- sequence of statements does not appear explicitly in the tree. Instead
+ -- a list of statements appears directly.
-- Some additional cases of omitted nodes occur and are documented
-- individually. In particular, many nodes are omitted in the tree
@@ -155,23 +155,22 @@
-------------------------------------------
-- In several declarative forms in the syntax, lists of defining
- -- identifiers appear (object declarations, component declarations,
- -- number declarations etc.)
+ -- identifiers appear (object declarations, component declarations, number
+ -- declarations etc.)
- -- The semantics of such statements are equivalent to a series of
- -- identical declarations of single defining identifiers (except that
- -- conformance checks require the same grouping of identifiers in the
- -- parameter case).
+ -- The semantics of such statements are equivalent to a series of identical
+ -- declarations of single defining identifiers (except that conformance
+ -- checks require the same grouping of identifiers in the parameter case).
-- To simplify semantic processing, the parser breaks down such multiple
-- declaration cases into sequences of single declarations, duplicating
- -- type and initialization information as required. The flags More_Ids
- -- and Prev_Ids are used to record the original form of the source in
- -- the case where the original source used a list of names, More_Ids
- -- being set on all but the last name and Prev_Ids being set on all
- -- but the first name. These flags are used to reconstruct the original
- -- source (e.g. in the Sprint package), and also are included in the
- -- conformance checks, but otherwise have no semantic significance.
+ -- type and initialization information as required. The flags More_Ids and
+ -- Prev_Ids are used to record the original form of the source in the case
+ -- where the original source used a list of names, More_Ids being set on
+ -- all but the last name and Prev_Ids being set on all but the first name.
+ -- These flags are used to reconstruct the original source (e.g. in the
+ -- Sprint package), and also are included in the conformance checks, but
+ -- otherwise have no semantic significance.
-- Note: the reason that we use More_Ids and Prev_Ids rather than
-- First_Name and Last_Name flags is so that the flags are off in the
@@ -182,20 +181,20 @@
-----------------------
-- With a few exceptions, if a construction of the form {non-terminal}
- -- appears in the tree, lists are used in the corresponding tree node
- -- (see package Nlists for handling of node lists). In this case a field
- -- of the parent node points to a list of nodes for the non-terminal. The
- -- field name for such fields has a plural name which always ends in "s".
- -- For example, a case statement has a field Alternatives pointing to a
- -- list of case statement alternative nodes.
+ -- appears in the tree, lists are used in the corresponding tree node (see
+ -- package Nlists for handling of node lists). In this case a field of the
+ -- parent node points to a list of nodes for the non-terminal. The field
+ -- name for such fields has a plural name which always ends in "s". For
+ -- example, a case statement has a field Alternatives pointing to list of
+ -- case statement alternative nodes.
- -- Only fields pointing to lists have names ending in "s", so generally
- -- the structure is strongly typed, fields not ending in s point to
- -- single nodes, and fields ending in s point to lists.
+ -- Only fields pointing to lists have names ending in "s", so generally the
+ -- structure is strongly typed, fields not ending in s point to single
+ -- nodes, and fields ending in s point to lists.
-- The following example shows how a traversal of a list is written. We
- -- suppose here that Stmt points to a N_Case_Statement node which has
- -- a list field called Alternatives:
+ -- suppose here that Stmt points to a N_Case_Statement node which has a
+ -- list field called Alternatives:
-- Alt := First (Alternatives (Stmt));
-- while Present (Alt) loop
@@ -205,8 +204,8 @@
-- Alt := Next (Alt);
-- end loop;
- -- The Present function tests for Empty, which in this case signals the
- -- end of the list. First returns Empty immediately if the list is empty.
+ -- The Present function tests for Empty, which in this case signals the end
+ -- of the list. First returns Empty immediately if the list is empty.
-- Present is defined in Atree, First and Next are defined in Nlists.
-- The exceptions to this rule occur with {DEFINING_IDENTIFIERS} in all
@@ -219,25 +218,25 @@
-- Pragmas --
-------------
- -- Pragmas can appear in many different context, but are not included
- -- in the grammar. Still they must appear in the tree, so they can be
- -- properly processed.
+ -- Pragmas can appear in many different context, but are not included in
+ -- the grammar. Still they must appear in the tree, so they can be properly
+ -- processed.
- -- Two approaches are used. In some cases, an extra field is defined
- -- in an appropriate node that contains a list of pragmas appearing
- -- in the expected context. For example pragmas can appear before an
+ -- Two approaches are used. In some cases, an extra field is defined in an
+ -- appropriate node that contains a list of pragmas appearing in the
+ -- expected context. For example pragmas can appear before an
-- Accept_Alternative in a Selective_Accept_Statement, and these pragmas
-- appear in the Pragmas_Before field of the N_Accept_Alternative node.
-- The other approach is to simply allow pragmas to appear in syntactic
-- lists where the grammar (of course) does not include the possibility.
- -- For example, the Variants field of an N_Variant_Part node points to
- -- a list that can contain both N_Pragma and N_Variant nodes.
+ -- For example, the Variants field of an N_Variant_Part node points to a
+ -- list that can contain both N_Pragma and N_Variant nodes.
-- To make processing easier in the latter case, the Nlists package
-- provides a set of routines (First_Non_Pragma, Last_Non_Pragma,
- -- Next_Non_Pragma, Prev_Non_Pragma) that allow such lists to be
- -- handled ignoring all pragmas.
+ -- Next_Non_Pragma, Prev_Non_Pragma) that allow such lists to be handled
+ -- ignoring all pragmas.
-- In the case of the variants list, we can either write:
@@ -255,30 +254,30 @@
-- Variant := Next_Non_Pragma (Variant);
-- end loop;
- -- In the first form of the loop, Variant can either be an N_Pragma or
- -- an N_Variant node. In the second form, Variant can only be N_Variant
- -- since all pragmas are skipped.
+ -- In the first form of the loop, Variant can either be an N_Pragma or an
+ -- N_Variant node. In the second form, Variant can only be N_Variant since
+ -- all pragmas are skipped.
---------------------
-- Optional Fields --
---------------------
-- Fields which correspond to a section of the syntax enclosed in square
- -- brackets are generally omitted (and the corresponding field set to
- -- Empty for a node, or No_List for a list). The documentation of such
- -- fields notes these cases. One exception to this rule occurs in the
- -- case of possibly empty statement sequences (such as the sequence of
- -- statements in an entry call alternative). Such cases appear in the
- -- syntax rules as [SEQUENCE_OF_STATEMENTS] and the fields corresponding
- -- to such optional statement sequences always contain an empty list (not
- -- No_List) if no statements are present.
+ -- brackets are generally omitted (and the corresponding field set to Empty
+ -- for a node, or No_List for a list). The documentation of such fields
+ -- notes these cases. One exception to this rule occurs in the case of
+ -- possibly empty statement sequences (such as the sequence of statements
+ -- in an entry call alternative). Such cases appear in the syntax rules as
+ -- [SEQUENCE_OF_STATEMENTS] and the fields corresponding to such optional
+ -- statement sequences always contain an empty list (not No_List) if no
+ -- statements are present.
- -- Note: the utility program that constructs the body and spec of the
- -- Nmake package relies on the format of the comments to determine if
- -- a field should have a default value in the corresponding make routine.
- -- The rule is that if the first line of the description of the field
- -- contains the string "(set to xxx if", then a default value of xxx is
- -- provided for this field in the corresponding Make_yyy routine.
+ -- Note: the utility program that constructs the body and spec of the Nmake
+ -- package relies on the format of the comments to determine if a field
+ -- should have a default value in the corresponding make routine. The rule
+ -- is that if the first line of the description of the field contains the
+ -- string "(set to xxx if", then a default value of xxx is provided for
+ -- this field in the corresponding Make_yyy routine.
-----------------------------------
-- Note on Body/Spec Terminology --
@@ -287,33 +286,33 @@
-- In informal discussions about Ada, it is customary to refer to package
-- and subprogram specs and bodies. However, this is not technically
-- correct, what is normally referred to as a spec or specification is in
- -- fact a package declaration or subprogram declaration. We are careful
- -- in GNAT to use the correct terminology and in particular, the full
- -- word specification is never used as an incorrect substitute for
- -- declaration. The structure and terminology used in the tree also
- -- reflects the grammar and thus uses declaration and specification in
- -- the technically correct manner.
+ -- fact a package declaration or subprogram declaration. We are careful in
+ -- GNAT to use the correct terminology and in particular, the full word
+ -- specification is never used as an incorrect substitute for declaration.
+ -- The structure and terminology used in the tree also reflects the grammar
+ -- and thus uses declaration and specification in the technically correct
+ -- manner.
- -- However, there are contexts in which the informal terminology is
- -- useful. We have the word "body" to refer to the Interp_Etype declared by
- -- the declaration of a unit body, and in some contexts we need a
- -- similar term to refer to the entity declared by the package or
- -- subprogram declaration, and simply using declaration can be confusing
- -- since the body also has a declaration.
+ -- However, there are contexts in which the informal terminology is useful.
+ -- We have the word "body" to refer to the Interp_Etype declared by the
+ -- declaration of a unit body, and in some contexts we need similar term to
+ -- refer to the entity declared by the package or subprogram declaration,
+ -- and simply using declaration can be confusing since the body also has a
+ -- declaration.
- -- An example of such a context is the link between the package body
- -- and its declaration. With_Declaration is confusing, since
- -- the package body itself is a declaration.
+ -- An example of such a context is the link between the package body and
+ -- its declaration. With_Declaration is confusing, since the package body
+ -- itself is a declaration.
- -- To deal with this problem, we reserve the informal term Spec, i.e.
- -- the popular abbreviation used in this context, to refer to the entity
+ -- To deal with this problem, we reserve the informal term Spec, i.e. the
+ -- popular abbreviation used in this context, to refer to the entity
-- declared by the package or subprogram declaration. So in the above
-- example case, the field in the body is called With_Spec.
-- Another important context for the use of the word Spec is in error
- -- messages, where a hyper-correct use of declaration would be confusing
- -- to a typical Ada programmer, and even for an expert programmer can
- -- cause confusion since the body has a declaration as well.
+ -- messages, where a hyper-correct use of declaration would be confusing to
+ -- a typical Ada programmer, and even for an expert programmer can cause
+ -- confusion since the body has a declaration as well.
-- So, to summarize:
@@ -340,8 +339,8 @@
-- Internal Use Nodes --
------------------------
- -- These are Node_Kind settings used in the internal implementation
- -- which are not logically part of the specification.
+ -- These are Node_Kind settings used in the internal implementation which
+ -- are not logically part of the specification.
-- N_Unused_At_Start
-- Completely unused entry at the start of the enumeration type. This
@@ -352,24 +351,24 @@
-- Completely unused entry at the end of the enumeration type. This is
-- handy so that arrays with Node_Kind as the index type have an extra
-- entry at the end (see for example the use of the Pchar_Pos_Array in
- -- Treepr, where the extra entry provides the limit value when dealing
- -- with the last used entry in the array).
+ -- Treepr, where the extra entry provides the limit value when dealing with
+ -- the last used entry in the array).
-----------------------------------------
-- Note on the settings of Sloc fields --
-----------------------------------------
- -- The Sloc field of nodes that come from the source is set by the
- -- parser. For internal nodes, and nodes generated during expansion
- -- the Sloc is usually set in the call to the constructor for the node.
- -- In general the Sloc value chosen for an internal node is the Sloc of
- -- the source node whose processing is responsible for the expansion. For
- -- example, the Sloc of an inherited primitive operation is the Sloc of
- -- the corresponding derived type declaration.
+ -- The Sloc field of nodes that come from the source is set by the parser.
+ -- For internal nodes, and nodes generated during expansion the Sloc is
+ -- usually set in the call to the constructor for the node. In general the
+ -- Sloc value chosen for an internal node is the Sloc of the source node
+ -- whose processing is responsible for the expansion. For example, the Sloc
+ -- of an inherited primitive operation is the Sloc of the corresponding
+ -- derived type declaration.
- -- For the nodes of a generic instantiation, the Sloc value is encoded
- -- to represent both the original Sloc in the generic unit, and the Sloc
- -- of the instantiation itself. See Sinput.ads for details.
+ -- For the nodes of a generic instantiation, the Sloc value is encoded to
+ -- represent both the original Sloc in the generic unit, and the Sloc of
+ -- the instantiation itself. See Sinput.ads for details.
-- Subprogram instances create two callable entities: one is the visible
-- subprogram instance, and the other is an anonymous subprogram nested
@@ -383,12 +382,12 @@
-- In the following node definitions, all fields, both syntactic and
-- semantic, are documented. The one exception is in the case of entities
- -- (defining indentifiers, character literals and operator symbols),
- -- where the usage of the fields depends on the entity kind. Entity
- -- fields are fully documented in the separate package Einfo.
+ -- (defining indentifiers, character literals and operator symbols), where
+ -- the usage of the fields depends on the entity kind. Entity fields are
+ -- fully documented in the separate package Einfo.
- -- In the node definitions, three common sets of fields are abbreviated
- -- to save both space in the documentation, and also space in the string
+ -- In the node definitions, three common sets of fields are abbreviated to
+ -- save both space in the documentation, and also space in the string
-- (defined in Tree_Print_Strings) used to print trees. The following
-- abbreviations are used:
@@ -427,15 +426,14 @@
-- Note: see under (EXPRESSION) for further details on the use of
-- the Paren_Count field to record the number of parentheses levels.
- -- Node_Kind is the type used in the Nkind field to indicate the node
- -- kind. The actual definition of this type is given later (the reason
- -- for this is that we want the descriptions ordered by logical chapter
- -- in the RM, but the type definition is reordered to facilitate the
- -- definition of some subtype ranges. The individual descriptions of
- -- the nodes show how the various fields are used in each node kind,
- -- as well as providing logical names for the fields. Functions and
- -- procedures are provided for accessing and setting these fields
- -- using these logical names.
+ -- Node_Kind is the type used in the Nkind field to indicate the node kind.
+ -- The actual definition of this type is given later (the reason for this
+ -- is that we want the descriptions ordered by logical chapter in the RM,
+ -- but the type definition is reordered to facilitate the definition of
+ -- some subtype ranges. The individual descriptions of the nodes show how
+ -- the various fields are used in each node kind, as well as providing
+ -- logical names for the fields. Functions and procedures are provided for
+ -- accessing and setting these fields using these logical names.
-----------------------
-- Gigi Restrictions --
@@ -458,118 +456,115 @@
-- The following flag fields appear in all nodes
-- Analyzed (Flag1)
- -- This flag is used to indicate that a node (and all its children
- -- have been analyzed. It is used to avoid reanalysis of a node that
- -- has already been analyzed, both for efficiency and functional
- -- correctness reasons.
+ -- This flag is used to indicate that a node (and all its children have
+ -- been analyzed. It is used to avoid reanalysis of a node that has
+ -- already been analyzed, both for efficiency and functional correctness
+ -- reasons.
-- Comes_From_Source (Flag2)
- -- This flag is on for any nodes built by the scanner or parser from
- -- the source program, and off for any nodes built by the analyzer or
+ -- This flag is on for any nodes built by the scanner or parser from the
+ -- source program, and off for any nodes built by the analyzer or
-- expander. It indicates that a node comes from the original source.
-- This flag is defined in Atree.
-- Error_Posted (Flag3)
- -- This flag is used to avoid multiple error messages being posted
- -- on or referring to the same node. This flag is set if an error
- -- message refers to a node or is posted on its source location,
- -- and has the effect of inhibiting further messages involving
- -- this same node.
+ -- This flag is used to avoid multiple error messages being posted on or
+ -- referring to the same node. This flag is set if an error message
+ -- refers to a node or is posted on its source location, and has the
+ -- effect of inhibiting further messages involving this same node.
-- Has_Dynamic_Length_Check (Flag10-Sem)
- -- This flag is present on all nodes. It is set to indicate that one
- -- of the routines in unit Checks has generated a length check action
- -- which has been inserted at the flagged node. This is used to avoid
- -- the generation of duplicate checks.
+ -- This flag is present on all nodes. It is set to indicate that one of
+ -- the routines in unit Checks has generated a length check action which
+ -- has been inserted at the flagged node. This is used to avoid the
+ -- generation of duplicate checks.
-- Has_Dynamic_Range_Check (Flag12-Sem)
- -- This flag is present on all nodes. It is set to indicate that one
- -- of the routines in unit Checks has generated a range check action
- -- which has been inserted at the flagged node. This is used to avoid
- -- the generation of duplicate checks.
+ -- This flag is present on all nodes. It is set to indicate that one of
+ -- the routines in unit Checks has generated a range check action which
+ -- has been inserted at the flagged node. This is used to avoid the
+ -- generation of duplicate checks.
------------------------------------
-- Description of Semantic Fields --
------------------------------------
- -- The meaning of the syntactic fields is generally clear from their
- -- names without any further description, since the names are chosen
- -- to correspond very closely to the syntax in the reference manual.
- -- This section describes the usage of the semantic fields, which are
- -- used to contain additional information determined during semantic
- -- analysis.
+ -- The meaning of the syntactic fields is generally clear from their names
+ -- without any further description, since the names are chosen to
+ -- correspond very closely to the syntax in the reference manual. This
+ -- section describes the usage of the semantic fields, which are used to
+ -- contain additional information determined during semantic analysis.
-- ABE_Is_Certain (Flag18-Sem)
- -- This flag is set in an instantiation node or a call node is
- -- determined to be sure to raise an ABE. This is used to trigger
- -- special handling of such cases, particularly in the instantiation
- -- case where we avoid instantiating the body if this flag is set.
- -- This flag is also present in an N_Formal_Package_Declaration_Node
- -- since formal package declarations are treated like instantiations,
- -- but it is always set to False in this context.
+ -- This flag is set in an instantiation node or a call node is determined
+ -- to be sure to raise an ABE. This is used to trigger special handling
+ -- of such cases, particularly in the instantiation case where we avoid
+ -- instantiating the body if this flag is set. This flag is also present
+ -- in an N_Formal_Package_Declaration_Node since formal package
+ -- declarations are treated like instantiations, but it is always set to
+ -- False in this context.
-- Accept_Handler_Records (List5-Sem)
- -- This field is present only in an N_Accept_Alternative node. It is
- -- used to temporarily hold the exception handler records from an
- -- accept statement in a selective accept. These exception handlers
- -- will eventually be placed in the Handler_Records list of the
- -- procedure built for this accept (see Expand_N_Selective_Accept
- -- procedure in Exp_Ch9 for further details).
+ -- This field is present only in an N_Accept_Alternative node. It is used
+ -- to temporarily hold the exception handler records from an accept
+ -- statement in a selective accept. These exception handlers will
+ -- eventually be placed in the Handler_Records list of the procedure
+ -- built for this accept (see Expand_N_Selective_Accept procedure in
+ -- Exp_Ch9 for further details).
-- Access_Types_To_Process (Elist2-Sem)
-- Present in N_Freeze_Entity nodes for Incomplete or private types.
- -- Contains the list of access types which may require specific
- -- treatment when the nature of the type completion is completely
- -- known. An example of such treatement is the generation of the
- -- associated_final_chain.
+ -- Contains the list of access types which may require specific treatment
+ -- when the nature of the type completion is completely known. An example
+ -- of such treatement is the generation of the associated_final_chain.
-- Actions (List1-Sem)
- -- This field contains a sequence of actions that are associated
- -- with the node holding the field. See the individual node types
- -- for details of how this field is used, as well as the description
- -- of the specific use for a particular node type.
+ -- This field contains a sequence of actions that are associated with the
+ -- node holding the field. See the individual node types for details of
+ -- how this field is used, as well as the description of the specific use
+ -- for a particular node type.
-- Activation_Chain_Entity (Node3-Sem)
-- This is used in tree nodes representing task activators (blocks,
-- subprogram bodies, package declarations, and task bodies). It is
-- initially Empty, and then gets set to point to the entity for the
-- declared Activation_Chain variable when the first task is declared.
- -- When tasks are declared in the corresponding declarative region
- -- this entity is located by name (its name is always _Chain) and
- -- the declared tasks are added to the chain.
+ -- When tasks are declared in the corresponding declarative region this
+ -- entity is located by name (its name is always _Chain) and the declared
+ -- tasks are added to the chain.
-- Acts_As_Spec (Flag4-Sem)
- -- A flag set in the N_Subprogram_Body node for a subprogram body
- -- which is acting as its own spec. This flag also appears in the
- -- compilation unit node at the library level for such a subprogram
- -- (see further description in spec of Lib package).
+ -- A flag set in the N_Subprogram_Body node for a subprogram body which
+ -- is acting as its own spec. This flag also appears in the compilation
+ -- unit node at the library level for such a subprogram (see further
+ -- description in spec of Lib package).
-- Actual_Designated_Subtype (Node2-Sem)
- -- Present in N_Free_Statement and N_Explicit_Dereference nodes. If
- -- GIGI needs to known the dynamic constrained subtype of the designated
+ -- Present in N_Free_Statement and N_Explicit_Dereference nodes. If gigi
+ -- needs to known the dynamic constrained subtype of the designated
-- object, this attribute is set to that type. This is done for
-- N_Free_Statements for access-to-classwide types and access to
- -- unconstrained packed array types, and for N_Explicit_Dereference
- -- when the designated type is an unconstrained packed array and the
+ -- unconstrained packed array types, and for N_Explicit_Dereference when
+ -- the designated type is an unconstrained packed array and the
-- dereference is the prefix of a 'Size attribute reference.
-- Aggregate_Bounds (Node3-Sem)
-- Present in array N_Aggregate nodes. If the aggregate contains
-- component associations this field points to an N_Range node whose
-- bounds give the lowest and highest discrete choice values. If the
- -- named aggregate contains a dynamic or null choice this field is
- -- empty. If the aggregate contains positional elements this field
- -- points to an N_Integer_Literal node giving the number of positional
- -- elements. Note that if the aggregate contains positional elements
- -- and an other choice the N_Integer_Literal only accounts for the
- -- number of positional elements.
+ -- named aggregate contains a dynamic or null choice this field is empty.
+ -- If the aggregate contains positional elements this field points to an
+ -- N_Integer_Literal node giving the number of positional elements. Note
+ -- that if the aggregate contains positional elements and an other choice
+ -- the N_Integer_Literal only accounts for the number of positional
+ -- elements.
-- All_Others (Flag11-Sem)
- -- Present in an N_Others_Choice node. This flag is set in the case
- -- of an others exception where all exceptions are to be caught, even
- -- those that are not normally handled (in particular the tasking abort
- -- signal). This is used for translation of the at end handler into
- -- a normal exception handler.
+ -- Present in an N_Others_Choice node. This flag is set in the case of an
+ -- others exception where all exceptions are to be caught, even those
+ -- that are not normally handled (in particular the tasking abort
+ -- signal). This is used for translation of the at end handler into a
+ -- normal exception handler.
-- Assignment_OK (Flag15-Sem)
-- This flag is set in a subexpression node for an object, indicating
@@ -580,37 +575,37 @@
-- limited type objects (such as tasks), setting discriminant fields,
-- setting tag values, etc. N_Object_Declaration nodes also have this
-- flag defined. Here it is used to indicate that an initialization
- -- expression is valid, even where it would normally not be allowed
- -- (e.g. where the type involved is limited).
+ -- expression is valid, even where it would normally not be allowed (e.g.
+ -- where the type involved is limited).
-- Associated_Node (Node4-Sem)
-- Present in nodes that can denote an entity: identifiers, character
-- literals, operator symbols, expanded names, operator nodes, and
- -- attribute reference nodes (all these nodes have an Entity field).
- -- This field is also present in N_Aggregate, N_Selected_Component,
- -- and N_Extension_Aggregate nodes. This field is used in generic
- -- processing to create links between the generic template and the
- -- generic copy. See Sem_Ch12.Get_Associated_Node for full details.
- -- Note that this field overlaps Entity, which is fine, since, as
- -- explained in Sem_Ch12, the normal function of Entity is not
- -- required at the point where the Associated_Node is set. Note
- -- also, that in generic templates, this means that the Entity field
- -- does not necessarily point to an Entity. Since the back end is
- -- expected to ignore generic templates, this is harmless.
+ -- attribute reference nodes (all these nodes have an Entity field). This
+ -- field is also present in N_Aggregate, N_Selected_Component, and
+ -- N_Extension_Aggregate nodes. This field is used in generic processing
+ -- to create links between the generic template and the generic copy. See
+ -- Sem_Ch12.Get_Associated_Node for full details. Note that this field
+ -- overlaps Entity, which is fine, since, as explained in Sem_Ch12, the
+ -- normal function of Entity is not required at the point where the
+ -- Associated_Node is set. Note also, that in generic templates, this
+ -- means that the Entity field does not necessarily point to an Entity.
+ -- Since the back end is expected to ignore generic templates, this is
+ -- harmless.
-- At_End_Proc (Node1)
- -- This field is present in an N_Handled_Sequence_Of_Statements node.
- -- It contains an identifier reference for the cleanup procedure to
- -- be called. See description of this node for further details.
+ -- This field is present in an N_Handled_Sequence_Of_Statements node. It
+ -- contains an identifier reference for the cleanup procedure to be
+ -- called. See description of this node for further details.
-- Backwards_OK (Flag6-Sem)
- -- A flag present in the N_Assignment_Statement node. It is used only
- -- if the type being assigned is an array type, and is set if analysis
+ -- A flag present in the N_Assignment_Statement node. It is used only if
+ -- the type being assigned is an array type, and is set if analysis
-- determines that it is definitely safe to do the copy backwards, i.e.
- -- starting at the highest addressed element. Note that if neither of
- -- the flags Forwards_OK or Backwards_OK is set, it means that the
- -- front end could not determine that either direction is definitely
- -- safe, and a runtime check is required.
+ -- starting at the highest addressed element. Note that if neither of the
+ -- flags Forwards_OK or Backwards_OK is set, it means that the front end
+ -- could not determine that either direction is definitely safe, and a
+ -- runtime check is required.
-- Body_To_Inline (Node3-Sem)
-- present in subprogram declarations. Denotes analyzed but unexpanded
@@ -621,68 +616,68 @@
-- which is used directly in later calls to the original subprogram.
-- Body_Required (Flag13-Sem)
- -- A flag that appears in the N_Compilation_Unit node indicating that
- -- the corresponding unit requires a body. For the package case, this
- -- indicates that a completion is required. In Ada 95, if the flag
- -- is not set for the package case, then a body may not be present.
- -- In Ada 83, if the flag is not set for the package case, then a
- -- body is optional. For a subprogram declaration, the flag is set
- -- except in the case where a pragma Import or Interface applies,
- -- in which case no body is permitted (in Ada 83 or Ada 95).
+ -- A flag that appears in the N_Compilation_Unit node indicating that the
+ -- corresponding unit requires a body. For the package case, this
+ -- indicates that a completion is required. In Ada 95, if the flag is not
+ -- set for the package case, then a body may not be present. In Ada 83,
+ -- if the flag is not set for the package case, then body is optional.
+ -- For a subprogram declaration, the flag is set except in the case where
+ -- a pragma Import or Interface applies, in which case no body is
+ -- permitted (in Ada 83 or Ada 95).
-- By_Ref (Flag5-Sem)
-- A flag present in the N_Return_Statement_Node. It is set when the
- -- returned expression is already allocated on the secondary stack
- -- and thus the result is passed by reference rather than copied
- -- another time.
+ -- returned expression is already allocated on the secondary stack and
+ -- thus the result is passed by reference rather than copied another
+ -- time.
-- Check_Address_Alignment (Flag11-Sem)
-- A flag present in N_Attribute_Definition clause for a 'Address
- -- attribute definition. This flag is set if a dynamic check should
- -- be generated at the freeze point for the entity to which this
- -- address clause applies. The reason that we need this flag is that
- -- we want to check for range checks being suppressed at the point
- -- where the attribute definition clause is given, rather than
- -- testing this at the freeze point.
+ -- attribute definition. This flag is set if a dynamic check should be
+ -- generated at the freeze point for the entity to which this address
+ -- clause applies. The reason that we need this flag is that we want to
+ -- check for range checks being suppressed at the point where the
+ -- attribute definition clause is given, rather than testing this at the
+ -- freeze point.
-- Compile_Time_Known_Aggregate (Flag18-Sem)
- -- Present in N_Aggregate nodes. Set for aggregates which can be
- -- fully evaluated at compile time without raising constraint error.
- -- Such aggregates can be passed as is to Gigi without any expansion.
- -- See Sem_Aggr for the specific conditions under which an aggregate
- -- has this flag set. See also the flag Static_Processing_OK.
+ -- Present in N_Aggregate nodes. Set for aggregates which can be fully
+ -- evaluated at compile time without raising constraint error. Such
+ -- aggregates can be passed as is to Gigi without any expansion. See
+ -- Sem_Aggr for the specific conditions under which an aggregate has this
+ -- flag set. See also the flag Static_Processing_OK.
-- Condition_Actions (List3-Sem)
- -- This field appears in else-if nodes and in the iteration scheme
- -- node for while loops. This field is only used during semantic
- -- processing to temporarily hold actions inserted into the tree.
- -- In the tree passed to gigi, the condition actions field is always
- -- set to No_List. For details on how this field is used, see the
- -- routine Insert_Actions in package Exp_Util, and also the expansion
- -- routines for the relevant nodes.
+ -- This field appears in else-if nodes and in the iteration scheme node
+ -- for while loops. This field is only used during semantic processing to
+ -- temporarily hold actions inserted into the tree. In the tree passed to
+ -- gigi, the condition actions field is always set to No_List. For
+ -- details on how this field is used, see the routine Insert_Actions in
+ -- package Exp_Util, and also the expansion routines for the relevant
+ -- nodes.
-- Controlling_Argument (Node1-Sem)
- -- This field is set in procedure and function call nodes if the call
- -- is a dispatching call (it is Empty for a non-dispatching call).
- -- It indicates the source of the controlling tag for the call. For
- -- Procedure calls, the Controlling_Argument is one of the actuals.
- -- For a function that has a dispatching result, it is an entity in
- -- the context of the call that can provide a tag, or else it is the
- -- tag of the root type of the class. It can also specify a tag
- -- directly rather than being a tagged object. The latter is needed
- -- by the implementations of AI-239 and AI-260.
+ -- This field is set in procedure and function call nodes if the call is
+ -- a dispatching call (it is Empty for a non-dispatching call). It
+ -- indicates the source of the call's controlling tag. For procedure
+ -- calls, the Controlling_Argument is one of the actuals. For function
+ -- that has a dispatching result, it is an entity in the context of the
+ -- call that can provide a tag, or else it is the tag of the root type of
+ -- the class. It can also specify a tag directly rather than being a
+ -- tagged object. The latter is needed by the implementations of AI-239
+ -- and AI-260.
-- Conversion_OK (Flag14-Sem)
- -- A flag set on type conversion nodes to indicate that the conversion
- -- is to be considered as being valid, even though it is the case that
- -- the conversion is not valid Ada. This is used for the Enum_Rep,
- -- Fixed_Value and Integer_Value attributes, for internal conversions
- -- done for fixed-point operations, and for certain conversions for
- -- calls to initialization procedures. If Conversion_OK is set, then
- -- Etype must be set (the analyzer assumes that Etype has been set).
- -- For the case of fixed-point operands, it also indicates that the
- -- conversion is to be a direct conversion of the underlying integer
- -- result, with no regard to the small operand.
+ -- A flag set on type conversion nodes to indicate that the conversion is
+ -- to be considered as being valid, even though it is the case that the
+ -- conversion is not valid Ada. This is used for Enum_Rep, Fixed_Value
+ -- and Integer_Value attributes, for internal conversions done for
+ -- fixed-point operations, and for certain conversions for calls to
+ -- initialization procedures. If Conversion_OK is set, then Etype must be
+ -- set (the analyzer assumes that Etype has been set). For the case of
+ -- fixed-point operands, it also indicates that the conversion is to be
+ -- direct conversion of the underlying integer result, with no regard to
+ -- the small operand.
-- Corresponding_Body (Node5-Sem)
-- This field is set in subprogram declarations, package declarations,
@@ -714,11 +709,11 @@
-- Corresponding_Spec (Node5-Sem)
-- This field is set in subprogram, package, task, and protected body
-- nodes, where it points to the defining entity in the corresponding
- -- spec. The attribute is also set in N_With_Clause nodes, where
- -- it points to the defining entity for the with'ed spec, and in
- -- a subprogram renaming declaration when it is a Renaming_As_Body.
- -- The field is Empty if there is no corresponding spec, as in the
- -- case of a subprogram body that serves as its own spec.
+ -- spec. The attribute is also set in N_With_Clause nodes, where it
+ -- points to the defining entity for the with'ed spec, and in a
+ -- subprogram renaming declaration when it is a Renaming_As_Body. The
+ -- field is Empty if there is no corresponding spec, as in the case of a
+ -- subprogram body that serves as its own spec.
-- Corresponding_Stub (Node3-Sem)
-- This field is present in an N_Subunit node. It holds the node in
@@ -732,29 +727,28 @@
-- for the discriminant checking function for the variant.
-- Debug_Statement (Node3)
- -- This field is present in an N_Pragma node. It is used only for
- -- a Debug pragma or pragma Assert with a second parameter. The
- -- parameter is of the form of an expression, as required by the
- -- pragma syntax, but is actually a procedure call. To simplify
+ -- This field is present in an N_Pragma node. It is used only for a Debug
+ -- pragma. The parameter is of the form of an expression, as required by
+ -- the pragma syntax, but is actually a procedure call. To simplify
-- semantic processing, the parser creates a copy of the argument
-- rearranged into a procedure call statement and places it in the
- -- Debug_Statement field. Note that this field is considered a
- -- syntactic field, since it is created by the parser.
+ -- Debug_Statement field. Note that this field is considered syntactic
+ -- field, since it is created by the parser.
-- Default_Expression (Node5-Sem)
- -- This field is Empty if there is no default expression. If there
- -- is a simple default expression (one with no side effects), then
- -- this field simply contains a copy of the Expression field (both
- -- point to the tree for the default expression). Default_Expression
- -- is used for conformance checking.
+ -- This field is Empty if there is no default expression. If there is a
+ -- simple default expression (one with no side effects), then this field
+ -- simply contains a copy of the Expression field (both point to the tree
+ -- for the default expression). Default_Expression is used for
+ -- conformance checking.
-- Delay_Finalize_Attach (Flag14-Sem)
-- This flag is present in an N_Object_Declaration node. If it is set,
-- then in the case of a controlled type being declared and initialized,
-- the normal code for attaching the result to the appropriate local
-- finalization list is suppressed. This is used for functions that
- -- return controlled types without using the secondary stack, where
- -- it is the caller who must do the attachment.
+ -- return controlled types without using the secondary stack, where it is
+ -- the caller who must do the attachment.
-- Discr_Check_Funcs_Built (Flag11-Sem)
-- This flag is present in N_Full_Type_Declaration nodes. It is set when
@@ -783,16 +777,16 @@
-- is required. It is not determined who deals with this flag (???).
-- Do_Overflow_Check (Flag17-Sem)
- -- This flag is set on an operator where an overflow check is required
- -- on the operation. The actual check is dealt with by the backend
- -- (all the front end does is to set the flag). The other cases where
- -- this flag is used is on a Type_Conversion node and for attribute
- -- reference nodes. For a type conversion, it means that the conversion
- -- is from one base type to another, and the value may not fit in the
- -- target base type. See also the description of Do_Range_Check for
- -- this case. The only attribute references which use this flag are
- -- Pred and Succ, where it means that the result should be checked
- -- for going outside the base range.
+ -- This flag is set on an operator where an overflow check is required on
+ -- the operation. The actual check is dealt with by the backend (all the
+ -- front end does is to set the flag). The other cases where this flag is
+ -- used is on a Type_Conversion node and for attribute reference nodes.
+ -- For a type conversion, it means that the conversion is from one base
+ -- type to another, and the value may not fit in the target base type.
+ -- See also the description of Do_Range_Check for this case. The only
+ -- attribute references which use this flag are Pred and Succ, where it
+ -- means that the result should be checked for going outside the base
+ -- range.
-- Do_Range_Check (Flag9-Sem)
-- This flag is set on an expression which appears in a context where
@@ -808,27 +802,27 @@
-- target type is determined from the type of the array, which is
-- referenced by the Prefix of the N_Indexed_Component node.
- -- Argument expression for a parameter, appearing either directly
- -- in the Parameter_Associations list of a call or as the Expression
- -- of an N_Parameter_Association node that appears in this list. In
- -- either case, the check is against the type of the formal. Note
- -- that the flag is relevant only in IN and IN OUT parameters, and
- -- will be ignored for OUT parameters, where no check is required
- -- in the call, and if a check is required on the return, it is
- -- generated explicitly with a type conversion.
+ -- Argument expression for a parameter, appearing either directly in
+ -- the Parameter_Associations list of a call or as the Expression of an
+ -- N_Parameter_Association node that appears in this list. In either
+ -- case, the check is against the type of the formal. Note that the
+ -- flag is relevant only in IN and IN OUT parameters, and will be
+ -- ignored for OUT parameters, where no check is required in the call,
+ -- and if a check is required on the return, it is generated explicitly
+ -- with a type conversion.
-- Initialization expression for the initial value in an object
-- declaration. In this case the Do_Range_Check flag is set on
-- the initialization expression, and the check is against the
-- range of the type of the object being declared.
- -- The expression of a type conversion. In this case the range check
- -- is against the target type of the conversion. See also the use of
- -- Do_Overflow_Check on a type conversion. The distinction is that
- -- the overflow check protects against a value that is outside the
- -- range of the target base type, whereas a range check checks that
- -- the resulting value (which is a value of the base type of the
- -- target type), satisfies the range constraint of the target type.
+ -- The expression of a type conversion. In this case the range check is
+ -- against the target type of the conversion. See also the use of
+ -- Do_Overflow_Check on a type conversion. The distinction is that the
+ -- overflow check protects against a value that is outside the range of
+ -- the target base type, whereas a range check checks that the
+ -- resulting value (which is a value of the base type of the target
+ -- type), satisfies the range constraint of the target type.
-- Note: when a range check is required in contexts other than those
-- listed above (e.g. in a return statement), an additional type
@@ -836,11 +830,11 @@
-- Do_Storage_Check (Flag17-Sem)
-- This flag is set in an N_Allocator node to indicate that a storage
- -- check is required for the allocation, or in an N_Subprogram_Body
- -- node to indicate that a stack check is required in the subprogram
- -- prolog. The N_Allocator case is handled by the routine that expands
- -- the call to the runtime routine. The N_Subprogram_Body case is
- -- handled by the backend, and all the semantics does is set the flag.
+ -- check is required for the allocation, or in an N_Subprogram_Body node
+ -- to indicate that a stack check is required in the subprogram prolog.
+ -- The N_Allocator case is handled by the routine that expands the call
+ -- to the runtime routine. The N_Subprogram_Body case is handled by the
+ -- backend, and all the semantics does is set the flag.
-- Do_Tag_Check (Flag13-Sem)
-- This flag is set on an N_Assignment_Statement, N_Function_Call,
@@ -879,10 +873,10 @@
-- actions at an appropriate place in the tree to get elaborated at the
-- right time. For conditional expressions, we have to be sure that the
-- actions for the Else branch are only elaborated if the condition is
- -- False. The Else_Actions field is used as a temporary parking place
- -- for these actions. The final tree is always rewritten to eliminate
- -- the need for this field, so in the tree passed to Gigi, this field
- -- is always set to No_List.
+ -- False. The Else_Actions field is used as a temporary parking place for
+ -- these actions. The final tree is always rewritten to eliminate the
+ -- need for this field, so in the tree passed to Gigi, this field is
+ -- always set to No_List.
-- Enclosing_Variant (Node2-Sem)
-- This field is present in the N_Variant node and identifies the
@@ -891,142 +885,137 @@
-- processing of the variant part of a record type.
-- Entity (Node4-Sem)
- -- Appears in all direct names (identifier, character literal,
- -- operator symbol), as well as expanded names, and attributes that
- -- denote entities, such as 'Class. Points to the entity for the
- -- corresponding defining occurrence. Set after name resolution.
- -- In the case of identifiers in a WITH list, the corresponding
- -- defining occurrence is in a separately compiled file, and this
- -- pointer must be set using the library Load procedure. Note that
- -- during name resolution, the value in Entity may be temporarily
- -- incorrect (e.g. during overload resolution, Entity is initially
- -- set to the first possible correct interpretation, and then later
- -- modified if necessary to contain the correct value after resolution).
- -- Note that this field overlaps Associated_Node, which is used during
- -- generic processing (see Sem_Ch12 for details). Note also that in
- -- generic templates, this means that the Entity field does not always
- -- point to an Entity. Since the back end is expected to ignore
- -- generic templates, this is harmless.
+ -- Appears in all direct names (identifier, character literal, operator
+ -- symbol), as well as expanded names, and attributes that denote
+ -- entities, such as 'Class. Points to the entity for the corresponding
+ -- defining occurrence. Set after name resolution. In the case of
+ -- identifiers in a WITH list, the corresponding defining occurrence is
+ -- in a separately compiled file, and this pointer must be set using the
+ -- library Load procedure. Note that during name resolution, the value in
+ -- Entity may be temporarily incorrect (e.g. during overload resolution,
+ -- Entity is initially set to the first possible correct interpretation,
+ -- and then later modified if necessary to contain the correct value
+ -- after resolution). Note that this field overlaps Associated_Node,
+ -- which is used during generic processing (see Sem_Ch12 for details).
+ -- Note also that in generic templates, this means that the Entity field
+ -- does not always point to an Entity. Since the back end is expected to
+ -- ignore generic templates, this is harmless.
-- Entity_Or_Associated_Node (Node4-Sem)
- -- A synonym for both Entity and Associated_Node. Used by convention
- -- in the code when referencing this field in cases where it is not
- -- known whether the field contains an Entity or an Associated_Node.
+ -- A synonym for both Entity and Associated_Node. Used by convention in
+ -- the code when referencing this field in cases where it is not known
+ -- whether the field contains an Entity or an Associated_Node.
-- Etype (Node5-Sem)
- -- Appears in all expression nodes, all direct names, and all
- -- entities. Points to the entity for the related type. Set after
- -- type resolution. Normally this is the actual subtype of the
- -- expression. However, in certain contexts such as the right side
- -- of an assignment, subscripts, arguments to calls, returned value
- -- in a function, initial value etc. it is the desired target type.
- -- In the event that this is different from the actual type, the
- -- Do_Range_Check flag will be set if a range check is required.
- -- Note: if the Is_Overloaded flag is set, then Etype points to
- -- an essentially arbitrary choice from the possible set of types.
+ -- Appears in all expression nodes, all direct names, and all entities.
+ -- Points to the entity for the related type. Set after type resolution.
+ -- Normally this is the actual subtype of the expression. However, in
+ -- certain contexts such as the right side of an assignment, subscripts,
+ -- arguments to calls, returned value in a function, initial value etc.
+ -- it is the desired target type. In the event that this is different
+ -- from the actual type, the Do_Range_Check flag will be set if a range
+ -- check is required. Note: if the Is_Overloaded flag is set, then Etype
+ -- points to an essentially arbitrary choice from the possible set of
+ -- types.
-- Exception_Junk (Flag7-Sem)
- -- This flag is set in a various nodes appearing in a statement
- -- sequence to indicate that the corresponding node is an artifact
- -- of the generated code for exception handling, and should be
- -- ignored when analyzing the control flow of the relevant sequence
- -- of statements (e.g. to check that it does not end with a bad
- -- return statement).
+ -- This flag is set in a various nodes appearing in a statement sequence
+ -- to indicate that the corresponding node is an artifact of the
+ -- generated code for exception handling, and should be ignored when
+ -- analyzing the control flow of the relevant sequence of statements
+ -- (e.g. to check that it does not end with a bad return statement).
-- Expansion_Delayed (Flag11-Sem)
- -- Set on aggregates and extension aggregates that need a top-down
- -- rather than bottom up expansion. Typically aggregate expansion
- -- happens bottom up. For nested aggregates the expansion is delayed
- -- until the enclosing aggregate itself is expanded, e.g. in the context
- -- of a declaration. To delay it we set this flag. This is done to
- -- avoid creating a temporary for each level of a nested aggregates,
- -- and also to prevent the premature generation of constraint checks.
- -- This is also a requirement if we want to generate the proper
- -- attachment to the internal finalization lists (for record with
- -- controlled components). Top down expansion of aggregates is also
- -- used for in-place array aggregate assignment or initialization.
- -- When the full context is known, the target of the assignment or
- -- initialization is used to generate the left-hand side of individual
- -- assignment to each sub-component.
+ -- Set on aggregates and extension aggregates that need a top-down rather
+ -- than bottom up expansion. Typically aggregate expansion happens bottom
+ -- up. For nested aggregates the expansion is delayed until the enclosing
+ -- aggregate itself is expanded, e.g. in the context of a declaration. To
+ -- delay it we set this flag. This is done to avoid creating a temporary
+ -- for each level of a nested aggregates, and also to prevent the
+ -- premature generation of constraint checks. This is also a requirement
+ -- if we want to generate the proper attachment to the internal
+ -- finalization lists (for record with controlled components). Top down
+ -- expansion of aggregates is also used for in-place array aggregate
+ -- assignment or initialization. When the full context is known, the
+ -- target of the assignment or initialization is used to generate the
+ -- left-hand side of individual assignment to each sub-component.
-- First_Inlined_Subprogram (Node3-Sem)
- -- Present in the N_Compilation_Unit node for the main program. Points
- -- to a chain of entities for subprograms that are to be inlined. The
+ -- Present in the N_Compilation_Unit node for the main program. Points to
+ -- a chain of entities for subprograms that are to be inlined. The
-- Next_Inlined_Subprogram field of these entities is used as a link
- -- pointer with Empty marking the end of the list. This field is Empty
- -- if there are no inlined subprograms or inlining is not active.
+ -- pointer with Empty marking the end of the list. This field is Empty if
+ -- there are no inlined subprograms or inlining is not active.
-- First_Named_Actual (Node4-Sem)
- -- Present in procedure call statement and function call nodes, and
- -- also in Intrinsic nodes. Set during semantic analysis to point to
- -- the first named parameter where parameters are ordered by declaration
- -- order (as opposed to the actual order in the call which may be
- -- different due to named associations). Note: this field points to the
- -- explicit actual parameter itself, not the N_Parameter_Association
- -- node (its parent).
+ -- Present in procedure call statement and function call nodes, and also
+ -- in Intrinsic nodes. Set during semantic analysis to point to the first
+ -- named parameter where parameters are ordered by declaration order (as
+ -- opposed to the actual order in the call which may be different due to
+ -- named associations). Note: this field points to the explicit actual
+ -- parameter itself, not the N_Parameter_Association node (its parent).
-- First_Real_Statement (Node2-Sem)
-- Present in N_Handled_Sequence_Of_Statements node. Normally set to
- -- Empty. Used only when declarations are moved into the statement
- -- part of a construct as a result of wrapping an AT END handler that
- -- is required to cover the declarations. In this case, this field is
- -- used to remember the location in the statements list of the first
- -- real statement, i.e. the statement that used to be first in the
- -- statement list before the declarations were prepended.
+ -- Empty. Used only when declarations are moved into the statement part
+ -- of a construct as a result of wrapping an AT END handler that is
+ -- required to cover the declarations. In this case, this field is used
+ -- to remember the location in the statements list of the first real
+ -- statement, i.e. the statement that used to be first in the statement
+ -- list before the declarations were prepended.
-- First_Subtype_Link (Node5-Sem)
- -- Present in N_Freeze_Entity node for an anonymous base type that
- -- is implicitly created by the declaration of a first subtype. It
- -- points to the entity for the first subtype.
+ -- Present in N_Freeze_Entity node for an anonymous base type that is
+ -- implicitly created by the declaration of a first subtype. It points to
+ -- the entity for the first subtype.
-- Float_Truncate (Flag11-Sem)
- -- A flag present in type conversion nodes. This is used for float
- -- to integer conversions where truncation is required rather than
- -- rounding. Note that Gigi does not handle type conversions from real
- -- to integer with rounding (see Expand_N_Type_Conversion).
+ -- A flag present in type conversion nodes. This is used for float to
+ -- integer conversions where truncation is required rather than rounding.
+ -- Note that Gigi does not handle type conversions from real to integer
+ -- with rounding (see Expand_N_Type_Conversion).
-- Forwards_OK (Flag5-Sem)
- -- A flag present in the N_Assignment_Statement node. It is used only
- -- if the type being assigned is an array type, and is set if analysis
+ -- A flag present in the N_Assignment_Statement node. It is used only if
+ -- the type being assigned is an array type, and is set if analysis
-- determines that it is definitely safe to do the copy forwards, i.e.
- -- starting at the lowest addressed element. Note that if neither of
- -- the flags Forwards_OK or Backwards_OK is set, it means that the
- -- front end could not determine that either direction is definitely
- -- safe, and a runtime check is required.
+ -- starting at the lowest addressed element. Note that if neither of the
+ -- flags Forwards_OK or Backwards_OK is set, it means that the front end
+ -- could not determine that either direction is definitely safe, and a
+ -- runtime check is required.
-- From_At_Mod (Flag4-Sem)
-- This flag is set on the attribute definition clause node that is
-- generated by a transformation of an at mod phrase in a record
- -- representation clause. This is used to give slightly different
- -- (Ada 83 compatible) semantics to such a clause, namely it is
- -- used to specify a minimum acceptable alignment for the base type
- -- and all subtypes. In Ada 95 terms, the actual alignment of the
- -- base type and all subtypes must be a multiple of the given value,
- -- and the representation clause is considered to be type specific
- -- instead of subtype specific.
+ -- representation clause. This is used to give slightly different (Ada 83
+ -- compatible) semantics to such a clause, namely it is used to specify a
+ -- minimum acceptable alignment for the base type and all subtypes. In
+ -- Ada 95 terms, the actual alignment of the base type and all subtypes
+ -- must be a multiple of the given value, and the representation clause
+ -- is considered to be type specific instead of subtype specific.
-- From_Default (Flag6-Sem)
- -- This flag is set on the subprogram renaming declaration created in
- -- an instance for a formal subprogram, when the formal is declared
- -- with a box, and there is no explicit actual. If the flag is present,
- -- the declaration is treated as an implicit reference to the formal in
- -- the ali file.
+ -- This flag is set on the subprogram renaming declaration created in an
+ -- instance for a formal subprogram, when the formal is declared with a
+ -- box, and there is no explicit actual. If the flag is present, the
+ -- declaration is treated as an implicit reference to the formal in the
+ -- ali file.
-- Generic_Parent (Node5-Sem)
- -- Generic_parent is defined on declaration nodes that are instances.
- -- The value of Generic_Parent is the generic entity from which the
- -- instance is obtained. Generic_Parent is also defined for the renaming
+ -- Generic_parent is defined on declaration nodes that are instances. The
+ -- value of Generic_Parent is the generic entity from which the instance
+ -- is obtained. Generic_Parent is also defined for the renaming
-- declarations and object declarations created for the actuals in an
-- instantiation. The generic parent of such a declaration is the
-- corresponding generic association in the Instantiation node.
-- Generic_Parent_Type (Node4-Sem)
- -- Generic_Parent_Type is defined on Subtype_Declaration nodes for
- -- the actuals of formal private and derived types. Within the instance,
- -- the operations on the actual are those inherited from the parent.
- -- For a formal private type, the parent type is the generic type
- -- itself. The Generic_Parent_Type is also used in an instance to
- -- determine whether a private operation overrides an inherited one.
+ -- Generic_Parent_Type is defined on Subtype_Declaration nodes for the
+ -- actuals of formal private and derived types. Within the instance, the
+ -- operations on the actual are those inherited from the parent. For a
+ -- formal private type, the parent type is the generic type itself. The
+ -- Generic_Parent_Type is also used in an instance to determine whether a
+ -- private operation overrides an inherited one.
-- Handler_List_Entry (Node2-Sem)
-- This field is present in N_Object_Declaration nodes. It is set only
@@ -1037,75 +1026,75 @@
-- this is required, see Exp_Ch11.Remove_Handler_Entries.
-- Has_No_Elaboration_Code (Flag17-Sem)
- -- A flag that appears in the N_Compilation_Unit node to indicate
- -- whether or not elaboration code is present for this unit. It is
- -- initially set true for subprogram specs and bodies and for all
- -- generic units and false for non-generic package specs and bodies.
- -- Gigi may set the flag in the non-generic package case if it
- -- determines that no elaboration code is generated. Note that this
- -- flag is not related to the Is_Preelaborated status, there can be
- -- preelaborated packages that generate elaboration code, and non-
- -- preelaborated packages which do not generate elaboration code.
+ -- A flag that appears in the N_Compilation_Unit node to indicate whether
+ -- or not elaboration code is present for this unit. It is initially set
+ -- true for subprogram specs and bodies and for all generic units and
+ -- false for non-generic package specs and bodies. Gigi may set the flag
+ -- in the non-generic package case if it determines that no elaboration
+ -- code is generated. Note that this flag is not related to the
+ -- Is_Preelaborated status, there can be preelaborated packages that
+ -- generate elaboration code, and non- preelaborated packages which do
+ -- not generate elaboration code.
-- Has_Priority_Pragma (Flag6-Sem)
-- A flag present in N_Subprogram_Body, N_Task_Definition and
- -- N_Protected_Definition nodes to flag the presence of either
- -- a Priority or Interrupt_Priority pragma in the declaration
- -- sequence (public or private in the task and protected cases)
+ -- N_Protected_Definition nodes to flag the presence of either a Priority
+ -- or Interrupt_Priority pragma in the declaration sequence (public or
+ -- private in the task and protected cases)
-- Has_Private_View (Flag11-Sem)
- -- A flag present in generic nodes that have an entity, to indicate
- -- that the node has a private type. Used to exchange private
- -- and full declarations if the visibility at instantiation is
- -- different from the visibility at generic definition.
+ -- A flag present in generic nodes that have an entity, to indicate that
+ -- the node has a private type. Used to exchange private and full
+ -- declarations if the visibility at instantiation is different from the
+ -- visibility at generic definition.
-- Has_Storage_Size_Pragma (Flag5-Sem)
- -- A flag present in an N_Task_Definition node to flag the presence
- -- of a Storage_Size pragma
+ -- A flag present in an N_Task_Definition node to flag the presence of a
+ -- Storage_Size pragma.
-- Has_Task_Info_Pragma (Flag7-Sem)
- -- A flag present in an N_Task_Definition node to flag the presence
- -- of a Task_Info pragma. Used to detect duplicate pragmas.
+ -- A flag present in an N_Task_Definition node to flag the presence of a
+ -- Task_Info pragma. Used to detect duplicate pragmas.
-- Has_Task_Name_Pragma (Flag8-Sem)
- -- A flag present in N_Task_Definition nodes to flag the presence
- -- of a Task_Name pragma in the declaration sequence for the task.
+ -- A flag present in N_Task_Definition nodes to flag the presence of a
+ -- Task_Name pragma in the declaration sequence for the task.
-- Has_Wide_Character (Flag11-Sem)
- -- Present in string literals, set if any wide character (i.e. a
- -- character code outside the Character range) appears in the string.
+ -- Present in string literals, set if any wide character (i.e. character
+ -- code outside the Character range) appears in the string.
-- Hidden_By_Use_Clause (Elist4-Sem)
-- An entity list present in use clauses that appear within
-- instantiations. For the resolution of local entities, entities
- -- introduced by these use clauses have priority over global ones,
- -- and outer entities must be explicitly hidden/restored on exit.
+ -- introduced by these use clauses have priority over global ones, and
+ -- outer entities must be explicitly hidden/restored on exit.
-- Implicit_With (Flag16-Sem)
-- This flag is set in the N_With_Clause node that is implicitly
- -- generated for runtime units that are loaded by the expander, and
- -- also for package System, if it is loaded implicitly by a use of
- -- the 'Address or 'Tag attribute
+ -- generated for runtime units that are loaded by the expander, and also
+ -- for package System, if it is loaded implicitly by a use of the
+ -- 'Address or 'Tag attribute.
-- Includes_Infinities (Flag11-Sem)
- -- This flag is present in N_Range nodes. It is set for the range
- -- of unconstrained float types defined in Standard, which include
- -- not only the given range of values, but also legtitimately can
- -- include infinite values. This flag is false for any float type
- -- for which an explicit range is given by the programmer, even if
- -- that range is identical to the range for float.
+ -- This flag is present in N_Range nodes. It is set for the range of
+ -- unconstrained float types defined in Standard, which include not only
+ -- the given range of values, but also legtitimately can include infinite
+ -- values. This flag is false for any float type for which an explicit
+ -- range is given by the programmer, even if that range is identical to
+ -- the range for Float.
-- Instance_Spec (Node5-Sem)
-- This field is present in generic instantiation nodes, and also in
-- formal package declaration nodes (formal package declarations are
- -- treated in a manner very similar to package instantiations). It
- -- points to the node for the spec of the instance, inserted as part
- -- of the semantic processing for instantiations in Sem_Ch12.
+ -- treated in a manner very similar to package instantiations). It points
+ -- to the node for the spec of the instance, inserted as part of the
+ -- semantic processing for instantiations in Sem_Ch12.
-- Is_Asynchronous_Call_Block (Flag7-Sem)
-- A flag set in a Block_Statement node to indicate that it is the
- -- expansion of an asynchronous entry call. Such a block needs a
- -- cleanup handler to assure that the call is cancelled.
+ -- expansion of an asynchronous entry call. Such a block needs cleanup
+ -- handler to assure that the call is cancelled.
-- Is_Component_Left_Opnd (Flag13-Sem)
-- Is_Component_Right_Opnd (Flag14-Sem)
@@ -1114,59 +1103,59 @@
-- concatenation nodes in instances.
-- Is_Controlling_Actual (Flag16-Sem)
- -- This flag is set on in an expression that is a controlling argument
- -- in a dispatching call. It is off in all other cases. See Sem_Disp
- -- for details of its use.
+ -- This flag is set on in an expression that is a controlling argument in
+ -- a dispatching call. It is off in all other cases. See Sem_Disp for
+ -- details of its use.
-- Is_In_Discriminant_Check (Flag11-Sem)
- -- This flag is present in a selected component, and is used to
- -- indicate that the reference occurs within a discriminant check.
- -- The significance is that optimizations based on assuming that
- -- the discriminant check has a correct value cannot be performed
- -- in this case (or the disriminant check may be optimized away!)
+ -- This flag is present in a selected component, and is used to indicate
+ -- that the reference occurs within a discriminant check. The
+ -- significance is that optimizations based on assuming that the
+ -- discriminant check has a correct value cannot be performed in this
+ -- case (or the disriminant check may be optimized away!)
-- Is_Machine_Number (Flag11-Sem)
- -- This flag is set in an N_Real_Literal node to indicate that the
- -- value is a machine number. This avoids some unnecessary cases
- -- of converting real literals to machine numbers.
+ -- This flag is set in an N_Real_Literal node to indicate that the value
+ -- is a machine number. This avoids some unnecessary cases of converting
+ -- real literals to machine numbers.
-- Is_Null_Loop (Flag16-Sem)
- -- This flag is set in an N_Loop_Statement node if the corresponding
- -- loop can be determined to be null at compile time. This is used to
- -- suppress any warnings that would otherwise be issued inside the
- -- loop since they are probably not useful.
+ -- This flag is set in an N_Loop_Statement node if the corresponding loop
+ -- can be determined to be null at compile time. This is used to suppress
+ -- any warnings that would otherwise be issued inside the loop since they
+ -- are probably not useful.
-- Is_Overloaded (Flag5-Sem)
-- A flag present in all expression nodes. Used temporarily during
- -- overloading determination. The setting of this flag is not
- -- relevant once overloading analysis is complete.
+ -- overloading determination. The setting of this flag is not relevant
+ -- once overloading analysis is complete.
-- Is_Power_Of_2_For_Shift (Flag13-Sem)
-- A flag present only in N_Op_Expon nodes. It is set when the
- -- exponentiation is of the forma 2 ** N, where the type of N is
- -- an unsigned integral subtype whose size does not exceed the size
- -- of Standard_Integer (i.e. a type that can be safely converted to
- -- Natural), and the exponentiation appears as the right operand of
- -- an integer multiplication or an integer division where the dividend
- -- is unsigned. It is also required that overflow checking is off for
- -- both the exponentiation and the multiply/divide node. If this set
- -- of conditions holds, and the flag is set, then the division or
+ -- exponentiation is of the forma 2 ** N, where the type of N is an
+ -- unsigned integral subtype whose size does not exceed the size of
+ -- Standard_Integer (i.e. a type that can be safely converted to
+ -- Natural), and the exponentiation appears as the right operand of an
+ -- integer multiplication or an integer division where the dividend is
+ -- unsigned. It is also required that overflow checking is off for both
+ -- the exponentiation and the multiply/divide node. If this set of
+ -- conditions holds, and the flag is set, then the division or
-- multiplication can be (and is) converted to a shift.
-- Is_Overloaded (Flag5-Sem)
-- A flag present in all expression nodes. Used temporarily during
- -- overloading determination. The setting of this flag is not
- -- relevant once overloading analysis is complete.
+ -- overloading determination. The setting of this flag is not relevant
+ -- once overloading analysis is complete.
-- Is_Protected_Subprogram_Body (Flag7-Sem)
-- A flag set in a Subprogram_Body block to indicate that it is the
- -- implemenation of a protected subprogram. Such a body needs a
- -- cleanup handler to make sure that the associated protected object
- -- is unlocked when the subprogram completes.
+ -- implemenation of a protected subprogram. Such a body needs cleanup
+ -- handler to make sure that the associated protected object is unlocked
+ -- when the subprogram completes.
-- Is_Static_Expression (Flag6-Sem)
- -- Indicates that an expression is a static expression (RM 4.9). See
- -- spec of package Sem_Eval for full details on the use of this flag.
+ -- Indicates that an expression is a static expression (RM 4.9). See spec
+ -- of package Sem_Eval for full details on the use of this flag.
-- Is_Subprogram_Descriptor (Flag16-Sem)
-- Present in N_Object_Declaration, and set only for the object
@@ -1181,19 +1170,19 @@
-- allocated but not activated when the allocator completes abnormally.
-- Is_Task_Master (Flag5-Sem)
- -- A flag set in a Subprogram_Body, Block_Statement or Task_Body node
- -- to indicate that the construct is a task master (i.e. has declared
- -- tasks or declares an access to a task type).
+ -- A flag set in a Subprogram_Body, Block_Statement or Task_Body node to
+ -- indicate that the construct is a task master (i.e. has declared tasks
+ -- or declares an access to a task type).
-- Itype (Node1-Sem)
- -- Used in N_Itype_Reference node to reference an itype for which it
- -- is important to ensure that it is defined. See description of this
- -- node for further details.
+ -- Used in N_Itype_Reference node to reference an itype for which it is
+ -- important to ensure that it is defined. See description of this node
+ -- for further details.
-- Kill_Range_Check (Flag11-Sem)
-- Used in an N_Unchecked_Type_Conversion node to indicate that the
- -- result should not be subjected to range checks. This is used for
- -- the implementation of Normalize_Scalars.
+ -- result should not be subjected to range checks. This is used for the
+ -- implementation of Normalize_Scalars.
-- Label_Construct (Node2-Sem)
-- Used in an N_Implicit_Label_Declaration node. Refers to an N_Label,
@@ -1202,36 +1191,35 @@
-- itself, but it is useful in the implementation of ASIS queries.
-- Library_Unit (Node4-Sem)
- -- In a stub node, the Library_Unit field points to the compilation unit
- -- node of the corresponding subunit.
+ -- In a stub node, Library_Unit points to the compilation unit node of
+ -- the corresponding subunit.
--
- -- In a with clause node, the Library_Unit field points to the spec
- -- of the with'ed unit.
+ -- In a with clause node, Library_Unit points to the spec of the with'ed
+ -- unit.
--
- -- In a compilation unit node, the use of this field depends on
- -- the unit type:
+ -- In a compilation unit node, the usage depends on the unit type:
--
- -- For a subprogram body, the Library_Unit field points to the
- -- compilation unit node of the corresponding spec, unless
- -- Acts_As_Spec is set, in which case it points to itself.
+ -- For a subprogram body, Library_Unit points to the compilation unit
+ -- node of the corresponding spec, unless Acts_As_Spec is set, in which
+ -- case it points to itself.
--
- -- For a package body, the Library_Unit field points to the
- -- compilation unit node of the corresponding spec.
+ -- For a package body, Library_Unit points to the compilation unit of
+ -- the corresponding package spec.
--
- -- For a subprogram spec to which pragma Inline applies, the
- -- Library_Unit field points to the compilation unit node of
- -- the corresponding body, if inlining is active.
+ -- For a subprogram spec to which pragma Inline applies, Library_Unit
+ -- points to the compilation unit node of the corresponding body, if
+ -- inlining is active.
--
- -- For a generic declaration, the Library_Unit field points
- -- to the compilation unit node of the corresponding generic body.
+ -- For a generic declaration, Library_Unit points to the compilation
+ -- unit node of the corresponding generic body.
--
- -- For a subunit, the Library_Unit field points to the compilation
- -- unit node of the parent body.
+ -- For a subunit, Library_Unit points to the compilation unit node of
+ -- the parent body.
--
- -- Note that this field is not used to hold the parent pointer for a
- -- child unit (which might in any case need to use it for some other
- -- purpose as described above). Instead for a child unit, implicit
- -- with's are generated for all parents.
+ -- Note that this field is not used to hold the parent pointer for child
+ -- unit (which might in any case need to use it for some other purpose as
+ -- described above). Instead for a child unit, implicit with's are
+ -- generated for all parents.
-- Loop_Actions (List2-Sem)
-- A list present in Component_Association nodes in array aggregates.
@@ -1239,76 +1227,75 @@
-- they may need to be evaluated anew each time through.
-- Limited_View_Installed (Flag18-Sem)
- -- Present in With_Clauses and in package specifications. If set on a
+ -- Present in With_Clauses and in package specifications. If set on
-- with_clause, it indicates that this clause has created the current
- -- limited view of the designated package. On a package specification,
- -- it indicates that the limited view has already been created because
- -- the package is mentioned in a limited_with_clause in the closure of
- -- the unit being compiled.
+ -- limited view of the designated package. On a package specification, it
+ -- indicates that the limited view has already been created because the
+ -- package is mentioned in a limited_with_clause in the closure of the
+ -- unit being compiled.
-- Must_Be_Byte_Aligned (Flag14-Sem)
-- This flag is present in N_Attribute_Reference nodes. It can be set
-- only for the Address and Unrestricted_Access attributes. If set it
- -- means that the object for which the address/access is given must be
- -- on a byte (more accurately a storage unit) boundary. If necessary,
- -- a copy of the object is to be made before taking the address (this
- -- copy is in the current scope on the stack frame). This is used for
- -- certain cases of code generated by the expander that passes
- -- parameters by address.
+ -- means that the object for which the address/access is given must be on
+ -- a byte (more accurately a storage unit) boundary. If necessary, a copy
+ -- of the object is to be made before taking the address (this copy is in
+ -- the current scope on the stack frame). This is used for certain cases
+ -- of code generated by the expander that passes parameters by address.
--
- -- The reason the copy is not made by the front end is that the back
- -- end has more information about type layout and may be able to (but
- -- is not guaranteed to) prevent making unnecessary copies.
+ -- The reason the copy is not made by the front end is that the back end
+ -- has more information about type layout and may be able to (but is not
+ -- guaranteed to) prevent making unnecessary copies.
-- Must_Not_Freeze (Flag8-Sem)
-- A flag present in all expression nodes. Normally expressions cause
- -- freezing as described in the RM. If this flag is set, then this
- -- is inhibited. This is used by the analyzer and expander to label
- -- nodes that are created by semantic analysis or expansion and which
- -- must not cause freezing even though they normally would. This flag
- -- is also present in an N_Subtype_Indication node, since we also use
- -- these in calls to Freeze_Expression.
+ -- freezing as described in the RM. If this flag is set, then this is
+ -- inhibited. This is used by the analyzer and expander to label nodes
+ -- that are created by semantic analysis or expansion and which must not
+ -- cause freezing even though they normally would. This flag is also
+ -- present in an N_Subtype_Indication node, since we also use these in
+ -- calls to Freeze_Expression.
-- Next_Entity (Node2-Sem)
-- Present in defining identifiers, defining character literals and
- -- defining operator symbols (i.e. in all entities). The entities of
- -- a scope are chained, and this field is used as the forward pointer
- -- for this list. See Einfo for further details.
+ -- defining operator symbols (i.e. in all entities). The entities of a
+ -- scope are chained, and this field is used as the forward pointer for
+ -- this list. See Einfo for further details.
-- Next_Named_Actual (Node4-Sem)
- -- Present in parameter association node. Set during semantic
- -- analysis to point to the next named parameter, where parameters
- -- are ordered by declaration order (as opposed to the actual order
- -- in the call, which may be different due to named associations).
- -- Not that this field points to the explicit actual parameter itself,
- -- not to the N_Parameter_Association node (its parent).
+ -- Present in parameter association node. Set during semantic analysis to
+ -- point to the next named parameter, where parameters are ordered by
+ -- declaration order (as opposed to the actual order in the call, which
+ -- may be different due to named associations). Not that this field
+ -- points to the explicit actual parameter itself, not to the
+ -- N_Parameter_Association node (its parent).
-- Next_Rep_Item (Node4-Sem)
- -- Present in pragma nodes and attribute definition nodes. Used to
- -- link representation items that apply to an entity. See description
- -- of First_Rep_Item field in Einfo for full details.
+ -- Present in pragma nodes and attribute definition nodes. Used to link
+ -- representation items that apply to an entity. See description of
+ -- First_Rep_Item field in Einfo for full details.
-- Next_Use_Clause (Node3-Sem)
- -- While use clauses are active during semantic processing, they
- -- are chained from the scope stack entry, using Next_Use_Clause
- -- as a link pointer, with Empty marking the end of the list. The
- -- head pointer is in the scope stack entry (First_Use_Clause). At
- -- the end of semantic processing (i.e. when Gigi sees the tree,
- -- the contents of this field is undefined and should not be read).
+ -- While use clauses are active during semantic processing, they are
+ -- chained from the scope stack entry, using Next_Use_Clause as a link
+ -- pointer, with Empty marking the end of the list. The head pointer is
+ -- in the scope stack entry (First_Use_Clause). At the end of semantic
+ -- processing (i.e. when Gigi sees the tree, the contents of this field
+ -- is undefined and should not be read).
-- No_Ctrl_Actions (Flag7-Sem)
- -- Present in N_Assignment_Statement to indicate that no finalize nor
- -- nor adjust should take place on this assignment eventhough the rhs
- -- is controlled. This is used in init procs and aggregate expansions
- -- where the generated assignments are more initialisations than real
+ -- Present in N_Assignment_Statement to indicate that no finalize nor nor
+ -- adjust should take place on this assignment eventhough the rhs is
+ -- controlled. This is used in init procs and aggregate expansions where
+ -- the generated assignments are more initialisations than real
-- assignments.
-- No_Elaboration_Check (Flag14-Sem)
-- Present in N_Function_Call and N_Procedure_Call_Statement. Indicates
- -- that no elaboration check is needed on the call, because it appears
- -- in the context of a local Suppress pragma. This is used on calls
- -- within task bodies, where the actual elaboration checks are applied
- -- after analysis, when the local scope stack is not present.
+ -- that no elaboration check is needed on the call, because it appears in
+ -- the context of a local Suppress pragma. This is used on calls within
+ -- task bodies, where the actual elaboration checks are applied after
+ -- analysis, when the local scope stack is not present.
-- No_Entities_Ref_In_Spec (Flag8-Sem)
-- Present in N_With_Clause nodes. Set if the with clause is on the
@@ -1319,12 +1306,12 @@
-- full details)
-- No_Initialization (Flag13-Sem)
- -- Present in N_Object_Declaration & N_Allocator to indicate
- -- that the object must not be initialized (by Initialize or a
- -- call to an init proc). This is needed for controlled aggregates.
- -- When the Object declaration has an expression, this flag means
- -- that this expression should not be taken into account (needed
- -- for in place initialization with aggregates)
+ -- Present in N_Object_Declaration & N_Allocator to indicate that the
+ -- object must not be initialized (by Initialize or call to an init
+ -- proc). This is needed for controlled aggregates. When the Object
+ -- declaration has an expression, this flag means that this expression
+ -- should not be taken into account (needed for in place initialization
+ -- with aggregates)
-- No_Truncation (Flag17-Sem)
-- Present in N_Unchecked_Type_Conversion node. This flag has an effect
@@ -1332,51 +1319,51 @@
-- target for scalar operands. Normally in such a case we truncate some
-- higher order bits of the source, and then sign/zero extend the result
-- to form the output value. But if this flag is set, then we do not do
- -- any truncation, so for example, if an 8 bit input is converted to a
- -- 5 bit result which is in fact stored in 8 bits, then the high order
+ -- any truncation, so for example, if an 8 bit input is converted to 5
+ -- bit result which is in fact stored in 8 bits, then the high order
-- three bits of the target result will be copied from the source. This
-- is used for properly setting out of range values for use by pragmas
-- Initialize_Scalars and Normalize_Scalars.
-- Original_Discriminant (Node2-Sem)
-- Present in identifiers. Used in references to discriminants that
- -- appear in generic units. Because the names of the discriminants
- -- may be different in an instance, we use this field to recover the
- -- position of the discriminant in the original type, and replace it
- -- with the discriminant at the same position in the instantiated type.
+ -- appear in generic units. Because the names of the discriminants may be
+ -- different in an instance, we use this field to recover the position of
+ -- the discriminant in the original type, and replace it with the
+ -- discriminant at the same position in the instantiated type.
-- Original_Entity (Node2-Sem)
- -- Present in numeric literals. Used to denote the named number that
- -- has been constant-folded into the given literal. If literal is from
+ -- Present in numeric literals. Used to denote the named number that has
+ -- been constant-folded into the given literal. If literal is from
-- source, or the result of some other constant-folding operation, then
-- Original_Entity is empty. This field is needed to handle properly
-- named numbers in generic units, where the Associated_Node field
- -- interferes with the Entity field, making it impossible to preserve
- -- the original entity at the point of instantiation (ASIS problem).
+ -- interferes with the Entity field, making it impossible to preserve the
+ -- original entity at the point of instantiation (ASIS problem).
-- Others_Discrete_Choices (List1-Sem)
-- When a case statement or variant is analyzed, the semantic checks
-- determine the actual list of choices that correspond to an others
- -- choice. This list is materialized for later use by the expander
- -- and the Others_Discrete_Choices field of an N_Others_Choice node
- -- points to this materialized list of choices, which is in standard
- -- format for a list of discrete choices, except that of course it
- -- cannot contain an N_Others_Choice entry.
+ -- choice. This list is materialized for later use by the expander and
+ -- the Others_Discrete_Choices field of an N_Others_Choice node points to
+ -- this materialized list of choices, which is in standard format for a
+ -- list of discrete choices, except that of course it cannot contain an
+ -- N_Others_Choice entry.
-- Parameter_List_Truncated (Flag17-Sem)
- -- Present in N_Function_Call and N_Procedure_Call_Statement nodes.
- -- Set (for OpenVMS ports of GNAT only) if the parameter list is
- -- truncated as a result of a First_Optional_Parameter specification
- -- in an Import_Function, Import_Procedure, or Import_Valued_Procedure
- -- pragma. The truncation is done by the expander by removing trailing
- -- parameters from the argument list, in accordance with the set of
- -- rules allowing such parameter removal. In particular, parameters
- -- can be removed working from the end of the parameter list backwards
- -- up to and including the entry designated by First_Optional_Parameter
- -- in the Import pragma. Parameters can be removed if they are implicit
- -- and the default value is a known-at-compile-time value, including
- -- the use of the Null_Parameter attribute, or if explicit parameter
- -- values are present that match the corresponding defaults.
+ -- Present in N_Function_Call and N_Procedure_Call_Statement nodes. Set
+ -- (for OpenVMS ports of GNAT only) if the parameter list is truncated as
+ -- a result of a First_Optional_Parameter specification in an
+ -- Import_Function, Import_Procedure, or Import_Valued_Procedure pragma.
+ -- The truncation is done by the expander by removing trailing parameters
+ -- from the argument list, in accordance with the set of rules allowing
+ -- such parameter removal. In particular, parameters can be removed
+ -- working from the end of the parameter list backwards up to and
+ -- including the entry designated by First_Optional_Parameter in the
+ -- Import pragma. Parameters can be removed if they are implicit and the
+ -- default value is a known-at-compile-time value, including the use of
+ -- the Null_Parameter attribute, or if explicit parameter values are
+ -- present that match the corresponding defaults.
-- Parent_Spec (Node4-Sem)
-- For a library unit that is a child unit spec (package or subprogram
@@ -1387,67 +1374,67 @@
-- Present_Expr (Uint3-Sem)
-- Present in an N_Variant node. This has a meaningful value only after
- -- Gigi has back annotated the tree with representation information.
- -- At this point, it contains a reference to a gcc expression that
- -- depends on the values of one or more discriminants. Give a set of
- -- discriminant values, this expression evaluates to False (zero) if
- -- variant is not present, and True (non-zero) if it is present. See
- -- unit Repinfo for further details on gigi back annotation. This
- -- field is used during ASIS processing (data decomposition annex)
- -- to determine if a field is present or not.
+ -- Gigi has back annotated the tree with representation information. At
+ -- this point, it contains a reference to a gcc expression that depends
+ -- on the values of one or more discriminants. Give a set of discriminant
+ -- values, this expression evaluates to False (zero) if variant is not
+ -- present, and True (non-zero) if it is present. See unit Repinfo for
+ -- further details on gigi back annotation. This field is used during
+ -- ASIS processing (data decomposition annex) to determine if a field is
+ -- present or not.
-- Print_In_Hex (Flag13-Sem)
- -- Set on an N_Integer_Literal node to indicate that the value should
- -- be printed in hexadecimal in the sprint listing. Has no effect on
- -- legality or semantics of program, only on the displayed output.
- -- This is used to clarify output from the packed array cases.
+ -- Set on an N_Integer_Literal node to indicate that the value should be
+ -- printed in hexadecimal in the sprint listing. Has no effect on
+ -- legality or semantics of program, only on the displayed output. This
+ -- is used to clarify output from the packed array cases.
-- Procedure_To_Call (Node4-Sem)
-- Present in N_Allocator, N_Free_Statement, and N_Return_Statement
- -- nodes. References the entity for the declaration of the procedure
- -- to be called to accomplish the required operation (i.e. for the
- -- Allocate procedure in the case of N_Allocator and N_Return_Statement
- -- (for allocating the return value), and for the Deallocate procedure
- -- in the case of N_Free_Statement.
+ -- nodes. References the entity for the declaration of the procedure to
+ -- be called to accomplish the required operation (i.e. for the Allocate
+ -- procedure in the case of N_Allocator and N_Return_Statement (for
+ -- allocating the return value), and for the Deallocate procedure in the
+ -- case of N_Free_Statement.
-- Raises_Constraint_Error (Flag7-Sem)
- -- Set on an expression whose evaluation will definitely fail a
- -- constraint error check. In the case of static expressions, this
- -- flag must be set accurately (and if it is set, the expression is
- -- typically illegal unless it appears as a non-elaborated branch of
- -- a short-circuit form). For a non-static expression, this flag may
- -- be set whenever an expression (e.g. an aggregate) is known to raise
- -- constraint error. If set, the expression definitely will raise CE
- -- if elaborated at runtime. If not set, the expression may or may
- -- not raise CE. In other words, on static expressions, the flag is
- -- set accurately, on non-static expressions it is set conservatively.
+ -- Set on an expression whose evaluation will definitely fail constraint
+ -- error check. In the case of static expressions, this flag must be set
+ -- accurately (and if it is set, the expression is typically illegal
+ -- unless it appears as a non-elaborated branch of a short-circuit form).
+ -- For a non-static expression, this flag may be set whenever an
+ -- expression (e.g. an aggregate) is known to raise constraint error. If
+ -- set, the expression definitely will raise CE if elaborated at runtime.
+ -- If not set, the expression may or may not raise CE. In other words, on
+ -- static expressions, the flag is set accurately, on non-static
+ -- expressions it is set conservatively.
-- Redundant_Use (Flag13-Sem)
- -- A flag present in nodes that can appear as an operand in a use
- -- clause or use type clause (identifiers, expanded names, attribute
- -- references). Set to indicate that a use is redundant (and therefore
- -- need not be undone on scope exit).
+ -- Present in nodes that can appear as an operand in a use clause or use
+ -- type clause (identifiers, expanded names, attribute references). Set
+ -- to indicate that a use is redundant (and therefore need not be undone
+ -- on scope exit).
-- Return_Type (Node2-Sem)
- -- Present in N_Return_Statement node. For a procedure, this is set
- -- to Standard_Void_Type. For a function it references the entity
- -- for the returned type.
+ -- Present in N_Return_Statement node. For a procedure, this is set to
+ -- Standard_Void_Type. For a function it references the entity for the
+ -- returned type.
-- Rounded_Result (Flag18-Sem)
-- Present in N_Type_Conversion, N_Op_Divide and N_Op_Multiply nodes.
-- Used in the fixed-point cases to indicate that the result must be
- -- rounded as a result of the use of the 'Round attribute. Also used
- -- for integer N_Op_Divide nodes to indicate that the result should
- -- be rounded to the nearest integer (breaking ties away from zero),
- -- rather than truncated towards zero as usual. These rounded integer
- -- operations are the result of expansion of rounded fixed-point
- -- divide, conversion and multiplication operations.
+ -- rounded as a result of the use of the 'Round attribute. Also used for
+ -- integer N_Op_Divide nodes to indicate that the result should be
+ -- rounded to the nearest integer (breaking ties away from zero), rather
+ -- than truncated towards zero as usual. These rounded integer operations
+ -- are the result of expansion of rounded fixed-point divide, conversion
+ -- and multiplication operations.
-- Scope (Node3-Sem)
-- Present in defining identifiers, defining character literals and
- -- defining operator symbols (i.e. in all entities). The entities of
- -- a scope all use this field to reference the corresponding scope
- -- entity. See Einfo for further details.
+ -- defining operator symbols (i.e. in all entities). The entities of a
+ -- scope all use this field to reference the corresponding scope entity.
+ -- See Einfo for further details.
-- Shift_Count_OK (Flag4-Sem)
-- A flag present in shift nodes to indicate that the shift count is
@@ -1464,29 +1451,29 @@
-- Static_Processing_OK (Flag4-Sem)
-- Present in N_Aggregate nodes. When the Compile_Time_Known_Aggregate
-- flag is set, the full value of the aggregate can be determined at
- -- compile time and the aggregate can be passed as is to the back-end.
- -- In this event it is irrelevant whether this flag is set or not.
- -- However, if the Compile_Time_Known_Aggregate flag is not set but
+ -- compile time and the aggregate can be passed as is to the back-end. In
+ -- this event it is irrelevant whether this flag is set or not. However,
+ -- if the Compile_Time_Known_Aggregate flag is not set but
-- Static_Processing_OK is set, the aggregate can (but need not) be
- -- converted into a compile time known aggregate by the expander.
- -- See Sem_Aggr for the specific conditions under which an aggregate
- -- has its Static_Processing_OK flag set.
+ -- converted into a compile time known aggregate by the expander. See
+ -- Sem_Aggr for the specific conditions under which an aggregate has its
+ -- Static_Processing_OK flag set.
-- Storage_Pool (Node1-Sem)
- -- Present in N_Allocator, N_Free_Statement and N_Return_Statement
- -- nodes. References the entity for the storage pool to be used for
- -- the allocate or free call or for the allocation of the returned
- -- value from a function. Empty indicates that the global default
- -- default pool is to be used. Note that in the case of a return
- -- statement, this field is set only if the function returns a
- -- value of a type whose size is not known at compile time on the
- -- secondary stack. It is never set on targets for which the target
- -- parameter Targparm.Functions_Return_By_DSP_On_Target is True.
+ -- Present in N_Allocator, N_Free_Statement and N_Return_Statement nodes.
+ -- References the entity for the storage pool to be used for the allocate
+ -- or free call or for the allocation of the returned value from a
+ -- function. Empty indicates that the global default default pool is to
+ -- be used. Note that in the case of a return statement, this field is
+ -- set only if the function returns value of a type whose size is not
+ -- known at compile time on the secondary stack. It is never set on
+ -- targets for which the parameter Functions_Return_By_DSP_On_Target in
+ -- Targparm is True.
-- Target_Type (Node2-Sem)
- -- Used in an N_Validate_Unchecked_Conversion node to point to the
- -- target type entity for the unchecked conversion instantiation
- -- which gigi must do size validation for.
+ -- Used in an N_Validate_Unchecked_Conversion node to point to the target
+ -- type entity for the unchecked conversion instantiation which gigi must
+ -- do size validation for.
-- Then_Actions (List3-Sem)
-- This field is present in conditional expression nodes. During code
@@ -1494,55 +1481,55 @@
-- actions at an appropriate place in the tree to get elaborated at the
-- right time. For conditional expressions, we have to be sure that the
-- actions for the Then branch are only elaborated if the condition is
- -- True. The Then_Actions field is used as a temporary parking place
- -- for these actions. The final tree is always rewritten to eliminate
- -- the need for this field, so in the tree passed to Gigi, this field
- -- is always set to No_List.
+ -- True. The Then_Actions field is used as a temporary parking place for
+ -- these actions. The final tree is always rewritten to eliminate the
+ -- need for this field, so in the tree passed to Gigi, this field is
+ -- always set to No_List.
-- Treat_Fixed_As_Integer (Flag14-Sem)
- -- This flag appears in operator nodes for divide, multiply, mod and
- -- rem on fixed-point operands. It indicates that the operands are
- -- to be treated as integer values, ignoring small values. This flag
- -- is only set as a result of expansion of fixed-point operations.
- -- Typically a fixed-point multplication in the source generates
- -- subsidiary multiplication and division operations that work with
- -- the underlying integer values and have this flag set. Note that
- -- this flag is not needed on other arithmetic operations (add, neg,
- -- subtract etc) since in these cases it is always the case that fixed
- -- is treated as integer. The Etype field MUST be set if this flag
- -- is set. The analyzer knows to leave such nodes alone, and whoever
- -- makes them must set the correct Etype value.
+ -- This flag appears in operator nodes for divide, multiply, mod and rem
+ -- on fixed-point operands. It indicates that the operands are to be
+ -- treated as integer values, ignoring small values. This flag is only
+ -- set as a result of expansion of fixed-point operations. Typically a
+ -- fixed-point multplication in the source generates subsidiary
+ -- multiplication and division operations that work with the underlying
+ -- integer values and have this flag set. Note that this flag is not
+ -- needed on other arithmetic operations (add, neg, subtract etc) since
+ -- in these cases it is always the case that fixed is treated as integer.
+ -- The Etype field MUST be set if this flag is set. The analyzer knows to
+ -- leave such nodes alone, and whoever makes them must set the correct
+ -- Etype value.
-- TSS_Elist (Elist3-Sem)
-- Present in N_Freeze_Entity nodes. Holds an element list containing
-- entries for each TSS (type support subprogram) associated with the
-- frozen type. The elements of the list are the entities for the
- -- subprograms (see package Exp_TSS for further details). Set to
- -- No_Elist if there are no type support subprograms for the type
- -- or if the freeze node is not for a type.
+ -- subprograms (see package Exp_TSS for further details). Set to No_Elist
+ -- if there are no type support subprograms for the type or if the freeze
+ -- node is not for a type.
-- Unreferenced_In_Spec (Flag7-Sem)
-- Present in N_With_Clause nodes. Set if the with clause is on the
-- package or subprogram spec where the main unit is the corresponding
- -- body, and is not referenced by the spec (it may still be referenced
- -- by the body, so this flag is used to generate the proper message
- -- (see Sem_Util.Check_Unused_Withs for details)
+ -- body, and is not referenced by the spec (it may still be referenced by
+ -- the body, so this flag is used to generate the proper message (see
+ -- Sem_Util.Check_Unused_Withs for details)
-- Was_Originally_Stub (Flag13-Sem)
- -- This flag is set in the node for a proper body that replaces a
- -- stub. During the analysis procedure, stubs in some situations
- -- get rewritten by the corresponding bodies, and we set this flag
- -- to remember that this happened. Note that it is not good enough
- -- to rely on the use of Original_Node here because of the case of
- -- nested instantiations where the substituted node can be copied.
+ -- This flag is set in the node for a proper body that replaces stub.
+ -- During the analysis procedure, stubs in some situations get rewritten
+ -- by the corresponding bodies, and we set this flag to remember that
+ -- this happened. Note that it is not good enough to rely on the use of
+ -- Original_Node here because of the case of nested instantiations where
+ -- the substituted node can be copied.
-- Zero_Cost_Handling (Flag5-Sem)
-- This flag is set in all handled sequence of statement and exception
-- handler nodes if eceptions are to be handled using the zero-cost
-- mechanism (see Ada.Exceptions and System.Exceptions in files
- -- a-except.ads/adb and s-except.ads for full details). What gigi
- -- needs to do for such a handler is simply to put the code in the
- -- handler somewhere. The front end has generated all necessary labels.
+ -- a-except.ads/adb and s-except.ads for full details). What gigi needs
+ -- to do for such a handler is simply to put the code in the handler
+ -- somewhere. The front end has generated all necessary labels.
--------------------------------------------------
-- Note on Use of End_Label and End_Span Fields --
@@ -1569,46 +1556,43 @@
-- Record Definition end record;
-- Enumeration Definition );
- -- The End_Label and End_Span fields are used to mark the locations
- -- of these lines, and also keep track of the label in the case where
- -- a label is present.
+ -- The End_Label and End_Span fields are used to mark the locations of
+ -- these lines, and also keep track of the label in the case where a label
+ -- is present.
- -- For the first group above, the End_Label field of the corresponding
- -- node is used to point to the label identifier. In the case where
- -- there is no label in the source, the parser supplies a dummy
- -- identifier (with Comes_From_Source set to False), and the Sloc
- -- of this dummy identifier marks the location of the token following
- -- the END token.
+ -- For the first group above, the End_Label field of the corresponding node
+ -- is used to point to the label identifier. In the case where there is no
+ -- label in the source, the parser supplies a dummy identifier (with
+ -- Comes_From_Source set to False), and the Sloc of this dummy identifier
+ -- marks the location of the token following the END token.
- -- For the second group, the use of End_Label is similar, but the
- -- End_Label is found in the N_Handled_Sequence_Of_Statements node.
- -- This is done simply because in some cases there is no room in
- -- the parent node.
+ -- For the second group, the use of End_Label is similar, but the End_Label
+ -- is found in the N_Handled_Sequence_Of_Statements node. This is done
+ -- simply because in some cases there is no room in the parent node.
- -- For the third group, there is never any label, and instead of
- -- using End_Label, we use the End_Span field which gives the
- -- location of the token following END, relative to the starting
- -- Sloc of the construct, i.e. add Sloc (Node) + End_Span (Node)
- -- to get the Sloc of the IF or CASE following the End_Label.
+ -- For the third group, there is never any label, and instead of using
+ -- End_Label, we use the End_Span field which gives the location of the
+ -- token following END, relative to the starting Sloc of the construct,
+ -- i.e. add Sloc (Node) + End_Span (Node) to get the Sloc of the IF or CASE
+ -- following the End_Label.
- -- The record definition case is handled specially, we treat it
- -- as though it required an optional label which is never present,
- -- and so the parser always builds a dummy identifier with Comes
- -- From Source set False. The reason we do this, rather than using
- -- End_Span in this case, is that we want to generate a cross-ref
- -- entry for the end of a record, since it represents a scope for
- -- name declaration purposes.
+ -- The record definition case is handled specially, we treat it as though
+ -- it required an optional label which is never present, and so the parser
+ -- always builds a dummy identifier with Comes From Source set False. The
+ -- reason we do this, rather than using End_Span in this case, is that we
+ -- want to generate a cross-ref entry for the end of a record, since it
+ -- represents a scope for name declaration purposes.
- -- The enumeration definition case is handled in an exactly similar
- -- manner, building a dummy identifier to get a cross-reference.
+ -- The enumeration definition case is handled in an exactly similar manner,
+ -- building a dummy identifier to get a cross-reference.
- -- Note: the reason we store the difference as a Uint, instead of
- -- storing the Source_Ptr value directly, is that Source_Ptr values
- -- cannot be distinguished from other types of values, and we count
- -- on all general use fields being self describing. To make things
- -- easier for clients, note that we provide function End_Location,
- -- and procedure Set_End_Location to allow access to the logical
- -- value (which is the Source_Ptr value for the end token).
+ -- Note: the reason we store the difference as a Uint, instead of storing
+ -- the Source_Ptr value directly, is that Source_Ptr values cannot be
+ -- distinguished from other types of values, and we count on all general
+ -- use fields being self describing. To make things easier for clients,
+ -- note that we provide function End_Location, and procedure
+ -- Set_End_Location to allow access to the logical value (which is the
+ -- Source_Ptr value for the end token).
---------------------
-- Syntactic Nodes --
@@ -1623,23 +1607,23 @@
-- An IDENTIFIER shall not be a reserved word
- -- In the Ada grammar identifiers are the bottom level tokens which
- -- have very few semantics. Actual program identifiers are direct
- -- names. If we were being 100% honest with the grammar, then we would
- -- have a node called N_Direct_Name which would point to an identifier.
- -- However, that's too many extra nodes, so we just use the N_Identifier
- -- node directly as a direct name, and it contains the expression fields
- -- and Entity field that correspond to its use as a direct name. In
- -- those few cases where identifiers appear in contexts where they are
- -- not direct names (pragmas, pragma argument associations, attribute
+ -- In the Ada grammar identifiers are the bottom level tokens which have
+ -- very few semantics. Actual program identifiers are direct names. If
+ -- we were being 100% honest with the grammar, then we would have a node
+ -- called N_Direct_Name which would point to an identifier. However,
+ -- that's too many extra nodes, so we just use the N_Identifier node
+ -- directly as a direct name, and it contains the expression fields and
+ -- Entity field that correspond to its use as a direct name. In those
+ -- few cases where identifiers appear in contexts where they are not
+ -- direct names (pragmas, pragma argument associations, attribute
-- references and attribute definition clauses), the Chars field of the
-- node contains the Name_Id for the identifier name.
- -- Note: in GNAT, a reserved word can be treated as an identifier
- -- in two cases. First, an incorrect use of a reserved word as an
- -- identifier is diagnosed and then treated as a normal identifier.
- -- Second, an attribute designator of the form of a reserved word
- -- (access, delta, digits, range) is treated as an identifier.
+ -- Note: in GNAT, a reserved word can be treated as an identifier in two
+ -- cases. First, an incorrect use of a reserved word as an identifier is
+ -- diagnosed and then treated as a normal identifier. Second, an
+ -- attribute designator of the form of a reserved word (access, delta,
+ -- digits, range) is treated as an identifier.
-- Note: The set of letters that is permitted in an identifier depends
-- on the character set in use. See package Csets for full details.
@@ -1735,12 +1719,12 @@
-- Has_Private_View (Flag11-Sem) set in generic units.
-- plus fields for expression
- -- Note: the Entity field will be missing (and set to Empty) for
- -- character literals whose type is Standard.Wide_Character or
- -- Standard.Character or a type derived from one of these two.
- -- In this case the character literal stands for its own coding.
- -- The reason we take this irregular short cut is to avoid the
- -- need to build lots of junk defining character literal nodes.
+ -- Note: the Entity field will be missing (set to Empty) for character
+ -- literals whose type is Standard.Wide_Character or Standard.Character
+ -- or a type derived from one of these two. In this case the character
+ -- literal stands for its own coding. The reason we take this irregular
+ -- short cut is to avoid the need to build lots of junk defining
+ -- character literal nodes.
-------------------------
-- 2.6 String Literal --
@@ -5701,7 +5685,8 @@
--------------------------------------------
-- FORMAL_DERIVED_TYPE_DEFINITION ::=
- -- [abstract] new SUBTYPE_MARK [[and INTERFACE_LIST] with private]
+ -- [abstract] [limited]
+ -- new SUBTYPE_MARK [[and INTERFACE_LIST] with private]
-- Note: this construct is not allowed in Ada 83 mode
-- N_Formal_Derived_Type_Definition
@@ -5709,6 +5694,7 @@
-- Subtype_Mark (Node4)
-- Private_Present (Flag15)
-- Abstract_Present (Flag4)
+ -- Limited_Present (Flag17)
-- Interface_List (List2) (set to No_List if none)
---------------------------------------------
Index: sinfo.adb
===================================================================
--- sinfo.adb (revision 108280)
+++ sinfo.adb (working copy)
@@ -1692,6 +1692,7 @@
begin
pragma Assert (False
or else NT (N).Nkind = N_Derived_Type_Definition
+ or else NT (N).Nkind = N_Formal_Derived_Type_Definition
or else NT (N).Nkind = N_Formal_Private_Type_Definition
or else NT (N).Nkind = N_Private_Extension_Declaration
or else NT (N).Nkind = N_Private_Type_Declaration
@@ -4278,6 +4279,7 @@
begin
pragma Assert (False
or else NT (N).Nkind = N_Derived_Type_Definition
+ or else NT (N).Nkind = N_Formal_Derived_Type_Definition
or else NT (N).Nkind = N_Formal_Private_Type_Definition
or else NT (N).Nkind = N_Private_Extension_Declaration
or else NT (N).Nkind = N_Private_Type_Declaration
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 108280)
+++ sem_ch3.adb (working copy)
@@ -65,6 +65,7 @@
with Stand; use Stand;
with Sinfo; use Sinfo;
with Snames; use Snames;
+with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Uintp; use Uintp;
@@ -1416,6 +1417,7 @@
elsif not Is_Derived_Type (Current_Scope)
and then not Is_Limited_Record (Current_Scope)
+ and then not Is_Concurrent_Type (Current_Scope)
then
Error_Msg_N
("nonlimited tagged type cannot have limited components", N);
@@ -2654,6 +2656,15 @@
end if;
Build_Derived_Record_Type (N, Parent_Type, T);
+
+ if Limited_Present (N) then
+ Set_Is_Limited_Record (T);
+
+ if not Is_Limited_Type (Parent_Type) then
+ Error_Msg_NE ("parent type& of limited extension must be limited",
+ N, Parent_Type);
+ end if;
+ end if;
end Analyze_Private_Extension_Declaration;
---------------------------------
@@ -5703,8 +5714,12 @@
-- are only specified for limited records. For completeness, these
-- flags are also initialized along with all the other flags below.
+ -- AI-419: limitedness is not inherited from an interface parent
+
Set_Is_Tagged_Type (Derived_Type, Is_Tagged);
- Set_Is_Limited_Record (Derived_Type, Is_Limited_Record (Parent_Type));
+ Set_Is_Limited_Record (Derived_Type,
+ Is_Limited_Record (Parent_Type)
+ and then not Is_Interface (Parent_Type));
-- STEP 2a: process discriminants of derived type if any
@@ -5887,7 +5902,9 @@
Set_Is_Limited_Composite
(Derived_Type, Is_Limited_Composite (Parent_Type));
Set_Is_Limited_Record
- (Derived_Type, Is_Limited_Record (Parent_Type));
+ (Derived_Type,
+ Is_Limited_Record (Parent_Type)
+ and then not Is_Interface (Parent_Type));
Set_Is_Private_Composite
(Derived_Type, Is_Private_Composite (Parent_Type));
@@ -7646,7 +7663,7 @@
end if;
end Add_Interface;
- -- Start of processing for Add_Interface
+ -- Start of processing for Collect_Interfaces
begin
pragma Assert (False
@@ -7682,30 +7699,7 @@
Next (Intf);
end loop;
-
- -- A type extension may be written as a derivation from an interface.
- -- The completion will have to implement the same, or derive from a
- -- type that implements it as well.
-
- elsif Nkind (N) = N_Private_Extension_Declaration
- and then Is_Interface (Etype (Derived_Type))
- then
- Add_Interface (Etype (Derived_Type));
end if;
-
- -- Same for task and protected types, that can derive directly from
- -- an interface (and implement additional interfaces that will be
- -- present in the interface list of the declaration).
-
- if Nkind (N) = N_Task_Type_Declaration
- or else Nkind (N) = N_Protected_Type_Declaration
- or else Nkind (N) = N_Single_Protected_Declaration
- or else Nkind (N) = N_Single_Task_Declaration
- then
- if Is_Interface (Etype (Derived_Type)) then
- Add_Interface (Etype (Derived_Type));
- end if;
- end if;
end Collect_Interfaces;
------------------------------
@@ -9719,24 +9713,42 @@
New_Compon : constant Entity_Id := New_Copy (Old_Compon);
begin
- -- Set the parent so we have a proper link for freezing etc. This
- -- is not a real parent pointer, since of course our parent does
- -- not own up to us and reference us, we are an illegitimate
- -- child of the original parent!
+ -- Set the parent so we have a proper link for freezing etc. This is
+ -- not a real parent pointer, since of course our parent does not own
+ -- up to us and reference us, we are an illegitimate child of the
+ -- original parent!
Set_Parent (New_Compon, Parent (Old_Compon));
+ -- If the old component's Esize was already determined and is a
+ -- static value, then the new component simply inherits it. Otherwise
+ -- the old component's size may require run-time determination, but
+ -- the new component's size still might be statically determinable
+ -- (if, for example it has a static constraint). In that case we want
+ -- Layout_Type to recompute the component's size, so we reset its
+ -- size and positional fields.
+
+ if Frontend_Layout_On_Target
+ and then not Known_Static_Esize (Old_Compon)
+ then
+ Set_Esize (New_Compon, Uint_0);
+ Init_Normalized_First_Bit (New_Compon);
+ Init_Normalized_Position (New_Compon);
+ Init_Normalized_Position_Max (New_Compon);
+ end if;
+
-- We do not want this node marked as Comes_From_Source, since
- -- otherwise it would get first class status and a separate
- -- cross-reference line would be generated. Illegitimate
- -- children do not rate such recognition.
+ -- otherwise it would get first class status and a separate cross-
+ -- reference line would be generated. Illegitimate children do not
+ -- rate such recognition.
Set_Comes_From_Source (New_Compon, False);
- -- But it is a real entity, and a birth certificate must be
- -- properly registered by entering it into the entity list.
+ -- But it is a real entity, and a birth certificate must be properly
+ -- registered by entering it into the entity list.
Enter_Name (New_Compon);
+
return New_Compon;
end Create_Component;
@@ -10749,6 +10761,13 @@
if not Is_Interface (T) then
Error_Msg_NE ("(Ada 2005) & must be an interface", Intf, T);
+
+ elsif Limited_Present (Def)
+ and then not Is_Limited_Interface (T)
+ then
+ Error_Msg_NE
+ ("progenitor interface& of limited type must be limited",
+ N, T);
end if;
Next (Intf);
@@ -10782,6 +10801,100 @@
return;
end if;
+ -- Ada 2005 (AI-251): The case in which the parent of the full-view is
+ -- an interface is special because the list of interfaces in the full
+ -- view can be given in any order. For example:
+
+ -- type A is interface;
+ -- type B is interface and A;
+ -- type D is new B with private;
+ -- private
+ -- type D is new A and B with null record; -- 1 --
+
+ -- In this case we perform the following transformation of -1-:
+
+ -- type D is new B and A with null record;
+
+ -- If the parent of the full-view covers the parent of the partial-view
+ -- we have two possible cases:
+
+ -- 1) They have the same parent
+ -- 2) The parent of the full-view implements some further interfaces
+
+ -- In both cases we do not need to perform the transformation. In the
+ -- first case the source program is correct and the transformation is
+ -- not needed; in the second case the source program does not fulfill
+ -- the no-hidden interfaces rule (AI-396) and the error will be reported
+ -- later.
+
+ -- This transformation not only simplifies the rest of the analysis of
+ -- this type declaration but also simplifies the correct generation of
+ -- the object layout to the expander.
+
+ if In_Private_Part (Current_Scope)
+ and then Is_Interface (Parent_Type)
+ then
+ declare
+ Iface : Node_Id;
+ Partial_View : Entity_Id;
+ Partial_View_Parent : Entity_Id;
+ New_Iface : Node_Id;
+
+ begin
+ -- Look for the associated private type declaration
+
+ Partial_View := First_Entity (Current_Scope);
+ loop
+ exit when not Present (Partial_View)
+ or else (Has_Private_Declaration (Partial_View)
+ and then Full_View (Partial_View) = T);
+
+ Next_Entity (Partial_View);
+ end loop;
+
+ -- If the partial view was not found then the source code has
+ -- errors and the transformation is not needed.
+
+ if Present (Partial_View) then
+ Partial_View_Parent := Etype (Partial_View);
+
+ -- If the parent of the full-view covers the parent of the
+ -- partial-view we have nothing else to do.
+
+ if Interface_Present_In_Ancestor
+ (Parent_Type, Partial_View_Parent)
+ then
+ null;
+
+ -- Traverse the list of interfaces of the full-view to look
+ -- for the parent of the partial-view and perform the tree
+ -- transformation.
+
+ else
+ Iface := First (Interface_List (Def));
+ while Present (Iface) loop
+ if Etype (Iface) = Etype (Partial_View) then
+ Rewrite (Subtype_Indication (Def),
+ New_Copy (Subtype_Indication
+ (Parent (Partial_View))));
+
+ New_Iface := Make_Identifier (Sloc (N),
+ Chars (Parent_Type));
+ Append (New_Iface, Interface_List (Def));
+
+ -- Analyze the transformed code
+
+ Derived_Type_Declaration (T, N, Is_Completion);
+ return;
+ end if;
+
+ Next (Iface);
+ end loop;
+ end if;
+ end if;
+ end;
+ end if;
+
-- Only composite types other than array types are allowed to have
-- discriminants.
@@ -10905,6 +11018,20 @@
end if;
Build_Derived_Type (N, Parent_Type, T, Is_Completion);
+
+ -- AI-419: the parent type of an explicitly limited derived type must
+ -- be limited. Interface progenitors were checked earlier.
+
+ if Limited_Present (Def) then
+ Set_Is_Limited_Record (T);
+
+ if not Is_Limited_Type (Parent_Type)
+ and then not Is_Interface (Parent_Type)
+ then
+ Error_Msg_NE ("parent type& of limited type must be limited",
+ N, Parent_Type);
+ end if;
+ end if;
end Derived_Type_Declaration;
----------------------------------
@@ -13186,36 +13313,136 @@
Full_Parent : Entity_Id;
Full_Indic : Node_Id;
- function Find_Ancestor_Interface
- (Typ : Entity_Id) return Entity_Id;
- -- Find an implemented interface in the derivation chain of Typ
+ procedure Collect_Implemented_Interfaces
+ (Typ : Entity_Id;
+ Ifaces : Elist_Id);
+ -- Ada 2005: Gather all the interfaces that Typ directly or
+ -- inherently implements. Duplicate entries are not added to
+ -- the list Ifaces.
- -----------------------------
- -- Find_Ancestor_Interface --
- -----------------------------
+ function Contain_Interface
+ (Iface : Entity_Id;
+ Ifaces : Elist_Id) return Boolean;
+ -- Ada 2005: Determine whether Iface is present in the list Ifaces
- function Find_Ancestor_Interface
- (Typ : Entity_Id) return Entity_Id
+ function Find_Hidden_Interface
+ (Src : Elist_Id;
+ Dest : Elist_Id) return Entity_Id;
+ -- Ada 2005: Determine whether the interfaces in list Src are all
+ -- present in the list Dest. Return the first differing interface,
+ -- or Empty otherwise.
+
+ ------------------------------------
+ -- Collect_Implemented_Interfaces --
+ ------------------------------------
+
+ procedure Collect_Implemented_Interfaces
+ (Typ : Entity_Id;
+ Ifaces : Elist_Id)
is
- T : Entity_Id;
+ Iface : Entity_Id;
+ Iface_Elmt : Elmt_Id;
begin
- T := Typ;
- while T /= Etype (T) loop
- if Is_Interface (Etype (T)) then
- return Etype (T);
- end if;
+ -- Implementations of the form:
+ -- type Typ is new Iface ...
- T := Etype (T);
+ if Is_Interface (Etype (Typ))
+ and then not Contain_Interface (Etype (Typ), Ifaces)
+ then
+ Append_Elmt (Etype (Typ), Ifaces);
+ end if;
- -- Protect us against erroneous code that has a large
- -- chain of circularity dependencies
+ -- Implementations of the form:
+ -- type Typ is ... and Iface ...
- exit when T = Typ;
- end loop;
+ if Present (Abstract_Interfaces (Typ)) then
+ Iface_Elmt := First_Elmt (Abstract_Interfaces (Typ));
+ while Present (Iface_Elmt) loop
+ Iface := Node (Iface_Elmt);
+ if Is_Interface (Iface)
+ and then not Contain_Interface (Iface, Ifaces)
+ then
+ Append_Elmt (Iface, Ifaces);
+ end if;
+
+ Next_Elmt (Iface_Elmt);
+ end loop;
+ end if;
+
+ -- Implementations of the form:
+ -- type Typ is new Parent_Typ and ...
+
+ if Ekind (Typ) = E_Record_Type
+ and then Present (Parent_Subtype (Typ))
+ then
+ Collect_Implemented_Interfaces (Parent_Subtype (Typ), Ifaces);
+
+ -- Implementations of the form:
+ -- type Typ is ... with private;
+
+ elsif Ekind (Typ) = E_Record_Type_With_Private
+ and then Present (Full_View (Typ))
+ and then Etype (Typ) /= Full_View (Typ)
+ and then Etype (Typ) /= Typ
+ then
+ Collect_Implemented_Interfaces (Etype (Typ), Ifaces);
+ end if;
+ end Collect_Implemented_Interfaces;
+
+ -----------------------
+ -- Contain_Interface --
+ -----------------------
+
+ function Contain_Interface
+ (Iface : Entity_Id;
+ Ifaces : Elist_Id) return Boolean
+ is
+ Iface_Elmt : Elmt_Id;
+
+ begin
+ if Present (Ifaces) then
+ Iface_Elmt := First_Elmt (Ifaces);
+ while Present (Iface_Elmt) loop
+ if Node (Iface_Elmt) = Iface then
+ return True;
+ end if;
+
+ Next_Elmt (Iface_Elmt);
+ end loop;
+ end if;
+
+ return False;
+ end Contain_Interface;
+
+ ---------------------------
+ -- Find_Hidden_Interface --
+ ---------------------------
+
+ function Find_Hidden_Interface
+ (Src : Elist_Id;
+ Dest : Elist_Id) return Entity_Id
+ is
+ Iface : Entity_Id;
+ Iface_Elmt : Elmt_Id;
+
+ begin
+ if Present (Src) and then Present (Dest) then
+ Iface_Elmt := First_Elmt (Src);
+ while Present (Iface_Elmt) loop
+ Iface := Node (Iface_Elmt);
+
+ if not Contain_Interface (Iface, Dest) then
+ return Iface;
+ end if;
+
+ Next_Elmt (Iface_Elmt);
+ end loop;
+ end if;
+
return Empty;
- end Find_Ancestor_Interface;
+ end Find_Hidden_Interface;
-- Start of processing for Process_Full_View
@@ -13255,49 +13482,28 @@
Error_Msg_N ("generic type cannot have a completion", Full_T);
end if;
- -- Ada 2005 (AI-396): A full view shall be a descendant of an
- -- interface type if and only if the corresponding partial view
- -- (if any) is also a descendant of the interface type, or if
- -- the partial view is untagged.
-
if Ada_Version >= Ada_05
+ and then Is_Tagged_Type (Priv_T)
and then Is_Tagged_Type (Full_T)
then
declare
- Iface : Entity_Id;
- Iface_Def : Node_Id;
+ Iface : Entity_Id;
+ Priv_T_Ifaces : constant Elist_Id := New_Elmt_List;
+ Full_T_Ifaces : constant Elist_Id := New_Elmt_List;
begin
- Iface := Find_Ancestor_Interface (Full_T);
+ Collect_Implemented_Interfaces (Priv_T, Priv_T_Ifaces);
+ Collect_Implemented_Interfaces (Full_T, Full_T_Ifaces);
- if Present (Iface) then
- Iface_Def := Type_Definition (Parent (Iface));
+ -- Ada 2005 (AI-396): The partial view shall be a descendant of
+ -- an interface type if and only if the full view is a descendant
+ -- of the interface type.
- -- The full view derives from an interface descendant, but the
- -- partial view does not share the same tagged type.
+ Iface := Find_Hidden_Interface (Full_T_Ifaces, Priv_T_Ifaces);
- if Is_Tagged_Type (Priv_T)
- and then Etype (Priv_T) /= Etype (Full_T)
- and then Etype (Priv_T) /= Iface
- then
- Error_Msg_N ("(Ada 2005) tagged partial view cannot be " &
- "completed by a type that implements an " &
- "interface", Priv_T);
- end if;
-
- -- The full view derives from a limited, protected,
- -- synchronized or task interface descendant, but the
- -- partial view is not labeled as limited.
-
- if (Limited_Present (Iface_Def)
- or else Protected_Present (Iface_Def)
- or else Synchronized_Present (Iface_Def)
- or else Task_Present (Iface_Def))
- and then not Limited_Present (Parent (Priv_T))
- then
- Error_Msg_N ("(Ada 2005) non-limited private type cannot be "
- & "completed by a limited type", Priv_T);
- end if;
+ if Present (Iface) then
+ Error_Msg_NE ("interface & not implemented by partial view " &
+ "('R'M'-2005 7.3(9))", Full_T, Iface);
end if;
end;
end if;
@@ -13328,6 +13534,15 @@
if Priv_Parent = Any_Type or else Full_Parent = Any_Type then
return;
+ -- Ada 2005 (AI-251): Interfaces in the full-typ can be given in
+ -- any order. Therefore we don't have to check that its parent must
+ -- be a descendant of the parent of the private type declaration.
+
+ elsif Is_Interface (Priv_Parent)
+ and then Is_Interface (Full_Parent)
+ then
+ null;
+
elsif not Is_Ancestor (Base_Type (Priv_Parent), Full_Parent) then
Error_Msg_N
("parent of full type must descend from parent"
@@ -13428,6 +13643,23 @@
end if;
end if;
+ -- AI-419: verify that the use of "limited" is consistent
+
+ declare
+ Orig_Decl : constant Node_Id := Original_Node (N);
+ begin
+ if Nkind (Parent (Priv_T)) = N_Private_Extension_Declaration
+ and then not Limited_Present (Parent (Priv_T))
+ and then Nkind (Orig_Decl) = N_Full_Type_Declaration
+ and then Nkind
+ (Type_Definition (Orig_Decl)) = N_Derived_Type_Definition
+ and then Limited_Present (Type_Definition (Orig_Decl))
+ then
+ Error_Msg_N
+ ("full view of non-limited extension cannot be limited", N);
+ end if;
+ end;
+
-- Ada 2005 AI-363: if the full view has discriminants with
-- defaults, it is illegal to declare constrained access subtypes
-- whose designated type is the current type. This allows objects
@@ -14072,8 +14304,7 @@
if Nkind (Parent (S)) /= N_Access_To_Object_Definition
and then not
(Nkind (Parent (S)) = N_Subtype_Declaration
- and then
- Is_Itype (Defining_Identifier (Parent (S))))
+ and then Is_Itype (Defining_Identifier (Parent (S))))
then
Check_Incomplete (Subtype_Mark (S));
end if;
More information about the Gcc-patches
mailing list