1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ D I S P --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains routines involved in tagged types and dynamic
-- dispatching.
with Types; use Types;
package Sem_Disp is
procedure Check_Controlling_Formals (Typ : Entity_Id; Subp : Entity_Id);
-- Check that all controlling parameters of Subp are of type Typ, that
-- defaults for controlling parameters are tag-indeterminate, and that the
-- nominal subtype of the parameters and result statically match the first
-- subtype of the controlling type. Issues appropriate error messages if
-- any of these requirements is not met.
procedure Check_Dispatching_Call (N : Node_Id);
-- Check if the call N is a dispatching call. The subprogram is known to be
-- a dispatching operation. The call is dispatching if all the controlling
-- actuals are dynamically tagged. This procedure is called after overload
-- resolution, so the call is known to be unambiguous.
procedure Check_Dispatching_Operation (Subp, Old_Subp : Entity_Id);
-- Add Subp to the list of primitive operations of the corresponding type
-- if it has a parameter of this type and is defined at a proper place for
-- primitive operations (new primitives are only defined in package spec,
-- overridden operation can be defined in any scope). If Old_Subp is not
-- Empty we are in the overriding case. If the tagged type associated with
-- Subp is a concurrent type (case that occurs when the type is declared
-- in a generic because the analysis of generics disables generation of the
-- corresponding record) then this routine does not add Subp to the list of
-- primitive operations but leaves Subp decorated as dispatching operation
-- to enable checks associated with the Object.Operation notation.
procedure Check_Operation_From_Incomplete_Type
(Subp : Entity_Id;
Typ : Entity_Id);
-- If a primitive operation was defined for the incomplete view of the
-- type, and the full type declaration is a derived type definition,
-- the operation may override an inherited one.
-- Need more description here, what are the parameters, and what does
-- this call actually do???
procedure Check_Operation_From_Private_View (Subp, Old_Subp : Entity_Id);
-- Add Old_Subp to the list of primitive operations of the corresponding
-- tagged type if it is the full view of a private tagged type. The Alias
-- of Old_Subp is adjusted to point to the inherited procedure of the
-- full view because it is always this one which has to be called.
-- What is Subp used for???
function Covers_Some_Interface (Prim : Entity_Id) return Boolean;
-- Returns true if Prim covers some interface primitive of its associated
-- tagged type. The tagged type of Prim must be frozen when this function
-- is invoked.
function Find_Controlling_Arg (N : Node_Id) return Node_Id;
-- Returns the actual controlling argument if N is dynamically tagged, and
-- Empty if it is not dynamically tagged.
function Find_Dispatching_Type (Subp : Entity_Id) return Entity_Id;
-- Check whether the subprogram Subp is dispatching, and find the tagged
-- type of the controlling argument or arguments. Returns Empty if Subp
-- is not a dispatching operation.
function Find_Primitive_Covering_Interface
(Tagged_Type : Entity_Id;
Iface_Prim : Entity_Id) return Entity_Id;
-- Search the homonym chain for the primitive of Tagged_Type that covers
-- Iface_Prim. The homonym chain traversal is required to catch primitives
-- associated with the partial view of private types when processing the
-- corresponding full view. If the entity is not found, then search for it
-- in the list of primitives of Tagged_Type. This latter search is needed
-- when the interface primitive is covered by a private subprogram. If the
-- primitive has not been covered yet then return the entity that will be
-- overridden when the primitive is covered (that is, return the entity
-- whose alias attribute references the interface primitive). If none of
-- these entities is found then return Empty.
type Subprogram_List is array (Nat range <>) of Entity_Id;
-- Type returned by Inherited_Subprograms function
function Inherited_Subprograms
(S : Entity_Id;
No_Interfaces : Boolean := False;
Interfaces_Only : Boolean := False;
One_Only : Boolean := False) return Subprogram_List;
-- Given the spec of a subprogram, this function gathers any inherited
-- subprograms from direct inheritance or via interfaces. The result is an
-- array of Entity_Ids of the specs of inherited subprograms. Returns a
-- null array if passed an Empty spec id. Note that the returned array
-- only includes subprograms and generic subprograms (and excludes any
-- other inherited entities, in particular enumeration literals). If
-- No_Interfaces is True, only return inherited subprograms not coming
-- from an interface. If Interfaces_Only is True, only return inherited
-- subprograms from interfaces. Otherwise, subprograms inherited directly
-- come first, starting with the closest ancestors, and are followed by
-- subprograms inherited from interfaces. At most one of No_Interfaces
-- and Interfaces_Only should be True.
--
-- If One_Only is set, the search is discontinued as soon as one entry
-- is found. In this case the resulting array is either null or contains
-- exactly one element.
function Is_Dynamically_Tagged (N : Node_Id) return Boolean;
-- Used to determine whether a call is dispatching, i.e. if it is
-- an expression of a class_Wide type, or a call to a function with
-- controlling result where at least one operand is dynamically tagged.
-- Also used to determine whether an entity has a class-wide type, or a
-- function call that dispatches on the result. Used to verify that all the
-- dependent expressions in a conditional expression are equally tagged.
function Is_Null_Interface_Primitive (E : Entity_Id) return Boolean;
-- Returns True if E is a null procedure that is an interface primitive
function Is_Overriding_Subprogram (E : Entity_Id) return Boolean;
-- Returns True if E is an overriding subprogram
function Is_Tag_Indeterminate (N : Node_Id) return Boolean;
-- Returns true if the expression N is tag-indeterminate. An expression
-- is tag-indeterminate if it is a call that dispatches on result, and all
-- controlling operands are also indeterminate. Such a function call may
-- inherit a tag from an enclosing call.
procedure Override_Dispatching_Operation
(Tagged_Type : Entity_Id;
Prev_Op : Entity_Id;
New_Op : Entity_Id;
Is_Wrapper : Boolean := False);
-- Replace an implicit dispatching operation of the type Tagged_Type
-- with an explicit one. Prev_Op is an inherited primitive operation which
-- is overridden by the explicit declaration of New_Op. Is_Wrapper is
-- True when New_Op is an internally generated wrapper of a controlling
-- function. The caller checks that Tagged_Type is indeed a tagged type.
procedure Propagate_Tag (Control : Node_Id; Actual : Node_Id);
-- If a function call is tag-indeterminate, its controlling argument is
-- found in the context: either an enclosing call, or the left-hand side
-- of the enclosing assignment statement. The tag must be propagated
-- recursively to the tag-indeterminate actuals of the call.
-- Need clear description of the parameters Control and Actual, especially
-- since the comments above refer to actuals in the plural ???
end Sem_Disp;
|
