Warning: This file is not a C or C++ file. It does not have highlighting.
1 | //===-- include/flang/Evaluate/call.h ---------------------------*- C++ -*-===// |
---|---|
2 | // |
3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
4 | // See https://llvm.org/LICENSE.txt for license information. |
5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
6 | // |
7 | //===----------------------------------------------------------------------===// |
8 | |
9 | #ifndef FORTRAN_EVALUATE_CALL_H_ |
10 | #define FORTRAN_EVALUATE_CALL_H_ |
11 | |
12 | #include "common.h" |
13 | #include "constant.h" |
14 | #include "formatting.h" |
15 | #include "type.h" |
16 | #include "flang/Common/Fortran.h" |
17 | #include "flang/Common/indirection.h" |
18 | #include "flang/Common/reference.h" |
19 | #include "flang/Parser/char-block.h" |
20 | #include "flang/Semantics/attr.h" |
21 | #include <optional> |
22 | #include <vector> |
23 | |
24 | namespace llvm { |
25 | class raw_ostream; |
26 | } |
27 | |
28 | namespace Fortran::semantics { |
29 | class Symbol; |
30 | } |
31 | |
32 | // Mutually referential data structures are represented here with forward |
33 | // declarations of hitherto undefined class types and a level of indirection. |
34 | namespace Fortran::evaluate { |
35 | class Component; |
36 | class IntrinsicProcTable; |
37 | } // namespace Fortran::evaluate |
38 | namespace Fortran::evaluate::characteristics { |
39 | struct DummyArgument; |
40 | struct Procedure; |
41 | } // namespace Fortran::evaluate::characteristics |
42 | |
43 | extern template class Fortran::common::Indirection<Fortran::evaluate::Component, |
44 | true>; |
45 | extern template class Fortran::common::Indirection< |
46 | Fortran::evaluate::characteristics::Procedure, true>; |
47 | |
48 | namespace Fortran::evaluate { |
49 | |
50 | using semantics::Symbol; |
51 | using SymbolRef = common::Reference<const Symbol>; |
52 | |
53 | class ActualArgument { |
54 | public: |
55 | ENUM_CLASS(Attr, PassedObject, PercentVal, PercentRef); |
56 | using Attrs = common::EnumSet<Attr, Attr_enumSize>; |
57 | |
58 | // Dummy arguments that are TYPE(*) can be forwarded as actual arguments. |
59 | // Since that's the only thing one may do with them in Fortran, they're |
60 | // represented in expressions as a special case of an actual argument. |
61 | class AssumedType { |
62 | public: |
63 | explicit AssumedType(const Symbol &); |
64 | DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(AssumedType) |
65 | const Symbol &symbol() const { return symbol_; } |
66 | int Rank() const; |
67 | bool operator==(const AssumedType &that) const { |
68 | return &*symbol_ == &*that.symbol_; |
69 | } |
70 | llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; |
71 | |
72 | private: |
73 | SymbolRef symbol_; |
74 | }; |
75 | |
76 | DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(ActualArgument) |
77 | explicit ActualArgument(Expr<SomeType> &&); |
78 | explicit ActualArgument(common::CopyableIndirection<Expr<SomeType>> &&); |
79 | explicit ActualArgument(AssumedType); |
80 | explicit ActualArgument(common::Label); |
81 | ~ActualArgument(); |
82 | ActualArgument &operator=(Expr<SomeType> &&); |
83 | |
84 | Expr<SomeType> *UnwrapExpr() { |
85 | if (auto *p{ |
86 | std::get_if<common::CopyableIndirection<Expr<SomeType>>>(&u_)}) { |
87 | return &p->value(); |
88 | } else { |
89 | return nullptr; |
90 | } |
91 | } |
92 | const Expr<SomeType> *UnwrapExpr() const { |
93 | if (const auto *p{ |
94 | std::get_if<common::CopyableIndirection<Expr<SomeType>>>(&u_)}) { |
95 | return &p->value(); |
96 | } else { |
97 | return nullptr; |
98 | } |
99 | } |
100 | |
101 | const Symbol *GetAssumedTypeDummy() const { |
102 | if (const AssumedType * aType{std::get_if<AssumedType>(&u_)}) { |
103 | return &aType->symbol(); |
104 | } else { |
105 | return nullptr; |
106 | } |
107 | } |
108 | |
109 | common::Label GetLabel() const { return std::get<common::Label>(u_); } |
110 | |
111 | std::optional<DynamicType> GetType() const; |
112 | int Rank() const; |
113 | bool operator==(const ActualArgument &) const; |
114 | llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; |
115 | |
116 | std::optional<parser::CharBlock> keyword() const { return keyword_; } |
117 | ActualArgument &set_keyword(parser::CharBlock x) { |
118 | keyword_ = x; |
119 | return *this; |
120 | } |
121 | bool isAlternateReturn() const { |
122 | return std::holds_alternative<common::Label>(u_); |
123 | } |
124 | bool isPassedObject() const { return attrs_.test(Attr::PassedObject); } |
125 | ActualArgument &set_isPassedObject(bool yes = true) { |
126 | if (yes) { |
127 | attrs_ = attrs_ + Attr::PassedObject; |
128 | } else { |
129 | attrs_ = attrs_ - Attr::PassedObject; |
130 | } |
131 | return *this; |
132 | } |
133 | |
134 | bool Matches(const characteristics::DummyArgument &) const; |
135 | common::Intent dummyIntent() const { return dummyIntent_; } |
136 | ActualArgument &set_dummyIntent(common::Intent intent) { |
137 | dummyIntent_ = intent; |
138 | return *this; |
139 | } |
140 | std::optional<parser::CharBlock> sourceLocation() const { |
141 | return sourceLocation_; |
142 | } |
143 | ActualArgument &set_sourceLocation(std::optional<parser::CharBlock> at) { |
144 | sourceLocation_ = at; |
145 | return *this; |
146 | } |
147 | |
148 | // Wrap this argument in parentheses |
149 | void Parenthesize(); |
150 | |
151 | // Legacy %VAL. |
152 | bool isPercentVal() const { return attrs_.test(Attr::PercentVal); }; |
153 | ActualArgument &set_isPercentVal() { |
154 | attrs_ = attrs_ + Attr::PercentVal; |
155 | return *this; |
156 | } |
157 | // Legacy %REF. |
158 | bool isPercentRef() const { return attrs_.test(Attr::PercentRef); }; |
159 | ActualArgument &set_isPercentRef() { |
160 | attrs_ = attrs_ + Attr::PercentRef; |
161 | return *this; |
162 | } |
163 | |
164 | private: |
165 | // Subtlety: There is a distinction that must be maintained here between an |
166 | // actual argument expression that is a variable and one that is not, |
167 | // e.g. between X and (X). The parser attempts to parse each argument |
168 | // first as a variable, then as an expression, and the distinction appears |
169 | // in the parse tree. |
170 | std::variant<common::CopyableIndirection<Expr<SomeType>>, AssumedType, |
171 | common::Label> |
172 | u_; |
173 | std::optional<parser::CharBlock> keyword_; |
174 | Attrs attrs_; |
175 | common::Intent dummyIntent_{common::Intent::Default}; |
176 | std::optional<parser::CharBlock> sourceLocation_; |
177 | }; |
178 | |
179 | using ActualArguments = std::vector<std::optional<ActualArgument>>; |
180 | |
181 | // Intrinsics are identified by their names and the characteristics |
182 | // of their arguments, at least for now. |
183 | using IntrinsicProcedure = std::string; |
184 | |
185 | struct SpecificIntrinsic { |
186 | SpecificIntrinsic(IntrinsicProcedure, characteristics::Procedure &&); |
187 | DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(SpecificIntrinsic) |
188 | ~SpecificIntrinsic(); |
189 | bool operator==(const SpecificIntrinsic &) const; |
190 | llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; |
191 | |
192 | IntrinsicProcedure name; |
193 | bool isRestrictedSpecific{false}; // if true, can only call it, not pass it |
194 | common::CopyableIndirection<characteristics::Procedure> characteristics; |
195 | }; |
196 | |
197 | struct ProcedureDesignator { |
198 | EVALUATE_UNION_CLASS_BOILERPLATE(ProcedureDesignator) |
199 | explicit ProcedureDesignator(SpecificIntrinsic &&i) : u{std::move(i)} {} |
200 | explicit ProcedureDesignator(const Symbol &n) : u{n} {} |
201 | explicit ProcedureDesignator(Component &&); |
202 | |
203 | // Exactly one of these will return a non-null pointer. |
204 | const SpecificIntrinsic *GetSpecificIntrinsic() const; |
205 | const Symbol *GetSymbol() const; // symbol or component symbol |
206 | const SymbolRef *UnwrapSymbolRef() const; // null if intrinsic or component |
207 | |
208 | // For references to NOPASS components and bindings only. |
209 | // References to PASS components and bindings are represented |
210 | // with the symbol below and the base object DataRef in the |
211 | // passed-object ActualArgument. |
212 | // Always null when the procedure is intrinsic. |
213 | const Component *GetComponent() const; |
214 | |
215 | const Symbol *GetInterfaceSymbol() const; |
216 | |
217 | std::string GetName() const; |
218 | std::optional<DynamicType> GetType() const; |
219 | int Rank() const; |
220 | bool IsElemental() const; |
221 | bool IsPure() const; |
222 | std::optional<Expr<SubscriptInteger>> LEN() const; |
223 | llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; |
224 | |
225 | std::variant<SpecificIntrinsic, SymbolRef, |
226 | common::CopyableIndirection<Component>> |
227 | u; |
228 | }; |
229 | |
230 | using Chevrons = std::vector<Expr<SomeType>>; |
231 | |
232 | class ProcedureRef { |
233 | public: |
234 | CLASS_BOILERPLATE(ProcedureRef) |
235 | ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a, |
236 | bool hasAlternateReturns = false) |
237 | : proc_{std::move(p)}, arguments_{std::move(a)}, |
238 | hasAlternateReturns_{hasAlternateReturns} {} |
239 | ~ProcedureRef(); |
240 | static void Deleter(ProcedureRef *); |
241 | |
242 | ProcedureDesignator &proc() { return proc_; } |
243 | const ProcedureDesignator &proc() const { return proc_; } |
244 | ActualArguments &arguments() { return arguments_; } |
245 | const ActualArguments &arguments() const { return arguments_; } |
246 | // CALL subr <<< kernel launch >>> (...); not function |
247 | Chevrons &chevrons() { return chevrons_; } |
248 | const Chevrons &chevrons() const { return chevrons_; } |
249 | void set_chevrons(Chevrons &&chevrons) { chevrons_ = std::move(chevrons); } |
250 | |
251 | std::optional<Expr<SubscriptInteger>> LEN() const; |
252 | int Rank() const; |
253 | bool IsElemental() const { return proc_.IsElemental(); } |
254 | bool hasAlternateReturns() const { return hasAlternateReturns_; } |
255 | |
256 | Expr<SomeType> *UnwrapArgExpr(int n) { |
257 | if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) { |
258 | return arguments_[n]->UnwrapExpr(); |
259 | } else { |
260 | return nullptr; |
261 | } |
262 | } |
263 | const Expr<SomeType> *UnwrapArgExpr(int n) const { |
264 | if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) { |
265 | return arguments_[n]->UnwrapExpr(); |
266 | } else { |
267 | return nullptr; |
268 | } |
269 | } |
270 | |
271 | bool operator==(const ProcedureRef &) const; |
272 | llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; |
273 | |
274 | protected: |
275 | ProcedureDesignator proc_; |
276 | ActualArguments arguments_; |
277 | Chevrons chevrons_; |
278 | bool hasAlternateReturns_; |
279 | }; |
280 | |
281 | template <typename A> class FunctionRef : public ProcedureRef { |
282 | public: |
283 | using Result = A; |
284 | CLASS_BOILERPLATE(FunctionRef) |
285 | explicit FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {} |
286 | FunctionRef(ProcedureDesignator &&p, ActualArguments &&a) |
287 | : ProcedureRef{std::move(p), std::move(a)} {} |
288 | |
289 | std::optional<DynamicType> GetType() const { |
290 | if constexpr (IsLengthlessIntrinsicType<A>) { |
291 | return A::GetType(); |
292 | } else if (auto type{proc_.GetType()}) { |
293 | // TODO: Non constant explicit length parameters of PDTs result should |
294 | // likely be dropped too. This is not as easy as for characters since some |
295 | // long lived DerivedTypeSpec pointer would need to be created here. It is |
296 | // not clear if this is causing any issue so far since the storage size of |
297 | // PDTs is independent of length parameters. |
298 | return type->DropNonConstantCharacterLength(); |
299 | } else { |
300 | return std::nullopt; |
301 | } |
302 | } |
303 | }; |
304 | } // namespace Fortran::evaluate |
305 | #endif // FORTRAN_EVALUATE_CALL_H_ |
306 |
Warning: This file is not a C or C++ file. It does not have highlighting.