package body Sem_Ch12 is
- use Atree.Unchecked_Access;
- -- This package performs untyped traversals of the tree, therefore it
- -- needs direct access to the fields of a node.
-
----------------------------------------------------------
-- Implementation of Generic Analysis and Instantiation --
-----------------------------------------------------------
-- Add the context clause of the unit containing a generic unit to
-- an instantiation that is a compilation unit.
- function Associated_Node (N : Node_Id) return Node_Id;
+ function Get_Associated_Node (N : Node_Id) return Node_Id;
-- In order to propagate semantic information back from the analyzed
-- copy to the original generic, we maintain links between selected nodes
-- in the generic and their corresponding copies. At the end of generic
-- analysis, the routine Save_Global_References traverses the generic
-- tree, examines the semantic information, and preserves the links to
-- those nodes that contain global information. At instantiation, the
- -- information from the associated node is placed on the new copy, so that
- -- name resolution is not repeated.
- -- Two kinds of nodes have associated nodes:
+ -- information from the associated node is placed on the new copy, so
+ -- that name resolution is not repeated.
+
+ -- Three kinds of nodes have associated nodes:
- -- a) those that contain entities, that is to say identifiers, expanded_
- -- names, and operators.
+ -- a) those that contain entities, that is to say identifiers,
+ -- expanded_names, and operators (N_Has_Entity)
- -- b) aggregates.
+ -- b) aggregates (N_Aggregate and N_Extension_Aggregate)
+
+ -- c) selected components (N_Selected_Component)
-- For the first class, the associated node preserves the entity if it is
-- global. If the generic contains nested instantiations, the associated_
-- some of the ancestor types, if their view is private at the point of
-- instantiation.
- -- The associated node is stored in Node4, using this field as a free
- -- union in a fashion that should clearly be under control of sinfo ???
+ -- Query??? why selected components. What about N_Freeze_Nodes, I assume
+ -- that the answer is no, which means that the comment above for a) is
+ -- confusing ???
+
+ -- The associated node is stored in the Associated_Node field. Note that
+ -- this field overlaps Entity, which is fine, because the whole point is
+ -- that we don't need or want the normal Entity field in this situation.
procedure Move_Freeze_Nodes
(Out_Of : Entity_Id;
-- before installing parents of generics, that are not visible for the
-- actuals themselves.
- procedure Set_Associated_Node
- (Gen_Node : Node_Id;
- Copy_Node : Node_Id);
- -- Establish the link between an identifier in the generic unit, and the
- -- corresponding node in the semantic copy.
-
procedure Valid_Default_Attribute (Nam : Entity_Id; Def : Node_Id);
-- Verify that an attribute that appears as the default for a formal
-- subprogram is a function or procedure with the correct profile.
end Analyze_Subprogram_Instantiation;
- ---------------------
- -- Associated_Node --
- ---------------------
+ -------------------------
+ -- Get_Associated_Node --
+ -------------------------
- function Associated_Node (N : Node_Id) return Node_Id is
- Assoc : Node_Id := Node4 (N);
- -- ??? what is Node4 being used for here?
+ function Get_Associated_Node (N : Node_Id) return Node_Id is
+ Assoc : Node_Id := Associated_Node (N);
begin
if Nkind (Assoc) /= Nkind (N) then
return Assoc;
else
-- If the node is part of an inner generic, it may itself have been
- -- remapped into a further generic copy. Node4 is otherwise used for
- -- the entity of the node, and will be of a different node kind, or
- -- else N has been rewritten as a literal or function call.
+ -- remapped into a further generic copy. Associated_Node is otherwise
+ -- used for the entity of the node, and will be of a different node
+ -- kind, or else N has been rewritten as a literal or function call.
- while Present (Node4 (Assoc))
- and then Nkind (Node4 (Assoc)) = Nkind (Assoc)
+ while Present (Associated_Node (Assoc))
+ and then Nkind (Associated_Node (Assoc)) = Nkind (Assoc)
loop
- Assoc := Node4 (Assoc);
+ Assoc := Associated_Node (Assoc);
end loop;
-- Follow and additional link in case the final node was rewritten.
-- This can only happen with nested generic units.
if (Nkind (Assoc) = N_Identifier or else Nkind (Assoc) in N_Op)
- and then Present (Node4 (Assoc))
- and then (Nkind (Node4 (Assoc)) = N_Function_Call
- or else Nkind (Node4 (Assoc)) = N_Explicit_Dereference
- or else Nkind (Node4 (Assoc)) = N_Integer_Literal
- or else Nkind (Node4 (Assoc)) = N_Real_Literal
- or else Nkind (Node4 (Assoc)) = N_String_Literal)
+ and then Present (Associated_Node (Assoc))
+ and then (Nkind (Associated_Node (Assoc)) = N_Function_Call
+ or else
+ Nkind (Associated_Node (Assoc)) = N_Explicit_Dereference
+ or else
+ Nkind (Associated_Node (Assoc)) = N_Integer_Literal
+ or else
+ Nkind (Associated_Node (Assoc)) = N_Real_Literal
+ or else
+ Nkind (Associated_Node (Assoc)) = N_String_Literal)
then
- Assoc := Node4 (Assoc);
+ Assoc := Associated_Node (Assoc);
end if;
return Assoc;
end if;
- end Associated_Node;
+ end Get_Associated_Node;
-------------------------------------------
-- Build_Instance_Compilation_Unit_Nodes --
elsif Has_Private_View (N)
and then not Is_Private_Type (T)
and then not Has_Been_Exchanged (T)
- and then Etype (Associated_Node (N)) /= T
+ and then Etype (Get_Associated_Node (N)) /= T
then
-- Only the private declaration was visible in the generic. If
-- the type appears in a subtype declaration, the subtype in the
or else not In_Private_Part (Scope (Base_Type (T)))
then
Append_Elmt (T, Exchanged_Views);
- Exchange_Declarations (Etype (Associated_Node (N)));
+ Exchange_Declarations (Etype (Get_Associated_Node (N)));
end if;
-- For composite types with inconsistent representation
-----------------------
procedure Copy_Descendants is
+
+ use Atree.Unchecked_Access;
+ -- This code section is part of the implementation of an untyped
+ -- tree traversal, so it needs direct access to node fields.
+
begin
Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
-- If the associated node is still defined, the entity in
-- it is global, and must be copied to the instance.
- if Present (Associated_Node (N)) then
- if Nkind (Associated_Node (N)) = Nkind (N) then
- Set_Entity (New_N, Entity (Associated_Node (N)));
+ if Present (Get_Associated_Node (N)) then
+ if Nkind (Get_Associated_Node (N)) = Nkind (N) then
+ Set_Entity (New_N, Entity (Get_Associated_Node (N)));
Check_Private_View (N);
- elsif Nkind (Associated_Node (N)) = N_Function_Call then
- Set_Entity (New_N, Entity (Name (Associated_Node (N))));
+ elsif Nkind (Get_Associated_Node (N)) = N_Function_Call then
+ Set_Entity (New_N, Entity (Name (Get_Associated_Node (N))));
else
Set_Entity (New_N, Empty);
Set_Associated_Node (N, New_N);
else
- if Present (Associated_Node (N))
- and then Nkind (Associated_Node (N)) = Nkind (N)
+ if Present (Get_Associated_Node (N))
+ and then Nkind (Get_Associated_Node (N)) = Nkind (N)
then
-- In the generic the aggregate has some composite type.
-- If at the point of instantiation the type has a private
-- if any).
declare
- T : Entity_Id := (Etype (Associated_Node (New_N)));
+ T : Entity_Id := (Etype (Get_Associated_Node (New_N)));
Rt : Entity_Id;
begin
-- Do not copy the associated node, which points to
-- the generic copy of the aggregate.
- Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
- Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
- Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
- Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
+ declare
+ use Atree.Unchecked_Access;
+ -- This code section is part of the implementation of an untyped
+ -- tree traversal, so it needs direct access to node fields.
+
+ begin
+ Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
+ Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
+ Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
+ Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
+ end;
-- Allocators do not have an identifier denoting the access type,
-- so we must locate it through the expression to check whether
and then Instantiating
then
declare
- T : Node_Id := Associated_Node (Subtype_Mark (Expression (N)));
- Acc_T : Entity_Id;
+ T : Node_Id := Get_Associated_Node (Subtype_Mark (Expression (N)));
+ Acc_T : Entity_Id;
begin
if Present (T) then
-- context of the parent, we must preserve the identifier of the parent
-- so that it can be properly resolved in a subsequent instantiation.
+ procedure Save_Global_Operand_Descendants (N : Node_Id);
+ -- Apply Save_Global_Descendant to the possible operand fields
+ -- of the node N (Field2 = Left_Opnd, Field3 = Right_Opnd).
+ --
+ -- It is uncomfortable for Sem_Ch12 to have this knowledge ???
+
procedure Save_Global_Descendant (D : Union_Id);
-- Apply Save_Global_References recursively to the descendents of
-- current node.
-- The type of N2 is global to the generic unit. Save the
-- type in the generic node.
+ ---------------------
+ -- Set_Global_Type --
+ ---------------------
+
procedure Set_Global_Type (N : Node_Id; N2 : Node_Id) is
Typ : constant Entity_Id := Etype (N2);
-- Start of processing for Reset_Entity
begin
- N2 := Associated_Node (N);
+ N2 := Get_Associated_Node (N);
E := Entity (N2);
if Present (E) then
Change_Selected_Component_To_Expanded_Name (Parent (N));
Set_Associated_Node (Parent (N), Parent (N2));
Set_Global_Type (Parent (N), Parent (N2));
-
- Save_Global_Descendant (Field2 (N));
- Save_Global_Descendant (Field3 (N));
+ Save_Global_Operand_Descendants (N);
-- If this is a reference to the current generic entity,
-- replace it with a simple name. This is to avoid anomalies
New_Copy (Parent (N2)));
Set_Analyzed (Parent (N), False);
- -- a selected component may be transformed into a parameterless
+ -- A selected component may be transformed into a parameterless
-- function call. If the called entity is global, rewrite the
-- node appropriately, i.e. as an extended name for the global
-- entity.
Change_Selected_Component_To_Expanded_Name (Parent (N));
Set_Associated_Node (Parent (N), Name (Parent (N2)));
Set_Global_Type (Parent (N), Name (Parent (N2)));
-
- Save_Global_Descendant (Field2 (N));
- Save_Global_Descendant (Field3 (N));
+ Save_Global_Operand_Descendants (N);
else
-- Entity is local. Reset in generic unit, so that node
end if;
end Save_Global_Descendant;
+ -------------------------------------
+ -- Save_Global_Operand_Descendants --
+ -------------------------------------
+
+ procedure Save_Global_Operand_Descendants (N : Node_Id) is
+
+ use Atree.Unchecked_Access;
+ -- This code section is part of the implementation of an untyped
+ -- tree traversal, so it needs direct access to node fields.
+
+ begin
+ Save_Global_Descendant (Field2 (N));
+ Save_Global_Descendant (Field3 (N));
+ end Save_Global_Operand_Descendants;
+
---------------------
-- Save_References --
---------------------
elsif (Nkind (N) = N_Character_Literal
or else Nkind (N) = N_Operator_Symbol)
then
- if Nkind (N) = Nkind (Associated_Node (N)) then
+ if Nkind (N) = Nkind (Get_Associated_Node (N)) then
Reset_Entity (N);
elsif Nkind (N) = N_Operator_Symbol
- and then Nkind (Associated_Node (N)) = N_String_Literal
+ and then Nkind (Get_Associated_Node (N)) = N_String_Literal
then
Change_Operator_Symbol_To_String_Literal (N);
end if;
elsif Nkind (N) in N_Op then
- if Nkind (N) = Nkind (Associated_Node (N)) then
+ if Nkind (N) = Nkind (Get_Associated_Node (N)) then
if Nkind (N) = N_Op_Concat then
Set_Is_Component_Left_Opnd (N,
- Is_Component_Left_Opnd (Associated_Node (N)));
+ Is_Component_Left_Opnd (Get_Associated_Node (N)));
Set_Is_Component_Right_Opnd (N,
- Is_Component_Right_Opnd (Associated_Node (N)));
+ Is_Component_Right_Opnd (Get_Associated_Node (N)));
end if;
Reset_Entity (N);
else
-- Node may be transformed into call to a user-defined operator
- N2 := Associated_Node (N);
+ N2 := Get_Associated_Node (N);
if Nkind (N2) = N_Function_Call then
E := Entity (Name (N2));
end if;
end if;
- -- Complete the check on operands.
+ -- Complete the check on operands
- Save_Global_Descendant (Field2 (N));
- Save_Global_Descendant (Field3 (N));
+ Save_Global_Operand_Descendants (N);
elsif Nkind (N) = N_Identifier then
- if Nkind (N) = Nkind (Associated_Node (N)) then
+ if Nkind (N) = Nkind (Get_Associated_Node (N)) then
-- If this is a discriminant reference, always save it.
-- It is used in the instance to find the corresponding
-- discriminant positionally rather than by name.
Set_Original_Discriminant
- (N, Original_Discriminant (Associated_Node (N)));
+ (N, Original_Discriminant (Get_Associated_Node (N)));
Reset_Entity (N);
else
- N2 := Associated_Node (N);
+ N2 := Get_Associated_Node (N);
if Nkind (N2) = N_Function_Call then
E := Entity (Name (N2));
elsif Nkind (N) in N_Entity then
null;
- elsif Nkind (N) = N_Aggregate
- or else Nkind (N) = N_Extension_Aggregate
- then
- N2 := Associated_Node (N);
- if No (N2)
- or else No (Etype (N2))
- or else not Is_Global (Etype (N2))
- then
- Set_Associated_Node (N, Empty);
- end if;
+ else
+ declare
+ use Atree.Unchecked_Access;
+ -- This code section is part of implementing an untyped tree
+ -- traversal, so it needs direct access to node fields.
- Save_Global_Descendant (Field1 (N));
- Save_Global_Descendant (Field2 (N));
- Save_Global_Descendant (Field3 (N));
- Save_Global_Descendant (Field5 (N));
+ begin
+ if Nkind (N) = N_Aggregate
+ or else
+ Nkind (N) = N_Extension_Aggregate
+ then
+ N2 := Get_Associated_Node (N);
- else
- Save_Global_Descendant (Field1 (N));
- Save_Global_Descendant (Field2 (N));
- Save_Global_Descendant (Field3 (N));
- Save_Global_Descendant (Field4 (N));
- Save_Global_Descendant (Field5 (N));
+ if No (N2)
+ or else No (Etype (N2))
+ or else not Is_Global (Etype (N2))
+ then
+ Set_Associated_Node (N, Empty);
+ end if;
+
+ Save_Global_Descendant (Field1 (N));
+ Save_Global_Descendant (Field2 (N));
+ Save_Global_Descendant (Field3 (N));
+ Save_Global_Descendant (Field5 (N));
+
+ -- All other cases than aggregates
+ else
+ Save_Global_Descendant (Field1 (N));
+ Save_Global_Descendant (Field2 (N));
+ Save_Global_Descendant (Field3 (N));
+ Save_Global_Descendant (Field4 (N));
+ Save_Global_Descendant (Field5 (N));
+ end if;
+ end;
end if;
end Save_References;
Save_References (N);
end Save_Global_References;
- -------------------------
- -- Set_Associated_Node --
- -------------------------
-
- -- Note from RBKD: the uncommented use of Set_Node4 below is ugly ???
-
- procedure Set_Associated_Node
- (Gen_Node : Node_Id;
- Copy_Node : Node_Id)
- is
- begin
- Set_Node4 (Gen_Node, Copy_Node);
- end Set_Associated_Node;
-
---------------------
-- Set_Copied_Sloc --
---------------------
-- --
-- S p e c --
-- --
--- $Revision: 1.1 $
+-- $Revision: 1.2 $
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
-- Left_Opnd (Node2) left operand expression
-- Right_Opnd (Node3) right operand expression
-- Entity (Node4-Sem) defining entity for operator
+ -- Associated_Node (Node4-Sem) for generic processing
-- Do_Overflow_Check (Flag17-Sem) set if overflow check needed
-- Has_Private_View (Flag11-Sem) set in generic units.
-- Chars (Name1) Name_Id for the operator
-- Right_Opnd (Node3) right operand expression
-- Entity (Node4-Sem) defining entity for operator
+ -- Associated_Node (Node4-Sem) for generic processing
-- Do_Overflow_Check (Flag17-Sem) set if overflow check needed
-- Has_Private_View (Flag11-Sem) set in generic units.
-- 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 and expanded names, operator nodes that carry an entity
+ -- reference, and also in N_Aggregate, N_Selected_Component, and
+ -- N_Extension_Aggregate nodes. This field is used during generic
+ -- processing to relate nodes in the original template to nodes in the
+ -- generic copy. It overlaps the Entity field, and is used to capture
+ -- global references in the analyzed copy and place them in the template.
+ -- see description in Sem_Ch12 for further details on this usage.
+
-- 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
-- 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).
+ -- 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 Associated_Node overlays this field during the processing
+ -- of generics. See Sem_Ch12 for further details.
-- Etype (Node5-Sem)
-- Appears in all expression nodes, all direct names, and all
-- Sloc points to identifier
-- Chars (Name1) contains the Name_Id for the identifier
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Original_Discriminant (Node2-Sem)
-- Redundant_Use (Flag13-Sem)
-- Has_Private_View (Flag11-Sem) (set in generic units)
-- Chars (Name1) contains the Name_Id for the identifier
-- Char_Literal_Value (Char_Code2) contains the literal value
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Has_Private_View (Flag11-Sem) set in generic units.
-- plus fields for expression
-- Sloc points to period
-- Prefix (Node3)
-- Selector_Name (Node2)
+ -- Associated_Node (Node4-Sem)
-- Do_Access_Check (Flag11-Sem)
-- Do_Discriminant_Check (Flag13-Sem)
-- plus fields for expression
-- Attribute_Name (Name2) identifier name from attribute designator
-- Expressions (List1) (set to No_List if no associated expressions)
-- Entity (Node4-Sem) used if the attribute yields a type
+ -- Associated_Node (Node4-Sem)
-- Do_Access_Check (Flag11-Sem)
-- Do_Overflow_Check (Flag17-Sem)
-- Redundant_Use (Flag13-Sem)
-- Component_Associations (List2) (set to No_List if none)
-- Null_Record_Present (Flag17)
-- Aggregate_Bounds (Node3-Sem)
+ -- Associated_Node (Node4-Sem)
-- Static_Processing_OK (Flag4-Sem)
-- Compile_Time_Known_Aggregate (Flag18-Sem)
-- Expansion_Delayed (Flag11-Sem)
-- N_Extension_Aggregate
-- Sloc points to left parenthesis
-- Ancestor_Part (Node3)
+ -- Associated_Node (Node4-Sem)
-- Expressions (List1) (set to No_List if none or null record case)
-- Component_Associations (List2) (set to No_List if none)
-- Null_Record_Present (Flag17)
-- Strval (Str3) Id of string value. This is used if the operator
-- symbol turns out to be a normal string after all.
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Has_Private_View (Flag11-Sem) set in generic units.
-- Etype (Node5-Sem)
-- Prefix (Node3)
-- Selector_Name (Node2)
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Redundant_Use (Flag13-Sem)
-- Has_Private_View (Flag11-Sem) set in generic units.
-- plus fields for expression
-- N_Freeze_Entity
-- Sloc points near freeze point (see above special note)
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Access_Types_To_Process (Elist2-Sem) (set to No_Elist if none)
-- TSS_Elist (Elist3-Sem) (set to No_Elist if no associated TSS's)
-- Actions (List1) (set to No_List if no freeze actions)
function Assignment_OK
(N : Node_Id) return Boolean; -- Flag15
+ function Associated_Node
+ (N : Node_Id) return Node_Id; -- Node4
+
function At_End_Proc
(N : Node_Id) return Node_Id; -- Node1
procedure Set_Assignment_OK
(N : Node_Id; Val : Boolean := True); -- Flag15
+ procedure Set_Associated_Node
+ (N : Node_Id; Val : Node_Id); -- Node4
+
procedure Set_Attribute_Name
(N : Node_Id; Val : Name_Id); -- Name2
pragma Inline (Ancestor_Part);
pragma Inline (Array_Aggregate);
pragma Inline (Assignment_OK);
+ pragma Inline (Associated_Node);
pragma Inline (At_End_Proc);
pragma Inline (Attribute_Name);
pragma Inline (Aux_Decls_Node);
pragma Inline (Set_Ancestor_Part);
pragma Inline (Set_Array_Aggregate);
pragma Inline (Set_Assignment_OK);
+ pragma Inline (Set_Associated_Node);
pragma Inline (Set_At_End_Proc);
pragma Inline (Set_Attribute_Name);
pragma Inline (Set_Aux_Decls_Node);
projects / platform / upstream / gcc.git / commitdiff