Flag228 : Boolean;
Flag229 : Boolean;
Flag230 : Boolean;
-
- -- Note: flags 231-247 not in use yet
-
Flag231 : Boolean;
Flag232 : Boolean;
return Nodes.Table (N).Analyzed;
end Analyzed;
+ --------------------------
+ -- Basic_Set_Convention --
+ --------------------------
+
+ procedure Basic_Set_Convention (E : Entity_Id; Val : Convention_Id) is
+ begin
+ pragma Assert (Nkind (E) in N_Entity);
+ To_Flag_Word_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (E + 2).Field12'Unrestricted_Access)).Convention := Val;
+ end Basic_Set_Convention;
+
-----------------
-- Change_Node --
-----------------
end if;
end Copy_Separate_Tree;
- -----------------
- -- Delete_Node --
- -----------------
-
- procedure Delete_Node (Node : Node_Id) is
- begin
- pragma Assert (not Nodes.Table (Node).In_List);
-
- if Debug_Flag_N then
- Write_Str ("Delete node ");
- Write_Int (Int (Node));
- Write_Eol;
- end if;
-
- Nodes.Table (Node) := Default_Node;
- Nodes.Table (Node).Nkind := N_Unused_At_Start;
- Node_Count := Node_Count - 1;
-
- -- Note: for now, we are not bothering to reuse deleted nodes
-
- end Delete_Node;
-
- -----------------
- -- Delete_Tree --
- -----------------
-
- procedure Delete_Tree (Node : Node_Id) is
-
- procedure Delete_Field (F : Union_Id);
- -- Delete item pointed to by field F if it is a syntactic element
-
- procedure Delete_List (L : List_Id);
- -- Delete all elements on the given list
-
- ------------------
- -- Delete_Field --
- ------------------
-
- procedure Delete_Field (F : Union_Id) is
- begin
- if F = Union_Id (Empty) then
- return;
-
- elsif F in Node_Range
- and then Parent (Node_Id (F)) = Node
- then
- Delete_Tree (Node_Id (F));
-
- elsif F in List_Range
- and then Parent (List_Id (F)) = Node
- then
- Delete_List (List_Id (F));
-
- -- No need to test Elist case, there are no syntactic Elists
-
- else
- return;
- end if;
- end Delete_Field;
-
- -----------------
- -- Delete_List --
- -----------------
-
- procedure Delete_List (L : List_Id) is
- begin
- while Is_Non_Empty_List (L) loop
- Delete_Tree (Remove_Head (L));
- end loop;
- end Delete_List;
-
- -- Start of processing for Delete_Tree
-
- begin
- -- Delete descendents
-
- Delete_Field (Field1 (Node));
- Delete_Field (Field2 (Node));
- Delete_Field (Field3 (Node));
- Delete_Field (Field4 (Node));
- Delete_Field (Field5 (Node));
-
- -- ??? According to spec, Node itself should be deleted as well
- end Delete_Tree;
-
-----------
-- Ekind --
-----------
return Nodes.Table (N).Nkind;
end Nkind;
+ --------------
+ -- Nkind_In --
+ --------------
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3, V4);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3, V4, V5);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind;
+ V7 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind;
+ V7 : Node_Kind;
+ V8 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7, V8);
+ end Nkind_In;
+
--------
-- No --
--------
-- to Rewrite if there were an intention to save the original node.
Orig_Nodes.Table (Old_Node) := Old_Node;
-
- -- Finally delete the source, since it is now copied
-
- Delete_Node (New_Node);
end Replace;
-------------
Default_Node.Comes_From_Source := Default;
end Set_Comes_From_Source_Default;
- --------------------
- -- Set_Convention --
- --------------------
-
- procedure Set_Convention (E : Entity_Id; Val : Convention_Id) is
- begin
- pragma Assert (Nkind (E) in N_Entity);
- To_Flag_Word_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (E + 2).Field12'Unrestricted_Access)).Convention :=
- Val;
- end Set_Convention;
-
---------------
-- Set_Ekind --
---------------
return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag230;
end Flag230;
+ function Flag231 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag231;
+ end Flag231;
+
+ function Flag232 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag232;
+ end Flag232;
+
+ function Flag233 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag233;
+ end Flag233;
+
+ function Flag234 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag234;
+ end Flag234;
+
+ function Flag235 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag235;
+ end Flag235;
+
+ function Flag236 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag236;
+ end Flag236;
+
+ function Flag237 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag237;
+ end Flag237;
+
+ function Flag238 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag238;
+ end Flag238;
+
+ function Flag239 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag239;
+ end Flag239;
+
+ function Flag240 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag240;
+ end Flag240;
+
+ function Flag241 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag241;
+ end Flag241;
+
+ function Flag242 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag242;
+ end Flag242;
+
+ function Flag243 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag243;
+ end Flag243;
+
+ function Flag244 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag244;
+ end Flag244;
+
+ function Flag245 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag245;
+ end Flag245;
+
+ function Flag246 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag246;
+ end Flag246;
+
+ function Flag247 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag247;
+ end Flag247;
+
procedure Set_Nkind (N : Node_Id; Val : Node_Kind) is
begin
pragma Assert (N <= Nodes.Last);
(Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag230 := Val;
end Set_Flag230;
+ procedure Set_Flag231 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag231 := Val;
+ end Set_Flag231;
+
+ procedure Set_Flag232 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag232 := Val;
+ end Set_Flag232;
+
+ procedure Set_Flag233 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag233 := Val;
+ end Set_Flag233;
+
+ procedure Set_Flag234 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag234 := Val;
+ end Set_Flag234;
+
+ procedure Set_Flag235 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag235 := Val;
+ end Set_Flag235;
+
+ procedure Set_Flag236 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag236 := Val;
+ end Set_Flag236;
+
+ procedure Set_Flag237 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag237 := Val;
+ end Set_Flag237;
+
+ procedure Set_Flag238 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag238 := Val;
+ end Set_Flag238;
+
+ procedure Set_Flag239 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag239 := Val;
+ end Set_Flag239;
+
+ procedure Set_Flag240 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag240 := Val;
+ end Set_Flag240;
+
+ procedure Set_Flag241 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag241 := Val;
+ end Set_Flag241;
+
+ procedure Set_Flag242 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag242 := Val;
+ end Set_Flag242;
+
+ procedure Set_Flag243 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag243 := Val;
+ end Set_Flag243;
+
+ procedure Set_Flag244 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag244 := Val;
+ end Set_Flag244;
+
+ procedure Set_Flag245 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag245 := Val;
+ end Set_Flag245;
+
+ procedure Set_Flag246 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag246 := Val;
+ end Set_Flag246;
+
+ procedure Set_Flag247 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Word5_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag247 := Val;
+ end Set_Flag247;
+
procedure Set_Node1_With_Parent (N : Node_Id; Val : Node_Id) is
begin
pragma Assert (N <= Nodes.Last);
begin
loop
Set_Analyzed (Pfx, False);
- exit when Nkind (Pfx) /= N_Selected_Component
- and then Nkind (Pfx) /= N_Indexed_Component;
+ exit when
+ not Nkind_In (Pfx, N_Selected_Component, N_Indexed_Component);
Pfx := Prefix (Pfx);
end loop;
end Reset_Packed_Prefix;
P : constant Node_Id := Parent (N);
begin
- pragma Assert (Nkind (P) = N_Triggering_Alternative
- or else Nkind (P) = N_Entry_Call_Alternative);
+ pragma Assert (Nkind_In (P, N_Triggering_Alternative,
+ N_Entry_Call_Alternative));
if Is_Non_Empty_List (Statements (P)) then
Insert_List_Before_And_Analyze
-- form, and rewritten before analysis.
if not Analyzed (Prev_Orig)
- and then
- (Nkind (Actual) = N_Function_Call
- or else
- Nkind (Actual) = N_Identifier)
+ and then Nkind_In (Actual, N_Function_Call, N_Identifier)
then
Prev_Orig := Prev;
end if;
-- as out parameter actuals on calls to stream procedures.
Act_Prev := Prev;
- while Nkind (Act_Prev) = N_Type_Conversion
- or else Nkind (Act_Prev) = N_Unchecked_Type_Conversion
+ while Nkind_In (Act_Prev, N_Type_Conversion,
+ N_Unchecked_Type_Conversion)
loop
Act_Prev := Expression (Act_Prev);
end loop;
then
null;
- elsif Nkind (Prev) = N_Allocator
- or else Nkind (Prev) = N_Attribute_Reference
- then
+ elsif Nkind_In (Prev, N_Allocator, N_Attribute_Reference) then
null;
-- Suppress null checks when passing to access parameters of Java
begin
Nod := Actual;
- while Nkind (Nod) = N_Indexed_Component
- or else
- Nkind (Nod) = N_Selected_Component
+ while Nkind_In (Nod, N_Indexed_Component,
+ N_Selected_Component)
loop
Set_Analyzed (Nod, False);
Nod := Prefix (Nod);
Sav : Node_Id;
begin
- -- For an OUT parameter that is an assignable entity, we do not
- -- want to clobber the Last_Assignment field, since if it is
- -- set, it was precisely because it is indeed an OUT parameter!
-
- if Ekind (Formal) = E_Out_Parameter
+ -- For an OUT or IN OUT parameter that is an assignable entity,
+ -- we do not want to clobber the Last_Assignment field, since
+ -- if it is set, it was precisely because it is indeed an OUT
+ -- or IN OUT parameter!
+
+ if (Ekind (Formal) = E_Out_Parameter
+ or else
+ Ekind (Formal) = E_In_Out_Parameter)
and then Is_Assignable (Ent)
then
Sav := Last_Assignment (Ent);
-- Ada 2005 (AI-251): If some formal is a class-wide interface, expand
-- it to point to the correct secondary virtual table
- if (Nkind (N) = N_Function_Call
- or else Nkind (N) = N_Procedure_Call_Statement)
+ if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
and then CW_Interface_Formals_Present
then
Expand_Interface_Actuals (N);
-- the VM back-ends directly handle the generation of dispatching
-- calls and would have to undo any expansion to an indirect call.
- if (Nkind (N) = N_Function_Call
- or else Nkind (N) = N_Procedure_Call_Statement)
+ if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
and then Present (Controlling_Argument (N))
and then VM_Target = No_VM
then
if (In_Extended_Main_Code_Unit (N)
or else In_Extended_Main_Code_Unit (Parent (N))
- or else Is_Always_Inlined (Subp))
+ or else Has_Pragma_Inline_Always (Subp))
and then (not In_Same_Extended_Unit (Sloc (Bod), Loc)
or else
Earlier_In_Extended_Unit (Sloc (Bod), Loc))
-- If no arguments, delete entire list, this is the easy case
if No (Last_Keep_Arg) then
- while Is_Non_Empty_List (Parameter_Associations (N)) loop
- Delete_Tree (Remove_Head (Parameter_Associations (N)));
- end loop;
-
Set_Parameter_Associations (N, No_List);
Set_First_Named_Actual (N, Empty);
elsif Is_List_Member (Last_Keep_Arg) then
while Present (Next (Last_Keep_Arg)) loop
- Delete_Tree (Remove_Next (Last_Keep_Arg));
+ Discard_Node (Remove_Next (Last_Keep_Arg));
end loop;
Set_First_Named_Actual (N, Empty);
exit when No (Temp);
Set_Next_Named_Actual
(Passoc, Next_Named_Actual (Parent (Temp)));
- Delete_Tree (Temp);
end loop;
end;
end if;
-- use a qualified expression, because an aggregate is not a
-- legal argument of a conversion.
- if Nkind (Expression (N)) = N_Aggregate
- or else Nkind (Expression (N)) = N_Null
- then
+ if Nkind_In (Expression (N), N_Aggregate, N_Null) then
Ret :=
Make_Qualified_Expression (Sloc (N),
Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)),
and then Formal_Is_Used_Once (F))
or else
- ((Nkind (A) = N_Real_Literal or else
- Nkind (A) = N_Integer_Literal or else
- Nkind (A) = N_Character_Literal)
- and then not Address_Taken (F))
+ (Nkind_In (A, N_Real_Literal,
+ N_Integer_Literal,
+ N_Character_Literal)
+ and then not Address_Taken (F))
then
if Etype (F) /= Etype (A) then
Set_Renamed_Object
----------------------------
procedure Expand_N_Function_Call (N : Node_Id) is
- Typ : constant Entity_Id := Etype (N);
-
- function Returned_By_Reference return Boolean;
- -- If the return type is returned through the secondary stack; that is
- -- by reference, we don't want to create a temp to force stack checking.
- -- ???"sec stack" is not right -- Ada 95 return-by-reference object are
- -- returned wherever they are.
- -- Shouldn't this function be moved to exp_util???
-
- function Rhs_Of_Assign_Or_Decl (N : Node_Id) return Boolean;
- -- If the call is the right side of an assignment or the expression in
- -- an object declaration, we don't need to create a temp as the left
- -- side will already trigger stack checking if necessary.
- --
- -- If the call is a component in an extension aggregate, it will be
- -- expanded into assignments as well, so no temporary is needed. This
- -- also solves the problem of functions returning types with unknown
- -- discriminants, where it is not possible to declare an object of the
- -- type altogether.
-
- ---------------------------
- -- Returned_By_Reference --
- ---------------------------
-
- function Returned_By_Reference return Boolean is
- S : Entity_Id;
-
- begin
- if Is_Inherently_Limited_Type (Typ) then
- return True;
-
- elsif Nkind (Parent (N)) /= N_Simple_Return_Statement then
- return False;
-
- elsif Requires_Transient_Scope (Typ) then
-
- -- Verify that the return type of the enclosing function has the
- -- same constrained status as that of the expression.
-
- S := Current_Scope;
- while Ekind (S) /= E_Function loop
- S := Scope (S);
- end loop;
-
- return Is_Constrained (Typ) = Is_Constrained (Etype (S));
- else
- return False;
- end if;
- end Returned_By_Reference;
-
- ---------------------------
- -- Rhs_Of_Assign_Or_Decl --
- ---------------------------
-
- function Rhs_Of_Assign_Or_Decl (N : Node_Id) return Boolean is
- begin
- if (Nkind (Parent (N)) = N_Assignment_Statement
- and then Expression (Parent (N)) = N)
- or else
- (Nkind (Parent (N)) = N_Qualified_Expression
- and then Nkind (Parent (Parent (N))) = N_Assignment_Statement
- and then Expression (Parent (Parent (N))) = Parent (N))
- or else
- (Nkind (Parent (N)) = N_Object_Declaration
- and then Expression (Parent (N)) = N)
- or else
- (Nkind (Parent (N)) = N_Component_Association
- and then Expression (Parent (N)) = N
- and then Nkind (Parent (Parent (N))) = N_Aggregate
- and then Rhs_Of_Assign_Or_Decl (Parent (Parent (N))))
- or else
- (Nkind (Parent (N)) = N_Extension_Aggregate
- and then Is_Private_Type (Etype (Typ)))
- then
- return True;
- else
- return False;
- end if;
- end Rhs_Of_Assign_Or_Decl;
-
- -- Start of processing for Expand_N_Function_Call
-
begin
- -- A special check. If stack checking is enabled, and the return type
- -- might generate a large temporary, and the call is not the right side
- -- of an assignment, then generate an explicit temporary. We do this
- -- because otherwise gigi may generate a large temporary on the fly and
- -- this can cause trouble with stack checking.
-
- -- This is unnecessary if the call is the expression in an object
- -- declaration, or if it appears outside of any library unit. This can
- -- only happen if it appears as an actual in a library-level instance,
- -- in which case a temporary will be generated for it once the instance
- -- itself is installed.
-
- if May_Generate_Large_Temp (Typ)
- and then not Rhs_Of_Assign_Or_Decl (N)
- and then not Returned_By_Reference
- and then Current_Scope /= Standard_Standard
- then
- if Stack_Checking_Enabled then
-
- -- Note: it might be thought that it would be OK to use a call to
- -- Force_Evaluation here, but that's not good enough, because
- -- that can results in a 'Reference construct that may still need
- -- a temporary.
-
- declare
- Loc : constant Source_Ptr := Sloc (N);
- Temp_Obj : constant Entity_Id :=
- Make_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('F'));
- Temp_Typ : Entity_Id := Typ;
- Decl : Node_Id;
- A : Node_Id;
- F : Entity_Id;
- Proc : Entity_Id;
-
- begin
- if Is_Tagged_Type (Typ)
- and then Present (Controlling_Argument (N))
- then
- if Nkind (Parent (N)) /= N_Procedure_Call_Statement
- and then Nkind (Parent (N)) /= N_Function_Call
- then
- -- If this is a tag-indeterminate call, the object must
- -- be classwide.
-
- if Is_Tag_Indeterminate (N) then
- Temp_Typ := Class_Wide_Type (Typ);
- end if;
-
- else
- -- If this is a dispatching call that is itself the
- -- controlling argument of an enclosing call, the
- -- nominal subtype of the object that replaces it must
- -- be classwide, so that dispatching will take place
- -- properly. If it is not a controlling argument, the
- -- object is not classwide.
-
- Proc := Entity (Name (Parent (N)));
-
- F := First_Formal (Proc);
- A := First_Actual (Parent (N));
- while A /= N loop
- Next_Formal (F);
- Next_Actual (A);
- end loop;
-
- if Is_Controlling_Formal (F) then
- Temp_Typ := Class_Wide_Type (Typ);
- end if;
- end if;
- end if;
-
- Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Temp_Obj,
- Object_Definition => New_Occurrence_Of (Temp_Typ, Loc),
- Constant_Present => True,
- Expression => Relocate_Node (N));
- Set_Assignment_OK (Decl);
-
- Insert_Actions (N, New_List (Decl));
- Rewrite (N, New_Occurrence_Of (Temp_Obj, Loc));
- end;
-
- else
- -- If stack-checking is not enabled, increment serial number
- -- for internal names, so that subsequent symbols are consistent
- -- with and without stack-checking.
-
- Synchronize_Serial_Number;
-
- -- Now we can expand the call with consistent symbol names
-
- Expand_Call (N);
- end if;
-
- -- Normal case, expand the call
-
- else
- Expand_Call (N);
- end if;
+ Expand_Call (N);
end Expand_N_Function_Call;
---------------------------------------
-- Step past qualification or unchecked conversion (the latter can occur
-- in cases of calls to 'Input).
- if Nkind (Exp_Node) = N_Qualified_Expression
- or else Nkind (Exp_Node) = N_Unchecked_Type_Conversion
+ if Nkind_In
+ (Exp_Node, N_Qualified_Expression, N_Unchecked_Type_Conversion)
then
Exp_Node := Expression (N);
end if;
function Is_Build_In_Place_Function_Return (N : Node_Id) return Boolean is
begin
- if Nkind (N) = N_Simple_Return_Statement
- or else Nkind (N) = N_Extended_Return_Statement
+ if Nkind_In (N, N_Simple_Return_Statement,
+ N_Extended_Return_Statement)
then
return Is_Build_In_Place_Function
(Return_Applies_To (Return_Statement_Entity (N)));
while Present (Iface_DT_Ptr)
and then Ekind (Node (Iface_DT_Ptr)) = E_Constant
loop
+ pragma Assert (Has_Thunks (Node (Iface_DT_Ptr)));
Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code);
if Present (Thunk_Code) then
- Insert_Actions (N, New_List (
+ Insert_Actions_After (N, New_List (
Thunk_Code,
Build_Set_Predefined_Prim_Op_Address (Loc,
Address_Node =>
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Thunk_Id, Loc),
+ Attribute_Name => Name_Address)),
+
+ Build_Set_Predefined_Prim_Op_Address (Loc,
+ Tag_Node => New_Reference_To
+ (Node (Next_Elmt (Iface_DT_Ptr)), Loc),
+ Position => DT_Position (Prim),
+ Address_Node =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (Prim, Loc),
Attribute_Name => Name_Address))));
end if;
Next_Elmt (Iface_DT_Ptr);
+ pragma Assert (not Has_Thunks (Node (Iface_DT_Ptr)));
+
+ Next_Elmt (Iface_DT_Ptr);
end loop;
end Register_Predefined_DT_Entry;
Subp : constant Entity_Id := Entity (N);
+ -- Start of processing for Freeze_Subprogram
+
begin
-- We suppress the initialization of the dispatch table entry when
-- VM_Target because the dispatching mechanism is handled internally
-- Step past qualification or unchecked conversion (the latter can occur
-- in cases of calls to 'Input).
- if Nkind (Func_Call) = N_Qualified_Expression
- or else Nkind (Func_Call) = N_Unchecked_Type_Conversion
+ if Nkind_In (Func_Call,
+ N_Qualified_Expression,
+ N_Unchecked_Type_Conversion)
then
Func_Call := Expression (Func_Call);
end if;
-- Step past qualification or unchecked conversion (the latter can occur
-- in cases of calls to 'Input).
- if Nkind (Func_Call) = N_Qualified_Expression
- or else Nkind (Func_Call) = N_Unchecked_Type_Conversion
+ if Nkind_In (Func_Call, N_Qualified_Expression,
+ N_Unchecked_Type_Conversion)
then
Func_Call := Expression (Func_Call);
end if;
-- Step past qualification or unchecked conversion (the latter can occur
-- in cases of calls to 'Input).
- if Nkind (Func_Call) = N_Qualified_Expression
- or else Nkind (Func_Call) = N_Unchecked_Type_Conversion
+ if Nkind_In (Func_Call, N_Qualified_Expression,
+ N_Unchecked_Type_Conversion)
then
Func_Call := Expression (Func_Call);
end if;
-- Step past qualification or unchecked conversion (the latter can occur
-- in cases of calls to 'Input).
- if Nkind (Func_Call) = N_Qualified_Expression
- or else Nkind (Func_Call) = N_Unchecked_Type_Conversion
+ if Nkind_In (Func_Call, N_Qualified_Expression,
+ N_Unchecked_Type_Conversion)
then
Func_Call := Expression (Func_Call);
end if;
function Find_Interface_ADT
(T : Entity_Id;
- Iface : Entity_Id) return Entity_Id
+ Iface : Entity_Id) return Elmt_Id
is
ADT : Elmt_Id;
Found : Boolean := False;
end if;
Next_Elmt (ADT);
+ Next_Elmt (ADT);
Next_Elmt (AI_Elmt);
end loop;
end if;
pragma Assert (Present (Node (ADT)));
Find_Secondary_Table (Typ);
pragma Assert (Found);
- return Node (ADT);
+ return ADT;
end Find_Interface_ADT;
------------------------
when N_And_Then | N_Or_Else =>
if N = Right_Opnd (P) then
+
+ -- We are now going to either append the actions to the
+ -- actions field of the short-circuit operation. We will
+ -- also analyze the actions now.
+
+ -- This analysis is really too early, the proper thing would
+ -- be to just park them there now, and only analyze them if
+ -- we find we really need them, and to it at the proper
+ -- final insertion point. However attempting to this proved
+ -- tricky, so for now we just kill current values before and
+ -- after the analyze call to make sure we avoid peculiar
+ -- optimizations from this out of order insertion.
+
+ Kill_Current_Values;
+
if Present (Actions (P)) then
Insert_List_After_And_Analyze
- (Last (Actions (P)), Ins_Actions);
+ (Last (Actions (P)), Ins_Actions);
else
Set_Actions (P, Ins_Actions);
Analyze_List (Actions (P));
end if;
+ Kill_Current_Values;
+
return;
end if;
or else TSS_Name = TSS_Deep_Adjust
or else TSS_Name = TSS_Deep_Finalize
or else (Ada_Version >= Ada_05
- and then (Chars (E) = Name_uDisp_Asynchronous_Select
- or else Chars (E) = Name_uDisp_Conditional_Select
- or else Chars (E) = Name_uDisp_Get_Prim_Op_Kind
- or else Chars (E) = Name_uDisp_Get_Task_Id
- or else Chars (E) = Name_uDisp_Timed_Select))
+ and then (Chars (E) = Name_uDisp_Asynchronous_Select
+ or else Chars (E) = Name_uDisp_Conditional_Select
+ or else Chars (E) = Name_uDisp_Get_Prim_Op_Kind
+ or else Chars (E) = Name_uDisp_Get_Task_Id
+ or else Chars (E) = Name_uDisp_Requeue
+ or else Chars (E) = Name_uDisp_Timed_Select))
then
return True;
end if;
elsif Nkind (N) in N_Generic_Instantiation then
Remove_Dead_Instance (N);
end if;
-
- Delete_Tree (N);
end if;
end Kill_Dead_Code;
begin
W := Warn;
if Is_Non_Empty_List (L) then
- loop
- N := Remove_Head (L);
- exit when No (N);
+ N := First (L);
+ while Present (N) loop
Kill_Dead_Code (N, W);
W := False;
+ Next (N);
end loop;
end if;
end Kill_Dead_Code;
function Find_Interface_ADT
(T : Entity_Id;
- Iface : Entity_Id) return Entity_Id;
+ Iface : Entity_Id) return Elmt_Id;
-- Ada 2005 (AI-251): Given a type T implementing the interface Iface,
- -- return the Access_Disp_Table value of the interface.
+ -- return the element of Access_Disp_Table containing the tag of the
+ -- interface.
function Find_Interface_Tag
(T : Entity_Id;
-- or is a private type whose completion is such a type.
procedure Kill_Dead_Code (N : Node_Id; Warn : Boolean := False);
- -- N represents a node for a section of code that is known to be dead. The
- -- node is deleted, and any exception handler references and warning
- -- messages relating to this code are removed. If Warn is True, a warning
- -- will be output at the start of N indicating the deletion of the code.
+ -- N represents a node for a section of code that is known to be dead. Any
+ -- exception handler references and warning messages relating to this code
+ -- are removed. If Warn is True, a warning will be output at the start of N
+ -- indicating the deletion of the code. Note that the tree for the deleted
+ -- code is left intact so that e.g. cross-reference data is still valid.
procedure Kill_Dead_Code (L : List_Id; Warn : Boolean := False);
-- Like the above procedure, but applies to every element in the given
- -- list. Each of the entries is removed from the list before killing it.
- -- If Warn is True, a warning will be output at the start of N indicating
- -- the deletion of the code.
+ -- list. If Warn is True, a warning will be output at the start of N
+ -- indicating the deletion of the code.
function Known_Non_Negative (Opnd : Node_Id) return Boolean;
-- Given a node for a subexpression, determines if it represents a value
Append (Node, To);
end Append_To;
- -----------------
- -- Delete_List --
- -----------------
-
- procedure Delete_List (L : List_Id) is
- N : Node_Id;
-
- begin
- while Is_Non_Empty_List (L) loop
- N := Remove_Head (L);
- Delete_Tree (N);
- end loop;
-
- -- Should recycle list header???
- end Delete_List;
-
-----------
-- First --
-----------
function First_Non_Pragma (List : List_Id) return Node_Id is
N : constant Node_Id := First (List);
-
begin
if Nkind (N) /= N_Pragma
and then
function Last_Non_Pragma (List : List_Id) return Node_Id is
N : constant Node_Id := Last (List);
-
begin
if Nkind (N) /= N_Pragma then
return N;
-- These functions return the addresses of the Next_Node and Prev_Node
-- tables (used in Back_End for Gigi).
- procedure Delete_List (L : List_Id);
- -- Removes all elements of the given list, and calls Delete_Tree on each
-
function p (U : Union_Id) return Node_Id;
-- This function is intended for use from the debugger, it determines
-- whether U is a Node_Id or List_Id, and calls the appropriate Parent
Style.Check_Attribute_Name (False);
end if;
- Delete_Node (Token_Node);
-
-- Here for case of attribute designator is not an identifier
else
-- the flag for outer level entities that are not
-- imported/exported, and which have no interface name.
- elsif K = N_Object_Declaration
- or else K = N_Exception_Declaration
- or else K = N_Subprogram_Declaration
+ elsif Nkind_In (K, N_Object_Declaration,
+ N_Exception_Declaration,
+ N_Subprogram_Declaration)
then
E := Defining_Entity (D);
then
Generate_Reference (Id, Scope (Id), 'k', False);
- elsif Nkind (Unit (Cunit (Main_Unit))) /= N_Subprogram_Body
- and then Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit
+ elsif not Nkind_In (Unit (Cunit (Main_Unit)), N_Subprogram_Body,
+ N_Subunit)
then
-- If current unit is an ancestor of main unit, generate
-- a reference to its own parent.
-- with a known_discriminant_part whose full view is an
-- Unchecked_Union.
- if (Nkind (Decl) = N_Incomplete_Type_Declaration
- or else
- Nkind (Decl) = N_Private_Type_Declaration)
+ if Nkind_In (Decl, N_Incomplete_Type_Declaration,
+ N_Private_Type_Declaration)
and then Has_Discriminants (Defining_Identifier (Decl))
and then Present (Full_View (Defining_Identifier (Decl)))
- and then Is_Unchecked_Union
- (Full_View (Defining_Identifier (Decl)))
+ and then
+ Is_Unchecked_Union (Full_View (Defining_Identifier (Decl)))
then
- Error_Msg_N ("completion of discriminated partial view" &
- " cannot be an Unchecked_Union",
+ Error_Msg_N
+ ("completion of discriminated partial view "
+ & "cannot be an Unchecked_Union",
Full_View (Defining_Identifier (Decl)));
end if;
while Present (Gen_Par) and then Is_Child_Unit (Gen_Par) loop
Inst_Node := Get_Package_Instantiation_Node (Inst_Par);
- if (Nkind (Inst_Node) = N_Package_Instantiation
- or else Nkind (Inst_Node) = N_Formal_Package_Declaration)
+ if Nkind_In (Inst_Node, N_Package_Instantiation,
+ N_Formal_Package_Declaration)
and then Nkind (Name (Inst_Node)) = N_Expanded_Name
then
Inst_Par := Entity (Prefix (Name (Inst_Node)));
return List2 (N);
end Pragma_Argument_Associations;
+ function Pragma_Identifier
+ (N : Node_Id) return Node_Id is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Pragma);
+ return Node4 (N);
+ end Pragma_Identifier;
+
function Pragmas_After
(N : Node_Id) return List_Id is
begin
Set_List2_With_Parent (N, Val);
end Set_Pragma_Argument_Associations;
+ procedure Set_Pragma_Identifier
+ (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Pragma);
+ Set_Node4_With_Parent (N, Val);
+ end Set_Pragma_Identifier;
+
procedure Set_Pragmas_After
(N : Node_Id; Val : List_Id) is
begin
UI_From_Int (Int (S) - Int (Sloc (N))));
end Set_End_Location;
+ --------------------------------
+ -- Node_Kind Membership Tests --
+ --------------------------------
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2;
+ end Nkind_In;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3;
+ end Nkind_In;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3 or else
+ T = V4;
+ end Nkind_In;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3 or else
+ T = V4 or else
+ T = V5;
+ end Nkind_In;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3 or else
+ T = V4 or else
+ T = V5 or else
+ T = V6;
+ end Nkind_In;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind;
+ V7 : Node_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3 or else
+ T = V4 or else
+ T = V5 or else
+ T = V6 or else
+ T = V7;
+ end Nkind_In;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind;
+ V7 : Node_Kind;
+ V8 : Node_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3 or else
+ T = V4 or else
+ T = V5 or else
+ T = V6 or else
+ T = V7 or else
+ T = V8;
+ end Nkind_In;
+
end Sinfo;
-- 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).
+ -- is acting as its own spec, except in the case of a library level
+ -- subprogram, in which case the flag is set on the parent compilation
+ -- unit node instead (see further description in spec of Lib package).
+ -- ??? Above note about Lib is dubious since lib.ads does not mention
+ -- Acts_As_Spec at all.
-- Actual_Designated_Subtype (Node4-Sem)
-- Present in N_Free_Statement and N_Explicit_Dereference nodes. If gigi
-- 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. Note that this field also
- -- appears in N_Attribute_Definition_Clause nodes. It is used only for
- -- stream attributes definition clauses. In this case, it denotes a
- -- (possibly dummy) subprogram entity that is conceptually declared at
- -- the point of the clause. Thus the visibility of the attribute
- -- definition clause (in the sense of 8.3(23) as amended by AI-195) can
- -- be checked by testing the visibility of that subprogram.
+ -- Appears in all direct names (identifiers, character literals, and
+ -- operator symbols), as well as expanded names, and attributes that
+ -- denote entities, such as 'Class. Points to entity for corresponding
+ -- defining occurrence. Set after name resolution. For identifiers in a
+ -- WITH list, the corresponding defining occurrence is in a separately
+ -- compiled file, and Entity must be set by the library Load procedure.
+ --
+ -- Note: 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: 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.
+ --
+ -- Note: This field also appears in N_Attribute_Definition_Clause nodes.
+ -- It is used only for stream attributes definition clauses. In this
+ -- case, it denotes a (possibly dummy) subprogram entity that is declared
+ -- conceptually at the point of the clause. Thus the visibility of the
+ -- attribute definition clause (in the sense of 8.3(23) as amended by
+ -- AI-195) can be checked by testing the visibility of that subprogram.
+ --
+ -- Note: Normally the Entity field of an identifier points to the entity
+ -- for the corresponding defining identifier, and hence the Chars field
+ -- of an identifier will match the Chars field of the entity. However,
+ -- there is no requirement that these match, and there are obscure cases
+ -- of generated code where they do not match.
-- Entity_Or_Associated_Node (Node4-Sem)
-- A synonym for both Entity and Associated_Node. Used by convention in
-- 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
+ -- generate elaboration code, and non-preelaborated packages which do
-- not generate elaboration code.
-- Has_Priority_Pragma (Flag6-Sem)
-- which are explicitly documented.
-- N_Pragma
- -- Sloc points to PRAGMA
+ -- Sloc points to pragma identifier
-- Chars (Name1) identifier name from pragma identifier
-- Pragma_Argument_Associations (List2) (set to No_List if none)
-- Debug_Statement (Node3) (set to Empty if not Debug, Assert)
+ -- Pragma_Identifier (Node4)
-- Next_Rep_Item (Node5-Sem)
-- Note: we should have a section on what pragmas are passed on to
-- Psect_Object is always converted to Common_Object, but there are
-- undoubtedly many other similar notes required ???
+ -- Note: we don't really need the Chars field, since it can trivially
+ -- be obtained as Chars (Pragma_Identifier (Node)). However, it is
+ -- convenient to have this directly available, and historically the
+ -- Chars field has been around for ever, whereas the Pragma_Identifier
+ -- field was added much later (when we found the need to be able to get
+ -- the Sloc of the pragma identifier).
+
--------------------------------------
-- 2.8 Pragma Argument Association --
--------------------------------------
-- component_SELECTOR_NAME {| component_SELECTOR_NAME}
-- | others
- -- The entries of a component choice list appear in the Choices list
- -- of the associated N_Component_Association, as either selector
- -- names, or as an N_Others_Choice node.
+ -- The entries of a component choice list appear in the Choices list of
+ -- the associated N_Component_Association, as either selector names, or
+ -- as an N_Others_Choice node.
--------------------------------
-- 4.3.2 Extension Aggregate --
subtype N_Unit_Body is Node_Kind range
N_Package_Body ..
- N_Subprogram_Body;
+ N_Subprogram_Body;
---------------------------
-- Node Access Functions --
function Pragma_Argument_Associations
(N : Node_Id) return List_Id; -- List2
+ function Pragma_Identifier
+ (N : Node_Id) return Node_Id; -- Node4
+
function Pragmas_After
(N : Node_Id) return List_Id; -- List5
procedure Set_Pragma_Argument_Associations
(N : Node_Id; Val : List_Id); -- List2
+ procedure Set_Pragma_Identifier
+ (N : Node_Id; Val : Node_Id); -- Node4
+
procedure Set_Pragmas_After
(N : Node_Id; Val : List_Id); -- List5
-- other words, End_Span is set to the difference between S and
-- Sloc (N), the starting location.
+ --------------------------------
+ -- Node_Kind Membership Tests --
+ --------------------------------
+
+ -- The following functions allow a convenient notation for testing wheter
+ -- a Node_Kind value matches any one of a list of possible values. In each
+ -- case True is returned if the given T argument is equal to any of the V
+ -- arguments. Note that there is a similar set of functions defined in
+ -- Atree where the first argument is a Node_Id whose Nkind field is tested.
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind) return Boolean;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind) return Boolean;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind) return Boolean;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind) return Boolean;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind) return Boolean;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind;
+ V7 : Node_Kind) return Boolean;
+
+ function Nkind_In
+ (T : Node_Kind;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind;
+ V7 : Node_Kind;
+ V8 : Node_Kind) return Boolean;
+
+ pragma Inline (Nkind_In);
+ -- Inline all above functions
+
-----------------------------
-- Syntactic Parent Tables --
-----------------------------
(1 => True, -- Chars (Name1)
2 => True, -- Pragma_Argument_Associations (List2)
3 => True, -- Debug_Statement (Node3)
- 4 => False, -- Entity (Node4-Sem)
+ 4 => True, -- Pragma_Identifier (Node4)
5 => False), -- Next_Rep_Item (Node5-Sem)
N_Pragma_Argument_Association =>
pragma Inline (Parent_Spec);
pragma Inline (Position);
pragma Inline (Pragma_Argument_Associations);
+ pragma Inline (Pragma_Identifier);
pragma Inline (Pragmas_After);
pragma Inline (Pragmas_Before);
pragma Inline (Prefix);
pragma Inline (Set_Parent_Spec);
pragma Inline (Set_Position);
pragma Inline (Set_Pragma_Argument_Associations);
+ pragma Inline (Set_Pragma_Identifier);
pragma Inline (Set_Pragmas_After);
pragma Inline (Set_Pragmas_Before);
pragma Inline (Set_Prefix);
OSDN Git Service
