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