Warning: This file is not a C or C++ file. It does not have highlighting.
1 | //===-- include/flang/Evaluate/tools.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_TOOLS_H_ |
10 | #define FORTRAN_EVALUATE_TOOLS_H_ |
11 | |
12 | #include "traverse.h" |
13 | #include "flang/Common/idioms.h" |
14 | #include "flang/Common/template.h" |
15 | #include "flang/Common/unwrap.h" |
16 | #include "flang/Evaluate/constant.h" |
17 | #include "flang/Evaluate/expression.h" |
18 | #include "flang/Evaluate/shape.h" |
19 | #include "flang/Evaluate/type.h" |
20 | #include "flang/Parser/message.h" |
21 | #include "flang/Semantics/attr.h" |
22 | #include "flang/Semantics/scope.h" |
23 | #include "flang/Semantics/symbol.h" |
24 | #include <array> |
25 | #include <optional> |
26 | #include <set> |
27 | #include <type_traits> |
28 | #include <utility> |
29 | |
30 | namespace Fortran::evaluate { |
31 | |
32 | // Some expression predicates and extractors. |
33 | |
34 | // Predicate: true when an expression is a variable reference, not an |
35 | // operation. Be advised: a call to a function that returns an object |
36 | // pointer is a "variable" in Fortran (it can be the left-hand side of |
37 | // an assignment). |
38 | struct IsVariableHelper |
39 | : public AnyTraverse<IsVariableHelper, std::optional<bool>> { |
40 | using Result = std::optional<bool>; // effectively tri-state |
41 | using Base = AnyTraverse<IsVariableHelper, Result>; |
42 | IsVariableHelper() : Base{*this} {} |
43 | using Base::operator(); |
44 | Result operator()(const StaticDataObject &) const { return false; } |
45 | Result operator()(const Symbol &) const; |
46 | Result operator()(const Component &) const; |
47 | Result operator()(const ArrayRef &) const; |
48 | Result operator()(const Substring &) const; |
49 | Result operator()(const CoarrayRef &) const { return true; } |
50 | Result operator()(const ComplexPart &) const { return true; } |
51 | Result operator()(const ProcedureDesignator &) const; |
52 | template <typename T> Result operator()(const Expr<T> &x) const { |
53 | if constexpr (common::HasMember<T, AllIntrinsicTypes> || |
54 | std::is_same_v<T, SomeDerived>) { |
55 | // Expression with a specific type |
56 | if (std::holds_alternative<Designator<T>>(x.u) || |
57 | std::holds_alternative<FunctionRef<T>>(x.u)) { |
58 | if (auto known{(*this)(x.u)}) { |
59 | return known; |
60 | } |
61 | } |
62 | return false; |
63 | } else if constexpr (std::is_same_v<T, SomeType>) { |
64 | if (std::holds_alternative<ProcedureDesignator>(x.u) || |
65 | std::holds_alternative<ProcedureRef>(x.u)) { |
66 | return false; // procedure pointer |
67 | } else { |
68 | return (*this)(x.u); |
69 | } |
70 | } else { |
71 | return (*this)(x.u); |
72 | } |
73 | } |
74 | }; |
75 | |
76 | template <typename A> bool IsVariable(const A &x) { |
77 | if (auto known{IsVariableHelper{}(x)}) { |
78 | return *known; |
79 | } else { |
80 | return false; |
81 | } |
82 | } |
83 | |
84 | // Predicate: true when an expression is assumed-rank |
85 | bool IsAssumedRank(const Symbol &); |
86 | bool IsAssumedRank(const ActualArgument &); |
87 | template <typename A> bool IsAssumedRank(const A &) { return false; } |
88 | template <typename A> bool IsAssumedRank(const Designator<A> &designator) { |
89 | if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) { |
90 | return IsAssumedRank(symbol->get()); |
91 | } else { |
92 | return false; |
93 | } |
94 | } |
95 | template <typename T> bool IsAssumedRank(const Expr<T> &expr) { |
96 | return common::visit([](const auto &x) { return IsAssumedRank(x); }, expr.u); |
97 | } |
98 | template <typename A> bool IsAssumedRank(const std::optional<A> &x) { |
99 | return x && IsAssumedRank(*x); |
100 | } |
101 | |
102 | // Predicate: true when an expression is a coarray (corank > 0) |
103 | bool IsCoarray(const ActualArgument &); |
104 | bool IsCoarray(const Symbol &); |
105 | template <typename A> bool IsCoarray(const A &) { return false; } |
106 | template <typename A> bool IsCoarray(const Designator<A> &designator) { |
107 | if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) { |
108 | return IsCoarray(**symbol); |
109 | } |
110 | return false; |
111 | } |
112 | template <typename T> bool IsCoarray(const Expr<T> &expr) { |
113 | return common::visit([](const auto &x) { return IsCoarray(x); }, expr.u); |
114 | } |
115 | template <typename A> bool IsCoarray(const std::optional<A> &x) { |
116 | return x && IsCoarray(*x); |
117 | } |
118 | |
119 | // Generalizing packagers: these take operations and expressions of more |
120 | // specific types and wrap them in Expr<> containers of more abstract types. |
121 | |
122 | template <typename A> common::IfNoLvalue<Expr<ResultType<A>>, A> AsExpr(A &&x) { |
123 | return Expr<ResultType<A>>{std::move(x)}; |
124 | } |
125 | |
126 | template <typename T> Expr<T> AsExpr(Expr<T> &&x) { |
127 | static_assert(IsSpecificIntrinsicType<T>); |
128 | return std::move(x); |
129 | } |
130 | |
131 | template <TypeCategory CATEGORY> |
132 | Expr<SomeKind<CATEGORY>> AsCategoryExpr(Expr<SomeKind<CATEGORY>> &&x) { |
133 | return std::move(x); |
134 | } |
135 | |
136 | template <typename A> |
137 | common::IfNoLvalue<Expr<SomeType>, A> AsGenericExpr(A &&x) { |
138 | if constexpr (common::HasMember<A, TypelessExpression>) { |
139 | return Expr<SomeType>{std::move(x)}; |
140 | } else { |
141 | return Expr<SomeType>{AsCategoryExpr(std::move(x))}; |
142 | } |
143 | } |
144 | |
145 | inline Expr<SomeType> AsGenericExpr(Expr<SomeType> &&x) { return std::move(x); } |
146 | |
147 | // These overloads wrap DataRefs and simple whole variables up into |
148 | // generic expressions if they have a known type. |
149 | std::optional<Expr<SomeType>> AsGenericExpr(DataRef &&); |
150 | std::optional<Expr<SomeType>> AsGenericExpr(const Symbol &); |
151 | |
152 | // Propagate std::optional from input to output. |
153 | template <typename A> |
154 | std::optional<Expr<SomeType>> AsGenericExpr(std::optional<A> &&x) { |
155 | if (!x) |
156 | return std::nullopt; |
157 | return AsGenericExpr(std::move(*x)); |
158 | } |
159 | |
160 | template <typename A> |
161 | common::IfNoLvalue<Expr<SomeKind<ResultType<A>::category>>, A> AsCategoryExpr( |
162 | A &&x) { |
163 | return Expr<SomeKind<ResultType<A>::category>>{AsExpr(std::move(x))}; |
164 | } |
165 | |
166 | Expr<SomeType> Parenthesize(Expr<SomeType> &&); |
167 | |
168 | template <typename A> constexpr bool IsNumericCategoryExpr() { |
169 | if constexpr (common::HasMember<A, TypelessExpression>) { |
170 | return false; |
171 | } else { |
172 | return common::HasMember<ResultType<A>, NumericCategoryTypes>; |
173 | } |
174 | } |
175 | |
176 | // Specializing extractor. If an Expr wraps some type of object, perhaps |
177 | // in several layers, return a pointer to it; otherwise null. Also works |
178 | // with expressions contained in ActualArgument. |
179 | template <typename A, typename B> |
180 | auto UnwrapExpr(B &x) -> common::Constify<A, B> * { |
181 | using Ty = std::decay_t<B>; |
182 | if constexpr (std::is_same_v<A, Ty>) { |
183 | return &x; |
184 | } else if constexpr (std::is_same_v<Ty, ActualArgument>) { |
185 | if (auto *expr{x.UnwrapExpr()}) { |
186 | return UnwrapExpr<A>(*expr); |
187 | } |
188 | } else if constexpr (std::is_same_v<Ty, Expr<SomeType>>) { |
189 | return common::visit([](auto &x) { return UnwrapExpr<A>(x); }, x.u); |
190 | } else if constexpr (!common::HasMember<A, TypelessExpression>) { |
191 | if constexpr (std::is_same_v<Ty, Expr<ResultType<A>>> || |
192 | std::is_same_v<Ty, Expr<SomeKind<ResultType<A>::category>>>) { |
193 | return common::visit([](auto &x) { return UnwrapExpr<A>(x); }, x.u); |
194 | } |
195 | } |
196 | return nullptr; |
197 | } |
198 | |
199 | template <typename A, typename B> |
200 | const A *UnwrapExpr(const std::optional<B> &x) { |
201 | if (x) { |
202 | return UnwrapExpr<A>(*x); |
203 | } else { |
204 | return nullptr; |
205 | } |
206 | } |
207 | |
208 | template <typename A, typename B> A *UnwrapExpr(std::optional<B> &x) { |
209 | if (x) { |
210 | return UnwrapExpr<A>(*x); |
211 | } else { |
212 | return nullptr; |
213 | } |
214 | } |
215 | |
216 | // A variant of UnwrapExpr above that also skips through (parentheses) |
217 | // and conversions of kinds within a category. Useful for extracting LEN |
218 | // type parameter inquiries, at least. |
219 | template <typename A, typename B> |
220 | auto UnwrapConvertedExpr(B &x) -> common::Constify<A, B> * { |
221 | using Ty = std::decay_t<B>; |
222 | if constexpr (std::is_same_v<A, Ty>) { |
223 | return &x; |
224 | } else if constexpr (std::is_same_v<Ty, ActualArgument>) { |
225 | if (auto *expr{x.UnwrapExpr()}) { |
226 | return UnwrapConvertedExpr<A>(*expr); |
227 | } |
228 | } else if constexpr (std::is_same_v<Ty, Expr<SomeType>>) { |
229 | return common::visit( |
230 | [](auto &x) { return UnwrapConvertedExpr<A>(x); }, x.u); |
231 | } else { |
232 | using DesiredResult = ResultType<A>; |
233 | if constexpr (std::is_same_v<Ty, Expr<DesiredResult>> || |
234 | std::is_same_v<Ty, Expr<SomeKind<DesiredResult::category>>>) { |
235 | return common::visit( |
236 | [](auto &x) { return UnwrapConvertedExpr<A>(x); }, x.u); |
237 | } else { |
238 | using ThisResult = ResultType<B>; |
239 | if constexpr (std::is_same_v<Ty, Expr<ThisResult>>) { |
240 | return common::visit( |
241 | [](auto &x) { return UnwrapConvertedExpr<A>(x); }, x.u); |
242 | } else if constexpr (std::is_same_v<Ty, Parentheses<ThisResult>> || |
243 | std::is_same_v<Ty, Convert<ThisResult, DesiredResult::category>>) { |
244 | return common::visit( |
245 | [](auto &x) { return UnwrapConvertedExpr<A>(x); }, x.left().u); |
246 | } |
247 | } |
248 | } |
249 | return nullptr; |
250 | } |
251 | |
252 | // UnwrapProcedureRef() returns a pointer to a ProcedureRef when the whole |
253 | // expression is a reference to a procedure. |
254 | template <typename A> inline const ProcedureRef *UnwrapProcedureRef(const A &) { |
255 | return nullptr; |
256 | } |
257 | |
258 | inline const ProcedureRef *UnwrapProcedureRef(const ProcedureRef &proc) { |
259 | // Reference to subroutine or to a function that returns |
260 | // an object pointer or procedure pointer |
261 | return &proc; |
262 | } |
263 | |
264 | template <typename T> |
265 | inline const ProcedureRef *UnwrapProcedureRef(const FunctionRef<T> &func) { |
266 | return &func; // reference to a function returning a non-pointer |
267 | } |
268 | |
269 | template <typename T> |
270 | inline const ProcedureRef *UnwrapProcedureRef(const Expr<T> &expr) { |
271 | return common::visit( |
272 | [](const auto &x) { return UnwrapProcedureRef(x); }, expr.u); |
273 | } |
274 | |
275 | // When an expression is a "bare" LEN= derived type parameter inquiry, |
276 | // possibly wrapped in integer kind conversions &/or parentheses, return |
277 | // a pointer to the Symbol with TypeParamDetails. |
278 | template <typename A> const Symbol *ExtractBareLenParameter(const A &expr) { |
279 | if (const auto *typeParam{ |
280 | UnwrapConvertedExpr<evaluate::TypeParamInquiry>(expr)}) { |
281 | if (!typeParam->base()) { |
282 | const Symbol &symbol{typeParam->parameter()}; |
283 | if (const auto *tpd{symbol.detailsIf<semantics::TypeParamDetails>()}) { |
284 | if (tpd->attr() == common::TypeParamAttr::Len) { |
285 | return &symbol; |
286 | } |
287 | } |
288 | } |
289 | } |
290 | return nullptr; |
291 | } |
292 | |
293 | // If an expression simply wraps a DataRef, extract and return it. |
294 | // The Boolean arguments control the handling of Substring and ComplexPart |
295 | // references: when true (not default), it extracts the base DataRef |
296 | // of a substring or complex part. |
297 | template <typename A> |
298 | common::IfNoLvalue<std::optional<DataRef>, A> ExtractDataRef( |
299 | const A &, bool intoSubstring, bool intoComplexPart) { |
300 | return std::nullopt; // default base case |
301 | } |
302 | template <typename T> |
303 | std::optional<DataRef> ExtractDataRef(const Designator<T> &d, |
304 | bool intoSubstring = false, bool intoComplexPart = false) { |
305 | return common::visit( |
306 | [=](const auto &x) -> std::optional<DataRef> { |
307 | if constexpr (common::HasMember<decltype(x), decltype(DataRef::u)>) { |
308 | return DataRef{x}; |
309 | } |
310 | if constexpr (std::is_same_v<std::decay_t<decltype(x)>, Substring>) { |
311 | if (intoSubstring) { |
312 | return ExtractSubstringBase(x); |
313 | } |
314 | } |
315 | if constexpr (std::is_same_v<std::decay_t<decltype(x)>, ComplexPart>) { |
316 | if (intoComplexPart) { |
317 | return x.complex(); |
318 | } |
319 | } |
320 | return std::nullopt; // w/o "else" to dodge bogus g++ 8.1 warning |
321 | }, |
322 | d.u); |
323 | } |
324 | template <typename T> |
325 | std::optional<DataRef> ExtractDataRef(const Expr<T> &expr, |
326 | bool intoSubstring = false, bool intoComplexPart = false) { |
327 | return common::visit( |
328 | [=](const auto &x) { |
329 | return ExtractDataRef(x, intoSubstring, intoComplexPart); |
330 | }, |
331 | expr.u); |
332 | } |
333 | template <typename A> |
334 | std::optional<DataRef> ExtractDataRef(const std::optional<A> &x, |
335 | bool intoSubstring = false, bool intoComplexPart = false) { |
336 | if (x) { |
337 | return ExtractDataRef(*x, intoSubstring, intoComplexPart); |
338 | } else { |
339 | return std::nullopt; |
340 | } |
341 | } |
342 | template <typename A> |
343 | std::optional<DataRef> ExtractDataRef( |
344 | A *p, bool intoSubstring = false, bool intoComplexPart = false) { |
345 | if (p) { |
346 | return ExtractDataRef(std::as_const(*p), intoSubstring, intoComplexPart); |
347 | } else { |
348 | return std::nullopt; |
349 | } |
350 | } |
351 | std::optional<DataRef> ExtractDataRef(const ActualArgument &, |
352 | bool intoSubstring = false, bool intoComplexPart = false); |
353 | |
354 | std::optional<DataRef> ExtractSubstringBase(const Substring &); |
355 | |
356 | // Predicate: is an expression is an array element reference? |
357 | template <typename T> |
358 | bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = true, |
359 | bool skipComponents = false) { |
360 | if (auto dataRef{ExtractDataRef(expr, intoSubstring)}) { |
361 | const DataRef *ref{&*dataRef}; |
362 | if (skipComponents) { |
363 | while (const Component * component{std::get_if<Component>(&ref->u)}) { |
364 | ref = &component->base(); |
365 | } |
366 | } |
367 | if (const auto *coarrayRef{std::get_if<CoarrayRef>(&ref->u)}) { |
368 | return !coarrayRef->subscript().empty(); |
369 | } else { |
370 | return std::holds_alternative<ArrayRef>(ref->u); |
371 | } |
372 | } else { |
373 | return false; |
374 | } |
375 | } |
376 | |
377 | template <typename A> |
378 | std::optional<NamedEntity> ExtractNamedEntity(const A &x) { |
379 | if (auto dataRef{ExtractDataRef(x)}) { |
380 | return common::visit( |
381 | common::visitors{ |
382 | [](SymbolRef &&symbol) -> std::optional<NamedEntity> { |
383 | return NamedEntity{symbol}; |
384 | }, |
385 | [](Component &&component) -> std::optional<NamedEntity> { |
386 | return NamedEntity{std::move(component)}; |
387 | }, |
388 | [](CoarrayRef &&co) -> std::optional<NamedEntity> { |
389 | return co.GetBase(); |
390 | }, |
391 | [](auto &&) { return std::optional<NamedEntity>{}; }, |
392 | }, |
393 | std::move(dataRef->u)); |
394 | } else { |
395 | return std::nullopt; |
396 | } |
397 | } |
398 | |
399 | struct ExtractCoindexedObjectHelper { |
400 | template <typename A> std::optional<CoarrayRef> operator()(const A &) const { |
401 | return std::nullopt; |
402 | } |
403 | std::optional<CoarrayRef> operator()(const CoarrayRef &x) const { return x; } |
404 | template <typename A> |
405 | std::optional<CoarrayRef> operator()(const Expr<A> &expr) const { |
406 | return common::visit(*this, expr.u); |
407 | } |
408 | std::optional<CoarrayRef> operator()(const DataRef &dataRef) const { |
409 | return common::visit(*this, dataRef.u); |
410 | } |
411 | std::optional<CoarrayRef> operator()(const NamedEntity &named) const { |
412 | if (const Component * component{named.UnwrapComponent()}) { |
413 | return (*this)(*component); |
414 | } else { |
415 | return std::nullopt; |
416 | } |
417 | } |
418 | std::optional<CoarrayRef> operator()(const ProcedureDesignator &des) const { |
419 | if (const auto *component{ |
420 | std::get_if<common::CopyableIndirection<Component>>(&des.u)}) { |
421 | return (*this)(component->value()); |
422 | } else { |
423 | return std::nullopt; |
424 | } |
425 | } |
426 | std::optional<CoarrayRef> operator()(const Component &component) const { |
427 | return (*this)(component.base()); |
428 | } |
429 | std::optional<CoarrayRef> operator()(const ArrayRef &arrayRef) const { |
430 | return (*this)(arrayRef.base()); |
431 | } |
432 | }; |
433 | |
434 | template <typename A> std::optional<CoarrayRef> ExtractCoarrayRef(const A &x) { |
435 | if (auto dataRef{ExtractDataRef(x, true)}) { |
436 | return ExtractCoindexedObjectHelper{}(*dataRef); |
437 | } else { |
438 | return ExtractCoindexedObjectHelper{}(x); |
439 | } |
440 | } |
441 | |
442 | struct ExtractSubstringHelper { |
443 | template <typename T> static std::optional<Substring> visit(T &&) { |
444 | return std::nullopt; |
445 | } |
446 | |
447 | static std::optional<Substring> visit(const Substring &e) { return e; } |
448 | |
449 | template <typename T> |
450 | static std::optional<Substring> visit(const Designator<T> &e) { |
451 | return std::visit([](auto &&s) { return visit(s); }, e.u); |
452 | } |
453 | |
454 | template <typename T> |
455 | static std::optional<Substring> visit(const Expr<T> &e) { |
456 | return std::visit([](auto &&s) { return visit(s); }, e.u); |
457 | } |
458 | }; |
459 | |
460 | template <typename A> std::optional<Substring> ExtractSubstring(const A &x) { |
461 | return ExtractSubstringHelper::visit(x); |
462 | } |
463 | |
464 | // If an expression is simply a whole symbol data designator, |
465 | // extract and return that symbol, else null. |
466 | template <typename A> const Symbol *UnwrapWholeSymbolDataRef(const A &x) { |
467 | if (auto dataRef{ExtractDataRef(x)}) { |
468 | if (const SymbolRef * p{std::get_if<SymbolRef>(&dataRef->u)}) { |
469 | return &p->get(); |
470 | } |
471 | } |
472 | return nullptr; |
473 | } |
474 | |
475 | // If an expression is a whole symbol or a whole component desginator, |
476 | // extract and return that symbol, else null. |
477 | template <typename A> |
478 | const Symbol *UnwrapWholeSymbolOrComponentDataRef(const A &x) { |
479 | if (auto dataRef{ExtractDataRef(x)}) { |
480 | if (const SymbolRef * p{std::get_if<SymbolRef>(&dataRef->u)}) { |
481 | return &p->get(); |
482 | } else if (const Component * c{std::get_if<Component>(&dataRef->u)}) { |
483 | if (c->base().Rank() == 0) { |
484 | return &c->GetLastSymbol(); |
485 | } |
486 | } |
487 | } |
488 | return nullptr; |
489 | } |
490 | |
491 | // If an expression is a whole symbol or a whole component designator, |
492 | // potentially followed by an image selector, extract and return that symbol, |
493 | // else null. |
494 | template <typename A> |
495 | const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(const A &x) { |
496 | if (auto dataRef{ExtractDataRef(x)}) { |
497 | if (const SymbolRef * p{std::get_if<SymbolRef>(&dataRef->u)}) { |
498 | return &p->get(); |
499 | } else if (const Component * c{std::get_if<Component>(&dataRef->u)}) { |
500 | if (c->base().Rank() == 0) { |
501 | return &c->GetLastSymbol(); |
502 | } |
503 | } else if (const CoarrayRef * c{std::get_if<CoarrayRef>(&dataRef->u)}) { |
504 | if (c->subscript().empty()) { |
505 | return &c->GetLastSymbol(); |
506 | } |
507 | } |
508 | } |
509 | return nullptr; |
510 | } |
511 | |
512 | // GetFirstSymbol(A%B%C[I]%D) -> A |
513 | template <typename A> const Symbol *GetFirstSymbol(const A &x) { |
514 | if (auto dataRef{ExtractDataRef(x, true)}) { |
515 | return &dataRef->GetFirstSymbol(); |
516 | } else { |
517 | return nullptr; |
518 | } |
519 | } |
520 | |
521 | // GetLastPointerSymbol(A%PTR1%B%PTR2%C) -> PTR2 |
522 | const Symbol *GetLastPointerSymbol(const evaluate::DataRef &); |
523 | |
524 | // Creation of conversion expressions can be done to either a known |
525 | // specific intrinsic type with ConvertToType<T>(x) or by converting |
526 | // one arbitrary expression to the type of another with ConvertTo(to, from). |
527 | |
528 | template <typename TO, TypeCategory FROMCAT> |
529 | Expr<TO> ConvertToType(Expr<SomeKind<FROMCAT>> &&x) { |
530 | static_assert(IsSpecificIntrinsicType<TO>); |
531 | if constexpr (FROMCAT == TO::category) { |
532 | if (auto *already{std::get_if<Expr<TO>>(&x.u)}) { |
533 | return std::move(*already); |
534 | } else { |
535 | return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}}; |
536 | } |
537 | } else if constexpr (TO::category == TypeCategory::Complex) { |
538 | using Part = typename TO::Part; |
539 | Scalar<Part> zero; |
540 | return Expr<TO>{ComplexConstructor<TO::kind>{ |
541 | ConvertToType<Part>(std::move(x)), Expr<Part>{Constant<Part>{zero}}}}; |
542 | } else if constexpr (FROMCAT == TypeCategory::Complex) { |
543 | // Extract and convert the real component of a complex value |
544 | return common::visit( |
545 | [&](auto &&z) { |
546 | using ZType = ResultType<decltype(z)>; |
547 | using Part = typename ZType::Part; |
548 | return ConvertToType<TO, TypeCategory::Real>(Expr<SomeReal>{ |
549 | Expr<Part>{ComplexComponent<Part::kind>{false, std::move(z)}}}); |
550 | }, |
551 | std::move(x.u)); |
552 | } else { |
553 | return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}}; |
554 | } |
555 | } |
556 | |
557 | template <typename TO, TypeCategory FROMCAT, int FROMKIND> |
558 | Expr<TO> ConvertToType(Expr<Type<FROMCAT, FROMKIND>> &&x) { |
559 | return ConvertToType<TO, FROMCAT>(Expr<SomeKind<FROMCAT>>{std::move(x)}); |
560 | } |
561 | |
562 | template <typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) { |
563 | static_assert(IsSpecificIntrinsicType<TO>); |
564 | if constexpr (TO::category == TypeCategory::Integer) { |
565 | return Expr<TO>{ |
566 | Constant<TO>{Scalar<TO>::ConvertUnsigned(std::move(x)).value}}; |
567 | } else { |
568 | static_assert(TO::category == TypeCategory::Real); |
569 | using Word = typename Scalar<TO>::Word; |
570 | return Expr<TO>{ |
571 | Constant<TO>{Scalar<TO>{Word::ConvertUnsigned(std::move(x)).value}}}; |
572 | } |
573 | } |
574 | |
575 | template <typename T> bool IsBOZLiteral(const Expr<T> &expr) { |
576 | return std::holds_alternative<BOZLiteralConstant>(expr.u); |
577 | } |
578 | |
579 | // Conversions to dynamic types |
580 | std::optional<Expr<SomeType>> ConvertToType( |
581 | const DynamicType &, Expr<SomeType> &&); |
582 | std::optional<Expr<SomeType>> ConvertToType( |
583 | const DynamicType &, std::optional<Expr<SomeType>> &&); |
584 | std::optional<Expr<SomeType>> ConvertToType(const Symbol &, Expr<SomeType> &&); |
585 | std::optional<Expr<SomeType>> ConvertToType( |
586 | const Symbol &, std::optional<Expr<SomeType>> &&); |
587 | |
588 | // Conversions to the type of another expression |
589 | template <TypeCategory TC, int TK, typename FROM> |
590 | common::IfNoLvalue<Expr<Type<TC, TK>>, FROM> ConvertTo( |
591 | const Expr<Type<TC, TK>> &, FROM &&x) { |
592 | return ConvertToType<Type<TC, TK>>(std::move(x)); |
593 | } |
594 | |
595 | template <TypeCategory TC, typename FROM> |
596 | common::IfNoLvalue<Expr<SomeKind<TC>>, FROM> ConvertTo( |
597 | const Expr<SomeKind<TC>> &to, FROM &&from) { |
598 | return common::visit( |
599 | [&](const auto &toKindExpr) { |
600 | using KindExpr = std::decay_t<decltype(toKindExpr)>; |
601 | return AsCategoryExpr( |
602 | ConvertToType<ResultType<KindExpr>>(std::move(from))); |
603 | }, |
604 | to.u); |
605 | } |
606 | |
607 | template <typename FROM> |
608 | common::IfNoLvalue<Expr<SomeType>, FROM> ConvertTo( |
609 | const Expr<SomeType> &to, FROM &&from) { |
610 | return common::visit( |
611 | [&](const auto &toCatExpr) { |
612 | return AsGenericExpr(ConvertTo(toCatExpr, std::move(from))); |
613 | }, |
614 | to.u); |
615 | } |
616 | |
617 | // Convert an expression of some known category to a dynamically chosen |
618 | // kind of some category (usually but not necessarily distinct). |
619 | template <TypeCategory TOCAT, typename VALUE> struct ConvertToKindHelper { |
620 | using Result = std::optional<Expr<SomeKind<TOCAT>>>; |
621 | using Types = CategoryTypes<TOCAT>; |
622 | ConvertToKindHelper(int k, VALUE &&x) : kind{k}, value{std::move(x)} {} |
623 | template <typename T> Result Test() { |
624 | if (kind == T::kind) { |
625 | return std::make_optional( |
626 | AsCategoryExpr(ConvertToType<T>(std::move(value)))); |
627 | } |
628 | return std::nullopt; |
629 | } |
630 | int kind; |
631 | VALUE value; |
632 | }; |
633 | |
634 | template <TypeCategory TOCAT, typename VALUE> |
635 | common::IfNoLvalue<Expr<SomeKind<TOCAT>>, VALUE> ConvertToKind( |
636 | int kind, VALUE &&x) { |
637 | auto result{common::SearchTypes( |
638 | ConvertToKindHelper<TOCAT, VALUE>{kind, std::move(x)})}; |
639 | CHECK(result.has_value()); |
640 | return *result; |
641 | } |
642 | |
643 | // Given a type category CAT, SameKindExprs<CAT, N> is a variant that |
644 | // holds an arrays of expressions of the same supported kind in that |
645 | // category. |
646 | template <typename A, int N = 2> using SameExprs = std::array<Expr<A>, N>; |
647 | template <int N = 2> struct SameKindExprsHelper { |
648 | template <typename A> using SameExprs = std::array<Expr<A>, N>; |
649 | }; |
650 | template <TypeCategory CAT, int N = 2> |
651 | using SameKindExprs = |
652 | common::MapTemplate<SameKindExprsHelper<N>::template SameExprs, |
653 | CategoryTypes<CAT>>; |
654 | |
655 | // Given references to two expressions of arbitrary kind in the same type |
656 | // category, convert one to the kind of the other when it has the smaller kind, |
657 | // then return them in a type-safe package. |
658 | template <TypeCategory CAT> |
659 | SameKindExprs<CAT, 2> AsSameKindExprs( |
660 | Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) { |
661 | return common::visit( |
662 | [&](auto &&kx, auto &&ky) -> SameKindExprs<CAT, 2> { |
663 | using XTy = ResultType<decltype(kx)>; |
664 | using YTy = ResultType<decltype(ky)>; |
665 | if constexpr (std::is_same_v<XTy, YTy>) { |
666 | return {SameExprs<XTy>{std::move(kx), std::move(ky)}}; |
667 | } else if constexpr (XTy::kind < YTy::kind) { |
668 | return {SameExprs<YTy>{ConvertTo(ky, std::move(kx)), std::move(ky)}}; |
669 | } else { |
670 | return {SameExprs<XTy>{std::move(kx), ConvertTo(kx, std::move(ky))}}; |
671 | } |
672 | #if !__clang__ && 100 * __GNUC__ + __GNUC_MINOR__ == 801 |
673 | // Silence a bogus warning about a missing return with G++ 8.1.0. |
674 | // Doesn't execute, but must be correctly typed. |
675 | CHECK(!"can't happen"); |
676 | return {SameExprs<XTy>{std::move(kx), std::move(kx)}}; |
677 | #endif |
678 | }, |
679 | std::move(x.u), std::move(y.u)); |
680 | } |
681 | |
682 | // Ensure that both operands of an intrinsic REAL operation (or CMPLX() |
683 | // constructor) are INTEGER or REAL, then convert them as necessary to the |
684 | // same kind of REAL. |
685 | using ConvertRealOperandsResult = |
686 | std::optional<SameKindExprs<TypeCategory::Real, 2>>; |
687 | ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &, |
688 | Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind); |
689 | |
690 | // Per F'2018 R718, if both components are INTEGER, they are both converted |
691 | // to default REAL and the result is default COMPLEX. Otherwise, the |
692 | // kind of the result is the kind of most precise REAL component, and the other |
693 | // component is converted if necessary to its type. |
694 | std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &, |
695 | Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind); |
696 | std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &, |
697 | std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&, |
698 | int defaultRealKind); |
699 | |
700 | template <typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) { |
701 | using Ty = TypeOf<A>; |
702 | static_assert( |
703 | std::is_same_v<Scalar<Ty>, std::decay_t<A>>, "TypeOf<> is broken"); |
704 | return Expr<TypeOf<A>>{Constant<Ty>{x}}; |
705 | } |
706 | |
707 | // Combine two expressions of the same specific numeric type with an operation |
708 | // to produce a new expression. |
709 | template <template <typename> class OPR, typename SPECIFIC> |
710 | Expr<SPECIFIC> Combine(Expr<SPECIFIC> &&x, Expr<SPECIFIC> &&y) { |
711 | static_assert(IsSpecificIntrinsicType<SPECIFIC>); |
712 | return AsExpr(OPR<SPECIFIC>{std::move(x), std::move(y)}); |
713 | } |
714 | |
715 | // Given two expressions of arbitrary kind in the same intrinsic type |
716 | // category, convert one of them if necessary to the larger kind of the |
717 | // other, then combine the resulting homogenized operands with a given |
718 | // operation, returning a new expression in the same type category. |
719 | template <template <typename> class OPR, TypeCategory CAT> |
720 | Expr<SomeKind<CAT>> PromoteAndCombine( |
721 | Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) { |
722 | return common::visit( |
723 | [](auto &&xy) { |
724 | using Ty = ResultType<decltype(xy[0])>; |
725 | return AsCategoryExpr( |
726 | Combine<OPR, Ty>(std::move(xy[0]), std::move(xy[1]))); |
727 | }, |
728 | AsSameKindExprs(std::move(x), std::move(y))); |
729 | } |
730 | |
731 | // Given two expressions of arbitrary type, try to combine them with a |
732 | // binary numeric operation (e.g., Add), possibly with data type conversion of |
733 | // one of the operands to the type of the other. Handles special cases with |
734 | // typeless literal operands and with REAL/COMPLEX exponentiation to INTEGER |
735 | // powers. |
736 | template <template <typename> class OPR> |
737 | std::optional<Expr<SomeType>> NumericOperation(parser::ContextualMessages &, |
738 | Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind); |
739 | |
740 | extern template std::optional<Expr<SomeType>> NumericOperation<Power>( |
741 | parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&, |
742 | int defaultRealKind); |
743 | extern template std::optional<Expr<SomeType>> NumericOperation<Multiply>( |
744 | parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&, |
745 | int defaultRealKind); |
746 | extern template std::optional<Expr<SomeType>> NumericOperation<Divide>( |
747 | parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&, |
748 | int defaultRealKind); |
749 | extern template std::optional<Expr<SomeType>> NumericOperation<Add>( |
750 | parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&, |
751 | int defaultRealKind); |
752 | extern template std::optional<Expr<SomeType>> NumericOperation<Subtract>( |
753 | parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&, |
754 | int defaultRealKind); |
755 | |
756 | std::optional<Expr<SomeType>> Negation( |
757 | parser::ContextualMessages &, Expr<SomeType> &&); |
758 | |
759 | // Given two expressions of arbitrary type, try to combine them with a |
760 | // relational operator (e.g., .LT.), possibly with data type conversion. |
761 | std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &, |
762 | RelationalOperator, Expr<SomeType> &&, Expr<SomeType> &&); |
763 | |
764 | // Create a relational operation between two identically-typed operands |
765 | // and wrap it up in an Expr<LogicalResult>. |
766 | template <typename T> |
767 | Expr<LogicalResult> PackageRelation( |
768 | RelationalOperator opr, Expr<T> &&x, Expr<T> &&y) { |
769 | static_assert(IsSpecificIntrinsicType<T>); |
770 | return Expr<LogicalResult>{ |
771 | Relational<SomeType>{Relational<T>{opr, std::move(x), std::move(y)}}}; |
772 | } |
773 | |
774 | template <int K> |
775 | Expr<Type<TypeCategory::Logical, K>> LogicalNegation( |
776 | Expr<Type<TypeCategory::Logical, K>> &&x) { |
777 | return AsExpr(Not<K>{std::move(x)}); |
778 | } |
779 | |
780 | Expr<SomeLogical> LogicalNegation(Expr<SomeLogical> &&); |
781 | |
782 | template <int K> |
783 | Expr<Type<TypeCategory::Logical, K>> BinaryLogicalOperation(LogicalOperator opr, |
784 | Expr<Type<TypeCategory::Logical, K>> &&x, |
785 | Expr<Type<TypeCategory::Logical, K>> &&y) { |
786 | return AsExpr(LogicalOperation<K>{opr, std::move(x), std::move(y)}); |
787 | } |
788 | |
789 | Expr<SomeLogical> BinaryLogicalOperation( |
790 | LogicalOperator, Expr<SomeLogical> &&, Expr<SomeLogical> &&); |
791 | |
792 | // Convenience functions and operator overloadings for expression construction. |
793 | // These interfaces are defined only for those situations that can never |
794 | // emit any message. Use the more general templates (above) in other |
795 | // situations. |
796 | |
797 | template <TypeCategory C, int K> |
798 | Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x) { |
799 | return AsExpr(Negate<Type<C, K>>{std::move(x)}); |
800 | } |
801 | |
802 | template <TypeCategory C, int K> |
803 | Expr<Type<C, K>> operator+(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) { |
804 | return AsExpr(Combine<Add, Type<C, K>>(std::move(x), std::move(y))); |
805 | } |
806 | |
807 | template <TypeCategory C, int K> |
808 | Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) { |
809 | return AsExpr(Combine<Subtract, Type<C, K>>(std::move(x), std::move(y))); |
810 | } |
811 | |
812 | template <TypeCategory C, int K> |
813 | Expr<Type<C, K>> operator*(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) { |
814 | return AsExpr(Combine<Multiply, Type<C, K>>(std::move(x), std::move(y))); |
815 | } |
816 | |
817 | template <TypeCategory C, int K> |
818 | Expr<Type<C, K>> operator/(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) { |
819 | return AsExpr(Combine<Divide, Type<C, K>>(std::move(x), std::move(y))); |
820 | } |
821 | |
822 | template <TypeCategory C> Expr<SomeKind<C>> operator-(Expr<SomeKind<C>> &&x) { |
823 | return common::visit( |
824 | [](auto &xk) { return Expr<SomeKind<C>>{-std::move(xk)}; }, x.u); |
825 | } |
826 | |
827 | template <TypeCategory CAT> |
828 | Expr<SomeKind<CAT>> operator+( |
829 | Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) { |
830 | return PromoteAndCombine<Add, CAT>(std::move(x), std::move(y)); |
831 | } |
832 | |
833 | template <TypeCategory CAT> |
834 | Expr<SomeKind<CAT>> operator-( |
835 | Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) { |
836 | return PromoteAndCombine<Subtract, CAT>(std::move(x), std::move(y)); |
837 | } |
838 | |
839 | template <TypeCategory CAT> |
840 | Expr<SomeKind<CAT>> operator*( |
841 | Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) { |
842 | return PromoteAndCombine<Multiply, CAT>(std::move(x), std::move(y)); |
843 | } |
844 | |
845 | template <TypeCategory CAT> |
846 | Expr<SomeKind<CAT>> operator/( |
847 | Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) { |
848 | return PromoteAndCombine<Divide, CAT>(std::move(x), std::move(y)); |
849 | } |
850 | |
851 | // A utility for use with common::SearchTypes to create generic expressions |
852 | // when an intrinsic type category for (say) a variable is known |
853 | // but the kind parameter value is not. |
854 | template <TypeCategory CAT, template <typename> class TEMPLATE, typename VALUE> |
855 | struct TypeKindVisitor { |
856 | using Result = std::optional<Expr<SomeType>>; |
857 | using Types = CategoryTypes<CAT>; |
858 | |
859 | TypeKindVisitor(int k, VALUE &&x) : kind{k}, value{std::move(x)} {} |
860 | TypeKindVisitor(int k, const VALUE &x) : kind{k}, value{x} {} |
861 | |
862 | template <typename T> Result Test() { |
863 | if (kind == T::kind) { |
864 | return AsGenericExpr(TEMPLATE<T>{std::move(value)}); |
865 | } |
866 | return std::nullopt; |
867 | } |
868 | |
869 | int kind; |
870 | VALUE value; |
871 | }; |
872 | |
873 | // TypedWrapper() wraps a object in an explicitly typed representation |
874 | // (e.g., Designator<> or FunctionRef<>) that has been instantiated on |
875 | // a dynamically chosen Fortran type. |
876 | template <TypeCategory CATEGORY, template <typename> typename WRAPPER, |
877 | typename WRAPPED> |
878 | common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> WrapperHelper( |
879 | int kind, WRAPPED &&x) { |
880 | return common::SearchTypes( |
881 | TypeKindVisitor<CATEGORY, WRAPPER, WRAPPED>{kind, std::move(x)}); |
882 | } |
883 | |
884 | template <template <typename> typename WRAPPER, typename WRAPPED> |
885 | common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> TypedWrapper( |
886 | const DynamicType &dyType, WRAPPED &&x) { |
887 | switch (dyType.category()) { |
888 | SWITCH_COVERS_ALL_CASES |
889 | case TypeCategory::Integer: |
890 | return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>( |
891 | dyType.kind(), std::move(x)); |
892 | case TypeCategory::Real: |
893 | return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>( |
894 | dyType.kind(), std::move(x)); |
895 | case TypeCategory::Complex: |
896 | return WrapperHelper<TypeCategory::Complex, WRAPPER, WRAPPED>( |
897 | dyType.kind(), std::move(x)); |
898 | case TypeCategory::Character: |
899 | return WrapperHelper<TypeCategory::Character, WRAPPER, WRAPPED>( |
900 | dyType.kind(), std::move(x)); |
901 | case TypeCategory::Logical: |
902 | return WrapperHelper<TypeCategory::Logical, WRAPPER, WRAPPED>( |
903 | dyType.kind(), std::move(x)); |
904 | case TypeCategory::Derived: |
905 | return AsGenericExpr(Expr<SomeDerived>{WRAPPER<SomeDerived>{std::move(x)}}); |
906 | } |
907 | } |
908 | |
909 | // GetLastSymbol() returns the rightmost symbol in an object or procedure |
910 | // designator (which has perhaps been wrapped in an Expr<>), or a null pointer |
911 | // when none is found. It will return an ASSOCIATE construct entity's symbol |
912 | // rather than descending into its expression. |
913 | struct GetLastSymbolHelper |
914 | : public AnyTraverse<GetLastSymbolHelper, std::optional<const Symbol *>> { |
915 | using Result = std::optional<const Symbol *>; |
916 | using Base = AnyTraverse<GetLastSymbolHelper, Result>; |
917 | GetLastSymbolHelper() : Base{*this} {} |
918 | using Base::operator(); |
919 | Result operator()(const Symbol &x) const { return &x; } |
920 | Result operator()(const Component &x) const { return &x.GetLastSymbol(); } |
921 | Result operator()(const NamedEntity &x) const { return &x.GetLastSymbol(); } |
922 | Result operator()(const ProcedureDesignator &x) const { |
923 | return x.GetSymbol(); |
924 | } |
925 | template <typename T> Result operator()(const Expr<T> &x) const { |
926 | if constexpr (common::HasMember<T, AllIntrinsicTypes> || |
927 | std::is_same_v<T, SomeDerived>) { |
928 | if (const auto *designator{std::get_if<Designator<T>>(&x.u)}) { |
929 | if (auto known{(*this)(*designator)}) { |
930 | return known; |
931 | } |
932 | } |
933 | return nullptr; |
934 | } else { |
935 | return (*this)(x.u); |
936 | } |
937 | } |
938 | }; |
939 | |
940 | template <typename A> const Symbol *GetLastSymbol(const A &x) { |
941 | if (auto known{GetLastSymbolHelper{}(x)}) { |
942 | return *known; |
943 | } else { |
944 | return nullptr; |
945 | } |
946 | } |
947 | |
948 | // For everyday variables: if GetLastSymbol() succeeds on the argument, return |
949 | // its set of attributes, otherwise the empty set. Also works on variables that |
950 | // are pointer results of functions. |
951 | template <typename A> semantics::Attrs GetAttrs(const A &x) { |
952 | if (const Symbol * symbol{GetLastSymbol(x)}) { |
953 | return symbol->attrs(); |
954 | } else { |
955 | return {}; |
956 | } |
957 | } |
958 | |
959 | template <> |
960 | inline semantics::Attrs GetAttrs<Expr<SomeType>>(const Expr<SomeType> &x) { |
961 | if (IsVariable(x)) { |
962 | if (const auto *procRef{UnwrapProcedureRef(x)}) { |
963 | if (const Symbol * interface{procRef->proc().GetInterfaceSymbol()}) { |
964 | if (const auto *details{ |
965 | interface->detailsIf<semantics::SubprogramDetails>()}) { |
966 | if (details->isFunction() && |
967 | details->result().attrs().test(semantics::Attr::POINTER)) { |
968 | // N.B.: POINTER becomes TARGET in SetAttrsFromAssociation() |
969 | return details->result().attrs(); |
970 | } |
971 | } |
972 | } |
973 | } |
974 | } |
975 | if (const Symbol * symbol{GetLastSymbol(x)}) { |
976 | return symbol->attrs(); |
977 | } else { |
978 | return {}; |
979 | } |
980 | } |
981 | |
982 | template <typename A> semantics::Attrs GetAttrs(const std::optional<A> &x) { |
983 | if (x) { |
984 | return GetAttrs(*x); |
985 | } else { |
986 | return {}; |
987 | } |
988 | } |
989 | |
990 | // GetBaseObject() |
991 | template <typename A> std::optional<BaseObject> GetBaseObject(const A &) { |
992 | return std::nullopt; |
993 | } |
994 | template <typename T> |
995 | std::optional<BaseObject> GetBaseObject(const Designator<T> &x) { |
996 | return x.GetBaseObject(); |
997 | } |
998 | template <typename T> |
999 | std::optional<BaseObject> GetBaseObject(const Expr<T> &x) { |
1000 | return common::visit([](const auto &y) { return GetBaseObject(y); }, x.u); |
1001 | } |
1002 | template <typename A> |
1003 | std::optional<BaseObject> GetBaseObject(const std::optional<A> &x) { |
1004 | if (x) { |
1005 | return GetBaseObject(*x); |
1006 | } else { |
1007 | return std::nullopt; |
1008 | } |
1009 | } |
1010 | |
1011 | // Like IsAllocatableOrPointer, but accepts pointer function results as being |
1012 | // pointers too. |
1013 | bool IsAllocatableOrPointerObject(const Expr<SomeType> &); |
1014 | |
1015 | bool IsAllocatableDesignator(const Expr<SomeType> &); |
1016 | |
1017 | // Procedure and pointer detection predicates |
1018 | bool IsProcedure(const Expr<SomeType> &); |
1019 | bool IsFunction(const Expr<SomeType> &); |
1020 | bool IsPointer(const Expr<SomeType> &); |
1021 | bool IsProcedurePointer(const Expr<SomeType> &); |
1022 | bool IsProcedurePointerTarget(const Expr<SomeType> &); |
1023 | bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type |
1024 | bool IsNullObjectPointer(const Expr<SomeType> &); |
1025 | bool IsNullProcedurePointer(const Expr<SomeType> &); |
1026 | bool IsNullPointer(const Expr<SomeType> &); |
1027 | bool IsObjectPointer(const Expr<SomeType> &); |
1028 | |
1029 | // Can Expr be passed as absent to an optional dummy argument. |
1030 | // See 15.5.2.12 point 1 for more details. |
1031 | bool MayBePassedAsAbsentOptional(const Expr<SomeType> &); |
1032 | |
1033 | // Extracts the chain of symbols from a designator, which has perhaps been |
1034 | // wrapped in an Expr<>, removing all of the (co)subscripts. The |
1035 | // base object will be the first symbol in the result vector. |
1036 | struct GetSymbolVectorHelper |
1037 | : public Traverse<GetSymbolVectorHelper, SymbolVector> { |
1038 | using Result = SymbolVector; |
1039 | using Base = Traverse<GetSymbolVectorHelper, Result>; |
1040 | using Base::operator(); |
1041 | GetSymbolVectorHelper() : Base{*this} {} |
1042 | Result Default() { return {}; } |
1043 | Result Combine(Result &&a, Result &&b) { |
1044 | a.insert(a.end(), b.begin(), b.end()); |
1045 | return std::move(a); |
1046 | } |
1047 | Result operator()(const Symbol &) const; |
1048 | Result operator()(const Component &) const; |
1049 | Result operator()(const ArrayRef &) const; |
1050 | Result operator()(const CoarrayRef &) const; |
1051 | }; |
1052 | template <typename A> SymbolVector GetSymbolVector(const A &x) { |
1053 | return GetSymbolVectorHelper{}(x); |
1054 | } |
1055 | |
1056 | // GetLastTarget() returns the rightmost symbol in an object designator's |
1057 | // SymbolVector that has the POINTER or TARGET attribute, or a null pointer |
1058 | // when none is found. |
1059 | const Symbol *GetLastTarget(const SymbolVector &); |
1060 | |
1061 | // Collects all of the Symbols in an expression |
1062 | template <typename A> semantics::UnorderedSymbolSet CollectSymbols(const A &); |
1063 | extern template semantics::UnorderedSymbolSet CollectSymbols( |
1064 | const Expr<SomeType> &); |
1065 | extern template semantics::UnorderedSymbolSet CollectSymbols( |
1066 | const Expr<SomeInteger> &); |
1067 | extern template semantics::UnorderedSymbolSet CollectSymbols( |
1068 | const Expr<SubscriptInteger> &); |
1069 | |
1070 | // Predicate: does a variable contain a vector-valued subscript (not a triplet)? |
1071 | bool HasVectorSubscript(const Expr<SomeType> &); |
1072 | |
1073 | // Utilities for attaching the location of the declaration of a symbol |
1074 | // of interest to a message, if both pointers are non-null. Handles |
1075 | // the case of USE association gracefully. |
1076 | parser::Message *AttachDeclaration(parser::Message &, const Symbol &); |
1077 | parser::Message *AttachDeclaration(parser::Message *, const Symbol &); |
1078 | template <typename MESSAGES, typename... A> |
1079 | parser::Message *SayWithDeclaration( |
1080 | MESSAGES &messages, const Symbol &symbol, A &&...x) { |
1081 | return AttachDeclaration(messages.Say(std::forward<A>(x)...), symbol); |
1082 | } |
1083 | |
1084 | // Check for references to impure procedures; returns the name |
1085 | // of one to complain about, if any exist. |
1086 | std::optional<std::string> FindImpureCall( |
1087 | FoldingContext &, const Expr<SomeType> &); |
1088 | std::optional<std::string> FindImpureCall( |
1089 | FoldingContext &, const ProcedureRef &); |
1090 | |
1091 | // Predicate: is a scalar expression suitable for naive scalar expansion |
1092 | // in the flattening of an array expression? |
1093 | // TODO: capture such scalar expansions in temporaries, flatten everything |
1094 | class UnexpandabilityFindingVisitor |
1095 | : public AnyTraverse<UnexpandabilityFindingVisitor> { |
1096 | public: |
1097 | using Base = AnyTraverse<UnexpandabilityFindingVisitor>; |
1098 | using Base::operator(); |
1099 | explicit UnexpandabilityFindingVisitor(bool admitPureCall) |
1100 | : Base{*this}, admitPureCall_{admitPureCall} {} |
1101 | template <typename T> bool operator()(const FunctionRef<T> &procRef) { |
1102 | return !admitPureCall_ || !procRef.proc().IsPure(); |
1103 | } |
1104 | bool operator()(const CoarrayRef &) { return true; } |
1105 | |
1106 | private: |
1107 | bool admitPureCall_{false}; |
1108 | }; |
1109 | |
1110 | template <typename T> |
1111 | bool IsExpandableScalar(const Expr<T> &expr, FoldingContext &context, |
1112 | const Shape &shape, bool admitPureCall = false) { |
1113 | if (UnexpandabilityFindingVisitor{admitPureCall}(expr)) { |
1114 | auto extents{AsConstantExtents(context, shape)}; |
1115 | return extents && GetSize(*extents) == 1; |
1116 | } else { |
1117 | return true; |
1118 | } |
1119 | } |
1120 | |
1121 | // Common handling for procedure pointer compatibility of left- and right-hand |
1122 | // sides. Returns nullopt if they're compatible. Otherwise, it returns a |
1123 | // message that needs to be augmented by the names of the left and right sides. |
1124 | std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall, |
1125 | const std::optional<characteristics::Procedure> &lhsProcedure, |
1126 | const characteristics::Procedure *rhsProcedure, |
1127 | const SpecificIntrinsic *specificIntrinsic, std::string &whyNotCompatible, |
1128 | std::optional<std::string> &warning, bool ignoreImplicitVsExplicit); |
1129 | |
1130 | // Scalar constant expansion |
1131 | class ScalarConstantExpander { |
1132 | public: |
1133 | explicit ScalarConstantExpander(ConstantSubscripts &&extents) |
1134 | : extents_{std::move(extents)} {} |
1135 | ScalarConstantExpander( |
1136 | ConstantSubscripts &&extents, std::optional<ConstantSubscripts> &&lbounds) |
1137 | : extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {} |
1138 | ScalarConstantExpander( |
1139 | ConstantSubscripts &&extents, ConstantSubscripts &&lbounds) |
1140 | : extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {} |
1141 | |
1142 | template <typename A> A Expand(A &&x) const { |
1143 | return std::move(x); // default case |
1144 | } |
1145 | template <typename T> Constant<T> Expand(Constant<T> &&x) { |
1146 | auto expanded{x.Reshape(std::move(extents_))}; |
1147 | if (lbounds_) { |
1148 | expanded.set_lbounds(std::move(*lbounds_)); |
1149 | } |
1150 | return expanded; |
1151 | } |
1152 | template <typename T> Expr<T> Expand(Parentheses<T> &&x) { |
1153 | return Expand(std::move(x.left())); // Constant<> can be parenthesized |
1154 | } |
1155 | template <typename T> Expr<T> Expand(Expr<T> &&x) { |
1156 | return common::visit( |
1157 | [&](auto &&x) { return Expr<T>{Expand(std::move(x))}; }, |
1158 | std::move(x.u)); |
1159 | } |
1160 | |
1161 | private: |
1162 | ConstantSubscripts extents_; |
1163 | std::optional<ConstantSubscripts> lbounds_; |
1164 | }; |
1165 | |
1166 | // Given a collection of element values, package them as a Constant. |
1167 | // If the type is Character or a derived type, take the length or type |
1168 | // (resp.) from a another Constant. |
1169 | template <typename T> |
1170 | Constant<T> PackageConstant(std::vector<Scalar<T>> &&elements, |
1171 | const Constant<T> &reference, const ConstantSubscripts &shape) { |
1172 | if constexpr (T::category == TypeCategory::Character) { |
1173 | return Constant<T>{ |
1174 | reference.LEN(), std::move(elements), ConstantSubscripts{shape}}; |
1175 | } else if constexpr (T::category == TypeCategory::Derived) { |
1176 | return Constant<T>{reference.GetType().GetDerivedTypeSpec(), |
1177 | std::move(elements), ConstantSubscripts{shape}}; |
1178 | } else { |
1179 | return Constant<T>{std::move(elements), ConstantSubscripts{shape}}; |
1180 | } |
1181 | } |
1182 | |
1183 | // Nonstandard conversions of constants (integer->logical, logical->integer) |
1184 | // that can appear in DATA statements as an extension. |
1185 | std::optional<Expr<SomeType>> DataConstantConversionExtension( |
1186 | FoldingContext &, const DynamicType &, const Expr<SomeType> &); |
1187 | |
1188 | // Convert Hollerith or short character to a another type as if the |
1189 | // Hollerith data had been BOZ. |
1190 | std::optional<Expr<SomeType>> HollerithToBOZ( |
1191 | FoldingContext &, const Expr<SomeType> &, const DynamicType &); |
1192 | |
1193 | // Set explicit lower bounds on a constant array. |
1194 | class ArrayConstantBoundChanger { |
1195 | public: |
1196 | explicit ArrayConstantBoundChanger(ConstantSubscripts &&lbounds) |
1197 | : lbounds_{std::move(lbounds)} {} |
1198 | |
1199 | template <typename A> A ChangeLbounds(A &&x) const { |
1200 | return std::move(x); // default case |
1201 | } |
1202 | template <typename T> Constant<T> ChangeLbounds(Constant<T> &&x) { |
1203 | x.set_lbounds(std::move(lbounds_)); |
1204 | return std::move(x); |
1205 | } |
1206 | template <typename T> Expr<T> ChangeLbounds(Parentheses<T> &&x) { |
1207 | return ChangeLbounds( |
1208 | std::move(x.left())); // Constant<> can be parenthesized |
1209 | } |
1210 | template <typename T> Expr<T> ChangeLbounds(Expr<T> &&x) { |
1211 | return common::visit( |
1212 | [&](auto &&x) { return Expr<T>{ChangeLbounds(std::move(x))}; }, |
1213 | std::move(x.u)); // recurse until we hit a constant |
1214 | } |
1215 | |
1216 | private: |
1217 | ConstantSubscripts &&lbounds_; |
1218 | }; |
1219 | |
1220 | // Predicate: should two expressions be considered identical for the purposes |
1221 | // of determining whether two procedure interfaces are compatible, modulo |
1222 | // naming of corresponding dummy arguments? |
1223 | std::optional<bool> AreEquivalentInInterface( |
1224 | const Expr<SubscriptInteger> &, const Expr<SubscriptInteger> &); |
1225 | |
1226 | bool CheckForCoindexedObject(parser::ContextualMessages &, |
1227 | const std::optional<ActualArgument> &, const std::string &procName, |
1228 | const std::string &argName); |
1229 | |
1230 | // Get the number of distinct symbols with CUDA attribute in the expression. |
1231 | template <typename A> inline int GetNbOfCUDASymbols(const A &expr) { |
1232 | semantics::UnorderedSymbolSet symbols; |
1233 | for (const Symbol &sym : CollectSymbols(expr)) { |
1234 | if (const auto *details = |
1235 | sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()) { |
1236 | if (details->cudaDataAttr()) { |
1237 | symbols.insert(sym); |
1238 | } |
1239 | } |
1240 | } |
1241 | return symbols.size(); |
1242 | } |
1243 | |
1244 | // Check if any of the symbols part of the expression has a CUDA data |
1245 | // attribute. |
1246 | template <typename A> inline bool HasCUDAAttrs(const A &expr) { |
1247 | return GetNbOfCUDASymbols(expr) > 0; |
1248 | } |
1249 | |
1250 | /// Check if the expression is a mix of host and device variables that require |
1251 | /// implicit data transfer. |
1252 | inline bool HasCUDAImplicitTransfer(const Expr<SomeType> &expr) { |
1253 | unsigned hostSymbols{0}; |
1254 | unsigned deviceSymbols{0}; |
1255 | for (const Symbol &sym : CollectSymbols(expr)) { |
1256 | if (const auto *details = |
1257 | sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()) { |
1258 | if (details->cudaDataAttr()) { |
1259 | ++deviceSymbols; |
1260 | } else { |
1261 | if (sym.owner().IsDerivedType()) { |
1262 | if (const auto *details = |
1263 | sym.owner() |
1264 | .GetSymbol() |
1265 | ->GetUltimate() |
1266 | .detailsIf<semantics::ObjectEntityDetails>()) { |
1267 | if (details->cudaDataAttr()) { |
1268 | ++deviceSymbols; |
1269 | } |
1270 | } |
1271 | } |
1272 | ++hostSymbols; |
1273 | } |
1274 | } |
1275 | } |
1276 | return hostSymbols > 0 && deviceSymbols > 0; |
1277 | } |
1278 | |
1279 | } // namespace Fortran::evaluate |
1280 | |
1281 | namespace Fortran::semantics { |
1282 | |
1283 | class Scope; |
1284 | |
1285 | // If a symbol represents an ENTRY, return the symbol of the main entry |
1286 | // point to its subprogram. |
1287 | const Symbol *GetMainEntry(const Symbol *); |
1288 | |
1289 | // These functions are used in Evaluate so they are defined here rather than in |
1290 | // Semantics to avoid a link-time dependency on Semantics. |
1291 | // All of these apply GetUltimate() or ResolveAssociations() to their arguments. |
1292 | bool IsVariableName(const Symbol &); |
1293 | bool IsPureProcedure(const Symbol &); |
1294 | bool IsPureProcedure(const Scope &); |
1295 | bool IsExplicitlyImpureProcedure(const Symbol &); |
1296 | bool IsElementalProcedure(const Symbol &); |
1297 | bool IsFunction(const Symbol &); |
1298 | bool IsFunction(const Scope &); |
1299 | bool IsProcedure(const Symbol &); |
1300 | bool IsProcedure(const Scope &); |
1301 | bool IsProcedurePointer(const Symbol *); |
1302 | bool IsProcedurePointer(const Symbol &); |
1303 | bool IsObjectPointer(const Symbol *); |
1304 | bool IsAllocatableOrObjectPointer(const Symbol *); |
1305 | bool IsAutomatic(const Symbol &); |
1306 | bool IsSaved(const Symbol &); // saved implicitly or explicitly |
1307 | bool IsDummy(const Symbol &); |
1308 | bool IsAssumedShape(const Symbol &); |
1309 | bool IsDeferredShape(const Symbol &); |
1310 | bool IsFunctionResult(const Symbol &); |
1311 | bool IsKindTypeParameter(const Symbol &); |
1312 | bool IsLenTypeParameter(const Symbol &); |
1313 | bool IsExtensibleType(const DerivedTypeSpec *); |
1314 | bool IsSequenceOrBindCType(const DerivedTypeSpec *); |
1315 | bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name); |
1316 | bool IsBuiltinCPtr(const Symbol &); |
1317 | bool IsEventType(const DerivedTypeSpec *); |
1318 | bool IsLockType(const DerivedTypeSpec *); |
1319 | bool IsNotifyType(const DerivedTypeSpec *); |
1320 | // Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV? |
1321 | bool IsTeamType(const DerivedTypeSpec *); |
1322 | // Is this derived type TEAM_TYPE, C_PTR, or C_FUNPTR? |
1323 | bool IsBadCoarrayType(const DerivedTypeSpec *); |
1324 | // Is this derived type either C_PTR or C_FUNPTR from module ISO_C_BINDING |
1325 | bool IsIsoCType(const DerivedTypeSpec *); |
1326 | bool IsEventTypeOrLockType(const DerivedTypeSpec *); |
1327 | inline bool IsAssumedSizeArray(const Symbol &symbol) { |
1328 | if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) { |
1329 | return (object->isDummy() || symbol.test(Symbol::Flag::CrayPointee)) && |
1330 | object->shape().CanBeAssumedSize(); |
1331 | } else if (const auto *assoc{symbol.detailsIf<AssocEntityDetails>()}) { |
1332 | return assoc->IsAssumedSize(); |
1333 | } else { |
1334 | return false; |
1335 | } |
1336 | } |
1337 | |
1338 | // ResolveAssociations() traverses use associations and host associations |
1339 | // like GetUltimate(), but also resolves through whole variable associations |
1340 | // with ASSOCIATE(x => y) and related constructs. GetAssociationRoot() |
1341 | // applies ResolveAssociations() and then, in the case of resolution to |
1342 | // a construct association with part of a variable that does not involve a |
1343 | // vector subscript, returns the first symbol of that variable instead |
1344 | // of the construct entity. |
1345 | // (E.g., for ASSOCIATE(x => y%z), ResolveAssociations(x) returns x, |
1346 | // while GetAssociationRoot(x) returns y.) |
1347 | // In a SELECT RANK construct, ResolveAssociations() stops at a |
1348 | // RANK(n) or RANK(*) case symbol, but traverses the selector for |
1349 | // RANK DEFAULT. |
1350 | const Symbol &ResolveAssociations(const Symbol &); |
1351 | const Symbol &GetAssociationRoot(const Symbol &); |
1352 | |
1353 | const Symbol *FindCommonBlockContaining(const Symbol &); |
1354 | int CountLenParameters(const DerivedTypeSpec &); |
1355 | int CountNonConstantLenParameters(const DerivedTypeSpec &); |
1356 | |
1357 | const Symbol &GetUsedModule(const UseDetails &); |
1358 | const Symbol *FindFunctionResult(const Symbol &); |
1359 | |
1360 | // Type compatibility predicate: are x and y effectively the same type? |
1361 | // Uses DynamicType::IsTkCompatible(), which handles the case of distinct |
1362 | // but identical derived types. |
1363 | bool AreTkCompatibleTypes(const DeclTypeSpec *x, const DeclTypeSpec *y); |
1364 | |
1365 | common::IgnoreTKRSet GetIgnoreTKR(const Symbol &); |
1366 | |
1367 | std::optional<int> GetDummyArgumentNumber(const Symbol *); |
1368 | |
1369 | } // namespace Fortran::semantics |
1370 | |
1371 | #endif // FORTRAN_EVALUATE_TOOLS_H_ |
1372 |
Warning: This file is not a C or C++ file. It does not have highlighting.