FLANG

tools.h
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/Parser/message.h"
19 #include "flang/Semantics/attr.h"
20 #include "flang/Semantics/symbol.h"
21 #include <array>
22 #include <optional>
23 #include <set>
24 #include <type_traits>
25 #include <utility>
26
27 namespace Fortran::evaluate {
28
29 // Some expression predicates and extractors.
30
31 // Predicate: true when an expression is a variable reference, not an
32 // operation. Be advised: a call to a function that returns an object
33 // pointer is a "variable" in Fortran (it can be the left-hand side of
34 // an assignment).
35 struct IsVariableHelper
36 : public AnyTraverse<IsVariableHelper, std::optional<bool>> {
37 using Result = std::optional<bool>; // effectively tri-state
38 using Base = AnyTraverse<IsVariableHelper, Result>;
39 IsVariableHelper() : Base{*this} {}
40 using Base::operator();
41 Result operator()(const StaticDataObject &) const { return false; }
42 Result operator()(const Symbol &) const;
43 Result operator()(const Component &) const;
44 Result operator()(const ArrayRef &) const;
45 Result operator()(const Substring &) const;
46 Result operator()(const CoarrayRef &) const { return true; }
47 Result operator()(const ComplexPart &) const { return true; }
48 Result operator()(const ProcedureDesignator &) const;
49 template <typename T> Result operator()(const Expr<T> &x) const {
50 if constexpr (common::HasMember<T, AllIntrinsicTypes> ||
51 std::is_same_v<T, SomeDerived>) {
52 // Expression with a specific type
53 if (std::holds_alternative<Designator<T>>(x.u) ||
54 std::holds_alternative<FunctionRef<T>>(x.u)) {
55 if (auto known{(*this)(x.u)}) {
56 return known;
57 }
58 }
59 return false;
60 } else {
61 return (*this)(x.u);
62 }
63 }
64 };
65
66 template <typename A> bool IsVariable(const A &x) {
67 if (auto known{IsVariableHelper{}(x)}) {
68 return *known;
69 } else {
70 return false;
71 }
72 }
73
74 // Predicate: true when an expression is assumed-rank
75 bool IsAssumedRank(const Symbol &);
76 bool IsAssumedRank(const ActualArgument &);
77 template <typename A> bool IsAssumedRank(const A &) { return false; }
78 template <typename A> bool IsAssumedRank(const Designator<A> &designator) {
79 if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) {
80 return IsAssumedRank(symbol->get());
81 } else {
82 return false;
83 }
84 }
85 template <typename T> bool IsAssumedRank(const Expr<T> &expr) {
86 return std::visit([](const auto &x) { return IsAssumedRank(x); }, expr.u);
87 }
88 template <typename A> bool IsAssumedRank(const std::optional<A> &x) {
89 return x && IsAssumedRank(*x);
90 }
91
92 // Generalizing packagers: these take operations and expressions of more
93 // specific types and wrap them in Expr<> containers of more abstract types.
94
95 template <typename A> common::IfNoLvalue<Expr<ResultType<A>>, A> AsExpr(A &&x) {
96 return Expr<ResultType<A>>{std::move(x)};
97 }
98
99 template <typename T> Expr<T> AsExpr(Expr<T> &&x) {
100 static_assert(IsSpecificIntrinsicType<T>);
101 return std::move(x);
102 }
103
104 template <TypeCategory CATEGORY>
105 Expr<SomeKind<CATEGORY>> AsCategoryExpr(Expr<SomeKind<CATEGORY>> &&x) {
106 return std::move(x);
107 }
108
109 template <typename A>
110 common::IfNoLvalue<Expr<SomeType>, A> AsGenericExpr(A &&x) {
111 if constexpr (common::HasMember<A, TypelessExpression>) {
112 return Expr<SomeType>{std::move(x)};
113 } else {
114 return Expr<SomeType>{AsCategoryExpr(std::move(x))};
115 }
116 }
117
118 template <typename A>
119 common::IfNoLvalue<Expr<SomeKind<ResultType<A>::category>>, A> AsCategoryExpr(
120 A &&x) {
121 return Expr<SomeKind<ResultType<A>::category>>{AsExpr(std::move(x))};
122 }
123
124 inline Expr<SomeType> AsGenericExpr(Expr<SomeType> &&x) { return std::move(x); }
125
126 Expr<SomeType> Parenthesize(Expr<SomeType> &&);
127
128 Expr<SomeReal> GetComplexPart(
129 const Expr<SomeComplex> &, bool isImaginary = false);
130
131 template <int KIND>
132 Expr<SomeComplex> MakeComplex(Expr<Type<TypeCategory::Real, KIND>> &&re,
133 Expr<Type<TypeCategory::Real, KIND>> &&im) {
134 return AsCategoryExpr(ComplexConstructor<KIND>{std::move(re), std::move(im)});
135 }
136
137 template <typename A> constexpr bool IsNumericCategoryExpr() {
138 if constexpr (common::HasMember<A, TypelessExpression>) {
139 return false;
140 } else {
141 return common::HasMember<ResultType<A>, NumericCategoryTypes>;
142 }
143 }
144
145 // Specializing extractor. If an Expr wraps some type of object, perhaps
146 // in several layers, return a pointer to it; otherwise null. Also works
147 // with expressions contained in ActualArgument.
148 template <typename A, typename B>
149 auto UnwrapExpr(B &x) -> common::Constify<A, B> * {
150 using Ty = std::decay_t<B>;
151 if constexpr (std::is_same_v<A, Ty>) {
152 return &x;
153 } else if constexpr (std::is_same_v<Ty, ActualArgument>) {
154 if (auto *expr{x.UnwrapExpr()}) {
155 return UnwrapExpr<A>(*expr);
156 }
157 } else if constexpr (std::is_same_v<Ty, Expr<SomeType>>) {
158 return std::visit([](auto &x) { return UnwrapExpr<A>(x); }, x.u);
159 } else if constexpr (!common::HasMember<A, TypelessExpression>) {
160 if constexpr (std::is_same_v<Ty, Expr<ResultType<A>>> ||
161 std::is_same_v<Ty, Expr<SomeKind<ResultType<A>::category>>>) {
162 return std::visit([](auto &x) { return UnwrapExpr<A>(x); }, x.u);
163 }
164 }
165 return nullptr;
166 }
167
168 template <typename A, typename B>
169 const A *UnwrapExpr(const std::optional<B> &x) {
170 if (x) {
171 return UnwrapExpr<A>(*x);
172 } else {
173 return nullptr;
174 }
175 }
176
177 template <typename A, typename B> A *UnwrapExpr(std::optional<B> &x) {
178 if (x) {
179 return UnwrapExpr<A>(*x);
180 } else {
181 return nullptr;
182 }
183 }
184
185 // If an expression simply wraps a DataRef, extract and return it.
186 // The Boolean argument controls the handling of Substring
187 // references: when true (not default), it extracts the base DataRef
188 // of a substring, if it has one.
189 template <typename A>
190 common::IfNoLvalue<std::optional<DataRef>, A> ExtractDataRef(
191 const A &, bool intoSubstring) {
192 return std::nullopt; // default base case
193 }
194 template <typename T>
195 std::optional<DataRef> ExtractDataRef(
196 const Designator<T> &d, bool intoSubstring = false) {
197 return std::visit(
198 [=](const auto &x) -> std::optional<DataRef> {
199 if constexpr (common::HasMember<decltype(x), decltype(DataRef::u)>) {
200 return DataRef{x};
201 }
202 if constexpr (std::is_same_v<std::decay_t<decltype(x)>, Substring>) {
203 if (intoSubstring) {
204 return ExtractSubstringBase(x);
205 }
206 }
207 return std::nullopt; // w/o "else" to dodge bogus g++ 8.1 warning
208 },
209 d.u);
210 }
211 template <typename T>
212 std::optional<DataRef> ExtractDataRef(
213 const Expr<T> &expr, bool intoSubstring = false) {
214 return std::visit(
215 [=](const auto &x) { return ExtractDataRef(x, intoSubstring); }, expr.u);
216 }
217 template <typename A>
218 std::optional<DataRef> ExtractDataRef(
219 const std::optional<A> &x, bool intoSubstring = false) {
220 if (x) {
221 return ExtractDataRef(*x, intoSubstring);
222 } else {
223 return std::nullopt;
224 }
225 }
226 std::optional<DataRef> ExtractSubstringBase(const Substring &);
227
228 // Predicate: is an expression is an array element reference?
229 template <typename T>
230 bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = false) {
231 if (auto dataRef{ExtractDataRef(expr, intoSubstring)}) {
232 const DataRef *ref{&*dataRef};
233 while (const Component * component{std::get_if<Component>(&ref->u)}) {
234 ref = &component->base();
235 }
236 return std::holds_alternative<ArrayRef>(ref->u);
237 } else {
238 return false;
239 }
240 }
241
242 template <typename A>
243 std::optional<NamedEntity> ExtractNamedEntity(const A &x) {
244 if (auto dataRef{ExtractDataRef(x, true)}) {
245 return std::visit(
246 common::visitors{
247 [](SymbolRef &&symbol) -> std::optional<NamedEntity> {
248 return NamedEntity{symbol};
249 },
250 [](Component &&component) -> std::optional<NamedEntity> {
251 return NamedEntity{std::move(component)};
252 },
253 [](CoarrayRef &&co) -> std::optional<NamedEntity> {
254 return co.GetBase();
255 },
256 [](auto &&) { return std::optional<NamedEntity>{}; },
257 },
258 std::move(dataRef->u));
259 } else {
260 return std::nullopt;
261 }
262 }
263
264 struct ExtractCoindexedObjectHelper {
265 template <typename A> std::optional<CoarrayRef> operator()(const A &) const {
266 return std::nullopt;
267 }
268 std::optional<CoarrayRef> operator()(const CoarrayRef &x) const { return x; }
269 template <typename A>
270 std::optional<CoarrayRef> operator()(const Expr<A> &expr) const {
271 return std::visit(*this, expr.u);
272 }
273 std::optional<CoarrayRef> operator()(const DataRef &dataRef) const {
274 return std::visit(*this, dataRef.u);
275 }
276 std::optional<CoarrayRef> operator()(const NamedEntity &named) const {
277 if (const Component * component{named.UnwrapComponent()}) {
278 return (*this)(*component);
279 } else {
280 return std::nullopt;
281 }
282 }
283 std::optional<CoarrayRef> operator()(const ProcedureDesignator &des) const {
284 if (const auto *component{
285 std::get_if<common::CopyableIndirection<Component>>(&des.u)}) {
286 return (*this)(component->value());
287 } else {
288 return std::nullopt;
289 }
290 }
291 std::optional<CoarrayRef> operator()(const Component &component) const {
292 return (*this)(component.base());
293 }
294 std::optional<CoarrayRef> operator()(const ArrayRef &arrayRef) const {
295 return (*this)(arrayRef.base());
296 }
297 };
298
299 template <typename A> std::optional<CoarrayRef> ExtractCoarrayRef(const A &x) {
300 if (auto dataRef{ExtractDataRef(x, true)}) {
301 return ExtractCoindexedObjectHelper{}(*dataRef);
302 } else {
303 return ExtractCoindexedObjectHelper{}(x);
304 }
305 }
306
307 // If an expression is simply a whole symbol data designator,
308 // extract and return that symbol, else null.
309 template <typename A> const Symbol *UnwrapWholeSymbolDataRef(const A &x) {
310 if (auto dataRef{ExtractDataRef(x)}) {
311 if (const SymbolRef * p{std::get_if<SymbolRef>(&dataRef->u)}) {
312 return &p->get();
313 }
314 }
315 return nullptr;
316 }
317
318 // GetFirstSymbol(A%B%C[I]%D) -> A
319 template <typename A> const Symbol *GetFirstSymbol(const A &x) {
320 if (auto dataRef{ExtractDataRef(x, true)}) {
321 return &dataRef->GetFirstSymbol();
322 } else {
323 return nullptr;
324 }
325 }
326
327 // Creation of conversion expressions can be done to either a known
328 // specific intrinsic type with ConvertToType<T>(x) or by converting
329 // one arbitrary expression to the type of another with ConvertTo(to, from).
330
331 template <typename TO, TypeCategory FROMCAT>
332 Expr<TO> ConvertToType(Expr<SomeKind<FROMCAT>> &&x) {
333 static_assert(IsSpecificIntrinsicType<TO>);
334 if constexpr (FROMCAT != TO::category) {
335 if constexpr (TO::category == TypeCategory::Complex) {
336 using Part = typename TO::Part;
337 Scalar<Part> zero;
338 return Expr<TO>{ComplexConstructor<TO::kind>{
339 ConvertToType<Part>(std::move(x)), Expr<Part>{Constant<Part>{zero}}}};
340 } else if constexpr (FROMCAT == TypeCategory::Complex) {
341 // Extract and convert the real component of a complex value
342 return std::visit(
343 [&](auto &&z) {
344 using ZType = ResultType<decltype(z)>;
345 using Part = typename ZType::Part;
346 return ConvertToType<TO, TypeCategory::Real>(Expr<SomeReal>{
347 Expr<Part>{ComplexComponent<Part::kind>{false, std::move(z)}}});
348 },
349 std::move(x.u));
350 } else {
351 return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}};
352 }
353 } else {
354 // Same type category
355 if (auto *already{std::get_if<Expr<TO>>(&x.u)}) {
356 return std::move(*already);
357 }
358 if constexpr (TO::category == TypeCategory::Complex) {
359 // Extract, convert, and recombine the components.
360 return Expr<TO>{std::visit(
361 [](auto &z) {
362 using FromType = ResultType<decltype(z)>;
363 using FromPart = typename FromType::Part;
364 using FromGeneric = SomeKind<TypeCategory::Real>;
365 using ToPart = typename TO::Part;
366 Convert<ToPart, TypeCategory::Real> re{Expr<FromGeneric>{
367 Expr<FromPart>{ComplexComponent<FromType::kind>{false, z}}}};
368 Convert<ToPart, TypeCategory::Real> im{Expr<FromGeneric>{
369 Expr<FromPart>{ComplexComponent<FromType::kind>{true, z}}}};
370 return ComplexConstructor<TO::kind>{
371 AsExpr(std::move(re)), AsExpr(std::move(im))};
372 },
373 x.u)};
374 } else {
375 return Expr<TO>{Convert<TO, TO::category>{std::move(x)}};
376 }
377 }
378 }
379
380 template <typename TO, TypeCategory FROMCAT, int FROMKIND>
381 Expr<TO> ConvertToType(Expr<Type<FROMCAT, FROMKIND>> &&x) {
382 return ConvertToType<TO, FROMCAT>(Expr<SomeKind<FROMCAT>>{std::move(x)});
383 }
384
385 template <typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
386 static_assert(IsSpecificIntrinsicType<TO>);
387 if constexpr (TO::category == TypeCategory::Integer) {
388 return Expr<TO>{
389 Constant<TO>{Scalar<TO>::ConvertUnsigned(std::move(x)).value}};
390 } else {
391 static_assert(TO::category == TypeCategory::Real);
392 using Word = typename Scalar<TO>::Word;
393 return Expr<TO>{
394 Constant<TO>{Scalar<TO>{Word::ConvertUnsigned(std::move(x)).value}}};
395 }
396 }
397
398 // Conversions to dynamic types
399 std::optional<Expr<SomeType>> ConvertToType(
400 const DynamicType &, Expr<SomeType> &&);
401 std::optional<Expr<SomeType>> ConvertToType(
402 const DynamicType &, std::optional<Expr<SomeType>> &&);
403 std::optional<Expr<SomeType>> ConvertToType(const Symbol &, Expr<SomeType> &&);
404 std::optional<Expr<SomeType>> ConvertToType(
405 const Symbol &, std::optional<Expr<SomeType>> &&);
406
407 // Conversions to the type of another expression
408 template <TypeCategory TC, int TK, typename FROM>
409 common::IfNoLvalue<Expr<Type<TC, TK>>, FROM> ConvertTo(
410 const Expr<Type<TC, TK>> &, FROM &&x) {
411 return ConvertToType<Type<TC, TK>>(std::move(x));
412 }
413
414 template <TypeCategory TC, typename FROM>
415 common::IfNoLvalue<Expr<SomeKind<TC>>, FROM> ConvertTo(
416 const Expr<SomeKind<TC>> &to, FROM &&from) {
417 return std::visit(
418 [&](const auto &toKindExpr) {
419 using KindExpr = std::decay_t<decltype(toKindExpr)>;
420 return AsCategoryExpr(
421 ConvertToType<ResultType<KindExpr>>(std::move(from)));
422 },
423 to.u);
424 }
425
426 template <typename FROM>
427 common::IfNoLvalue<Expr<SomeType>, FROM> ConvertTo(
428 const Expr<SomeType> &to, FROM &&from) {
429 return std::visit(
430 [&](const auto &toCatExpr) {
431 return AsGenericExpr(ConvertTo(toCatExpr, std::move(from)));
432 },
433 to.u);
434 }
435
436 // Convert an expression of some known category to a dynamically chosen
437 // kind of some category (usually but not necessarily distinct).
438 template <TypeCategory TOCAT, typename VALUE> struct ConvertToKindHelper {
439 using Result = std::optional<Expr<SomeKind<TOCAT>>>;
440 using Types = CategoryTypes<TOCAT>;
441 ConvertToKindHelper(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
442 template <typename T> Result Test() {
443 if (kind == T::kind) {
444 return std::make_optional(
445 AsCategoryExpr(ConvertToType<T>(std::move(value))));
446 }
447 return std::nullopt;
448 }
449 int kind;
450 VALUE value;
451 };
452
453 template <TypeCategory TOCAT, typename VALUE>
454 common::IfNoLvalue<Expr<SomeKind<TOCAT>>, VALUE> ConvertToKind(
455 int kind, VALUE &&x) {
456 return common::SearchTypes(
457 ConvertToKindHelper<TOCAT, VALUE>{kind, std::move(x)})
458 .value();
459 }
460
461 // Given a type category CAT, SameKindExprs<CAT, N> is a variant that
462 // holds an arrays of expressions of the same supported kind in that
463 // category.
464 template <typename A, int N = 2> using SameExprs = std::array<Expr<A>, N>;
465 template <int N = 2> struct SameKindExprsHelper {
466 template <typename A> using SameExprs = std::array<Expr<A>, N>;
467 };
468 template <TypeCategory CAT, int N = 2>
469 using SameKindExprs =
470 common::MapTemplate<SameKindExprsHelper<N>::template SameExprs,
471 CategoryTypes<CAT>>;
472
473 // Given references to two expressions of arbitrary kind in the same type
474 // category, convert one to the kind of the other when it has the smaller kind,
475 // then return them in a type-safe package.
476 template <TypeCategory CAT>
477 SameKindExprs<CAT, 2> AsSameKindExprs(
478 Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
479 return std::visit(
480 [&](auto &&kx, auto &&ky) -> SameKindExprs<CAT, 2> {
481 using XTy = ResultType<decltype(kx)>;
482 using YTy = ResultType<decltype(ky)>;
483 if constexpr (std::is_same_v<XTy, YTy>) {
484 return {SameExprs<XTy>{std::move(kx), std::move(ky)}};
485 } else if constexpr (XTy::kind < YTy::kind) {
486 return {SameExprs<YTy>{ConvertTo(ky, std::move(kx)), std::move(ky)}};
487 } else {
488 return {SameExprs<XTy>{std::move(kx), ConvertTo(kx, std::move(ky))}};
489 }
490 #if !__clang__ && 100 * __GNUC__ + __GNUC_MINOR__ == 801
491 // Silence a bogus warning about a missing return with G++ 8.1.0.
492 // Doesn't execute, but must be correctly typed.
493 CHECK(!"can't happen");
494 return {SameExprs<XTy>{std::move(kx), std::move(kx)}};
495 #endif
496 },
497 std::move(x.u), std::move(y.u));
498 }
499
500 // Ensure that both operands of an intrinsic REAL operation (or CMPLX()
501 // constructor) are INTEGER or REAL, then convert them as necessary to the
502 // same kind of REAL.
503 using ConvertRealOperandsResult =
504 std::optional<SameKindExprs<TypeCategory::Real, 2>>;
505 ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &,
506 Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
507
508 // Per F'2018 R718, if both components are INTEGER, they are both converted
509 // to default REAL and the result is default COMPLEX. Otherwise, the
510 // kind of the result is the kind of most precise REAL component, and the other
511 // component is converted if necessary to its type.
512 std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
513 Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
514 std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
515 std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&,
516 int defaultRealKind);
517
518 template <typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
519 using Ty = TypeOf<A>;
520 static_assert(
521 std::is_same_v<Scalar<Ty>, std::decay_t<A>>, "TypeOf<> is broken");
522 return Expr<TypeOf<A>>{Constant<Ty>{x}};
523 }
524
525 // Combine two expressions of the same specific numeric type with an operation
526 // to produce a new expression. Implements piecewise addition and subtraction
527 // for COMPLEX.
528 template <template <typename> class OPR, typename SPECIFIC>
529 Expr<SPECIFIC> Combine(Expr<SPECIFIC> &&x, Expr<SPECIFIC> &&y) {
530 static_assert(IsSpecificIntrinsicType<SPECIFIC>);
531 if constexpr (SPECIFIC::category == TypeCategory::Complex &&
532 (std::is_same_v<OPR<LargestReal>, Add<LargestReal>> ||
533 std::is_same_v<OPR<LargestReal>, Subtract<LargestReal>>)) {
534 static constexpr int kind{SPECIFIC::kind};
535 using Part = Type<TypeCategory::Real, kind>;
536 return AsExpr(ComplexConstructor<kind>{
537 AsExpr(OPR<Part>{AsExpr(ComplexComponent<kind>{false, x}),
538 AsExpr(ComplexComponent<kind>{false, y})}),
539 AsExpr(OPR<Part>{AsExpr(ComplexComponent<kind>{true, x}),
540 AsExpr(ComplexComponent<kind>{true, y})})});
541 } else {
542 return AsExpr(OPR<SPECIFIC>{std::move(x), std::move(y)});
543 }
544 }
545
546 // Given two expressions of arbitrary kind in the same intrinsic type
547 // category, convert one of them if necessary to the larger kind of the
548 // other, then combine the resulting homogenized operands with a given
549 // operation, returning a new expression in the same type category.
550 template <template <typename> class OPR, TypeCategory CAT>
551 Expr<SomeKind<CAT>> PromoteAndCombine(
552 Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
553 return std::visit(
554 [](auto &&xy) {
555 using Ty = ResultType<decltype(xy[0])>;
556 return AsCategoryExpr(
557 Combine<OPR, Ty>(std::move(xy[0]), std::move(xy[1])));
558 },
559 AsSameKindExprs(std::move(x), std::move(y)));
560 }
561
562 // Given two expressions of arbitrary type, try to combine them with a
563 // binary numeric operation (e.g., Add), possibly with data type conversion of
564 // one of the operands to the type of the other. Handles special cases with
565 // typeless literal operands and with REAL/COMPLEX exponentiation to INTEGER
566 // powers.
567 template <template <typename> class OPR>
568 std::optional<Expr<SomeType>> NumericOperation(parser::ContextualMessages &,
569 Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
570
571 extern template std::optional<Expr<SomeType>> NumericOperation<Power>(
572 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
573 int defaultRealKind);
574 extern template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
575 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
576 int defaultRealKind);
577 extern template std::optional<Expr<SomeType>> NumericOperation<Divide>(
578 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
579 int defaultRealKind);
580 extern template std::optional<Expr<SomeType>> NumericOperation<Add>(
581 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
582 int defaultRealKind);
583 extern template std::optional<Expr<SomeType>> NumericOperation<Subtract>(
584 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
585 int defaultRealKind);
586
587 std::optional<Expr<SomeType>> Negation(
588 parser::ContextualMessages &, Expr<SomeType> &&);
589
590 // Given two expressions of arbitrary type, try to combine them with a
591 // relational operator (e.g., .LT.), possibly with data type conversion.
592 std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &,
593 RelationalOperator, Expr<SomeType> &&, Expr<SomeType> &&);
594
595 template <int K>
596 Expr<Type<TypeCategory::Logical, K>> LogicalNegation(
597 Expr<Type<TypeCategory::Logical, K>> &&x) {
598 return AsExpr(Not<K>{std::move(x)});
599 }
600
601 Expr<SomeLogical> LogicalNegation(Expr<SomeLogical> &&);
602
603 template <int K>
604 Expr<Type<TypeCategory::Logical, K>> BinaryLogicalOperation(LogicalOperator opr,
605 Expr<Type<TypeCategory::Logical, K>> &&x,
606 Expr<Type<TypeCategory::Logical, K>> &&y) {
607 return AsExpr(LogicalOperation<K>{opr, std::move(x), std::move(y)});
608 }
609
610 Expr<SomeLogical> BinaryLogicalOperation(
611 LogicalOperator, Expr<SomeLogical> &&, Expr<SomeLogical> &&);
612
613 // Convenience functions and operator overloadings for expression construction.
614 // These interfaces are defined only for those situations that can never
615 // emit any message. Use the more general templates (above) in other
616 // situations.
617
618 template <TypeCategory C, int K>
619 Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x) {
620 return AsExpr(Negate<Type<C, K>>{std::move(x)});
621 }
622
623 template <int K>
624 Expr<Type<TypeCategory::Complex, K>> operator-(
625 Expr<Type<TypeCategory::Complex, K>> &&x) {
626 using Part = Type<TypeCategory::Real, K>;
627 return AsExpr(ComplexConstructor<K>{
628 AsExpr(Negate<Part>{AsExpr(ComplexComponent<K>{false, x})}),
629 AsExpr(Negate<Part>{AsExpr(ComplexComponent<K>{true, x})})});
630 }
631
632 template <TypeCategory C, int K>
633 Expr<Type<C, K>> operator+(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
634 return AsExpr(Combine<Add, Type<C, K>>(std::move(x), std::move(y)));
635 }
636
637 template <TypeCategory C, int K>
638 Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
639 return AsExpr(Combine<Subtract, Type<C, K>>(std::move(x), std::move(y)));
640 }
641
642 template <TypeCategory C, int K>
643 Expr<Type<C, K>> operator*(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
644 return AsExpr(Combine<Multiply, Type<C, K>>(std::move(x), std::move(y)));
645 }
646
647 template <TypeCategory C, int K>
648 Expr<Type<C, K>> operator/(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
649 return AsExpr(Combine<Divide, Type<C, K>>(std::move(x), std::move(y)));
650 }
651
652 template <TypeCategory C> Expr<SomeKind<C>> operator-(Expr<SomeKind<C>> &&x) {
653 return std::visit(
654 [](auto &xk) { return Expr<SomeKind<C>>{-std::move(xk)}; }, x.u);
655 }
656
657 template <TypeCategory CAT>
658 Expr<SomeKind<CAT>> operator+(
659 Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
660 return PromoteAndCombine<Add, CAT>(std::move(x), std::move(y));
661 }
662
663 template <TypeCategory CAT>
664 Expr<SomeKind<CAT>> operator-(
665 Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
666 return PromoteAndCombine<Subtract, CAT>(std::move(x), std::move(y));
667 }
668
669 template <TypeCategory CAT>
670 Expr<SomeKind<CAT>> operator*(
671 Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
672 return PromoteAndCombine<Multiply, CAT>(std::move(x), std::move(y));
673 }
674
675 template <TypeCategory CAT>
676 Expr<SomeKind<CAT>> operator/(
677 Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
678 return PromoteAndCombine<Divide, CAT>(std::move(x), std::move(y));
679 }
680
681 // A utility for use with common::SearchTypes to create generic expressions
682 // when an intrinsic type category for (say) a variable is known
683 // but the kind parameter value is not.
684 template <TypeCategory CAT, template <typename> class TEMPLATE, typename VALUE>
685 struct TypeKindVisitor {
686 using Result = std::optional<Expr<SomeType>>;
687 using Types = CategoryTypes<CAT>;
688
689 TypeKindVisitor(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
690 TypeKindVisitor(int k, const VALUE &x) : kind{k}, value{x} {}
691
692 template <typename T> Result Test() {
693 if (kind == T::kind) {
694 return AsGenericExpr(TEMPLATE<T>{std::move(value)});
695 }
696 return std::nullopt;
697 }
698
699 int kind;
700 VALUE value;
701 };
702
703 // TypedWrapper() wraps a object in an explicitly typed representation
704 // (e.g., Designator<> or FunctionRef<>) that has been instantiated on
705 // a dynamically chosen Fortran type.
706 template <TypeCategory CATEGORY, template <typename> typename WRAPPER,
707 typename WRAPPED>
708 common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> WrapperHelper(
709 int kind, WRAPPED &&x) {
710 return common::SearchTypes(
711 TypeKindVisitor<CATEGORY, WRAPPER, WRAPPED>{kind, std::move(x)});
712 }
713
714 template <template <typename> typename WRAPPER, typename WRAPPED>
715 common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> TypedWrapper(
716 const DynamicType &dyType, WRAPPED &&x) {
717 switch (dyType.category()) {
718 SWITCH_COVERS_ALL_CASES
719 case TypeCategory::Integer:
720 return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>(
721 dyType.kind(), std::move(x));
722 case TypeCategory::Real:
723 return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>(
724 dyType.kind(), std::move(x));
725 case TypeCategory::Complex:
726 return WrapperHelper<TypeCategory::Complex, WRAPPER, WRAPPED>(
727 dyType.kind(), std::move(x));
728 case TypeCategory::Character:
729 return WrapperHelper<TypeCategory::Character, WRAPPER, WRAPPED>(
730 dyType.kind(), std::move(x));
731 case TypeCategory::Logical:
732 return WrapperHelper<TypeCategory::Logical, WRAPPER, WRAPPED>(
733 dyType.kind(), std::move(x));
734 case TypeCategory::Derived:
735 return AsGenericExpr(Expr<SomeDerived>{WRAPPER<SomeDerived>{std::move(x)}});
736 }
737 }
738
739 // GetLastSymbol() returns the rightmost symbol in an object or procedure
740 // designator (which has perhaps been wrapped in an Expr<>), or a null pointer
741 // when none is found.
742 struct GetLastSymbolHelper
743 : public AnyTraverse<GetLastSymbolHelper, std::optional<const Symbol *>> {
744 using Result = std::optional<const Symbol *>;
745 using Base = AnyTraverse<GetLastSymbolHelper, Result>;
746 GetLastSymbolHelper() : Base{*this} {}
747 using Base::operator();
748 Result operator()(const Symbol &x) const { return &x; }
749 Result operator()(const Component &x) const { return &x.GetLastSymbol(); }
750 Result operator()(const NamedEntity &x) const { return &x.GetLastSymbol(); }
751 Result operator()(const ProcedureDesignator &x) const {
752 return x.GetSymbol();
753 }
754 template <typename T> Result operator()(const Expr<T> &x) const {
755 if constexpr (common::HasMember<T, AllIntrinsicTypes> ||
756 std::is_same_v<T, SomeDerived>) {
757 if (const auto *designator{std::get_if<Designator<T>>(&x.u)}) {
758 if (auto known{(*this)(*designator)}) {
759 return known;
760 }
761 }
762 return nullptr;
763 } else {
764 return (*this)(x.u);
765 }
766 }
767 };
768
769 template <typename A> const Symbol *GetLastSymbol(const A &x) {
770 if (auto known{GetLastSymbolHelper{}(x)}) {
771 return *known;
772 } else {
773 return nullptr;
774 }
775 }
776
777 // Convenience: If GetLastSymbol() succeeds on the argument, return its
778 // set of attributes, otherwise the empty set.
779 template <typename A> semantics::Attrs GetAttrs(const A &x) {
780 if (const Symbol * symbol{GetLastSymbol(x)}) {
781 return symbol->attrs();
782 } else {
783 return {};
784 }
785 }
786
787 // GetBaseObject()
788 template <typename A> std::optional<BaseObject> GetBaseObject(const A &) {
789 return std::nullopt;
790 }
791 template <typename T>
792 std::optional<BaseObject> GetBaseObject(const Designator<T> &x) {
793 return x.GetBaseObject();
794 }
795 template <typename T>
796 std::optional<BaseObject> GetBaseObject(const Expr<T> &x) {
797 return std::visit([](const auto &y) { return GetBaseObject(y); }, x.u);
798 }
799 template <typename A>
800 std::optional<BaseObject> GetBaseObject(const std::optional<A> &x) {
801 if (x) {
802 return GetBaseObject(*x);
803 } else {
804 return std::nullopt;
805 }
806 }
807
808 // Predicate: IsAllocatableOrPointer()
809 template <typename A> bool IsAllocatableOrPointer(const A &x) {
810 return GetAttrs(x).HasAny(
811 semantics::Attrs{semantics::Attr::POINTER, semantics::Attr::ALLOCATABLE});
812 }
813
814 // Procedure and pointer detection predicates
815 bool IsProcedure(const Expr<SomeType> &);
816 bool IsProcedurePointer(const Expr<SomeType> &);
817 bool IsNullPointer(const Expr<SomeType> &);
818
819 // Extracts the chain of symbols from a designator, which has perhaps been
820 // wrapped in an Expr<>, removing all of the (co)subscripts. The
821 // base object will be the first symbol in the result vector.
822 struct GetSymbolVectorHelper
823 : public Traverse<GetSymbolVectorHelper, SymbolVector> {
824 using Result = SymbolVector;
825 using Base = Traverse<GetSymbolVectorHelper, Result>;
826 using Base::operator();
827 GetSymbolVectorHelper() : Base{*this} {}
828 Result Default() { return {}; }
829 Result Combine(Result &&a, Result &&b) {
830 a.insert(a.end(), b.begin(), b.end());
831 return std::move(a);
832 }
833 Result operator()(const Symbol &) const;
834 Result operator()(const Component &) const;
835 Result operator()(const ArrayRef &) const;
836 Result operator()(const CoarrayRef &) const;
837 };
838 template <typename A> SymbolVector GetSymbolVector(const A &x) {
839 return GetSymbolVectorHelper{}(x);
840 }
841
842 // GetLastTarget() returns the rightmost symbol in an object designator's
843 // SymbolVector that has the POINTER or TARGET attribute, or a null pointer
844 // when none is found.
845 const Symbol *GetLastTarget(const SymbolVector &);
846
847 // Resolves any whole ASSOCIATE(B=>A) associations, then returns GetUltimate()
848 const Symbol &ResolveAssociations(const Symbol &);
849
850 // Collects all of the Symbols in an expression
851 template <typename A> semantics::SymbolSet CollectSymbols(const A &);
852 extern template semantics::SymbolSet CollectSymbols(const Expr<SomeType> &);
853 extern template semantics::SymbolSet CollectSymbols(const Expr<SomeInteger> &);
854 extern template semantics::SymbolSet CollectSymbols(
855 const Expr<SubscriptInteger> &);
856
857 // Predicate: does a variable contain a vector-valued subscript (not a triplet)?
858 bool HasVectorSubscript(const Expr<SomeType> &);
859
860 // Utilities for attaching the location of the declaration of a symbol
861 // of interest to a message, if both pointers are non-null. Handles
862 // the case of USE association gracefully.
863 parser::Message *AttachDeclaration(parser::Message &, const Symbol &);
864 parser::Message *AttachDeclaration(parser::Message *, const Symbol &);
865 template <typename MESSAGES, typename... A>
866 parser::Message *SayWithDeclaration(
867 MESSAGES &messages, const Symbol &symbol, A &&... x) {
868 return AttachDeclaration(messages.Say(std::forward<A>(x)...), symbol);
869 }
870
871 // Check for references to impure procedures; returns the name
872 // of one to complain about, if any exist.
873 std::optional<std::string> FindImpureCall(
874 const IntrinsicProcTable &, const Expr<SomeType> &);
875 std::optional<std::string> FindImpureCall(
876 const IntrinsicProcTable &, const ProcedureRef &);
877
878 // Predicate: is a scalar expression suitable for naive scalar expansion
879 // in the flattening of an array expression?
880 // TODO: capture such scalar expansions in temporaries, flatten everything
881 struct UnexpandabilityFindingVisitor
882 : public AnyTraverse<UnexpandabilityFindingVisitor> {
883 using Base = AnyTraverse<UnexpandabilityFindingVisitor>;
884 using Base::operator();
885 UnexpandabilityFindingVisitor() : Base{*this} {}
886 template <typename T> bool operator()(const FunctionRef<T> &) { return true; }
887 bool operator()(const CoarrayRef &) { return true; }
888 };
889
890 template <typename T> bool IsExpandableScalar(const Expr<T> &expr) {
891 return !UnexpandabilityFindingVisitor{}(expr);
892 }
893
894 } // namespace Fortran::evaluate
895
896 namespace Fortran::semantics {
897
898 class Scope;
899
900 // These functions are used in Evaluate so they are defined here rather than in
901 // Semantics to avoid a link-time dependency on Semantics.
902
903 bool IsVariableName(const Symbol &);
904 bool IsPureProcedure(const Symbol &);
905 bool IsPureProcedure(const Scope &);
906 bool IsFunction(const Symbol &);
907 bool IsProcedure(const Symbol &);
908 bool IsProcedurePointer(const Symbol &);
909 bool IsSaved(const Symbol &); // saved implicitly or explicitly
910 bool IsDummy(const Symbol &);
911 bool IsFunctionResult(const Symbol &);
912
913 // Follow use, host, and construct assocations to a variable, if any.
914 const Symbol *GetAssociationRoot(const Symbol &);
915 const Symbol *FindCommonBlockContaining(const Symbol &);
916 int CountLenParameters(const DerivedTypeSpec &);
917 int CountNonConstantLenParameters(const DerivedTypeSpec &);
918 const Symbol &GetUsedModule(const UseDetails &);
919
920 } // namespace Fortran::semantics
921
922 #endif // FORTRAN_EVALUATE_TOOLS_H_
Fortran::evaluate::CoarrayRef
Definition: variable.h:242
Fortran::evaluate::StaticDataObject
Definition: static-data.h:29
Fortran::evaluate::TypeKindVisitor
Definition: tools.h:685
Fortran::evaluate::Substring
Definition: variable.h:301
Fortran::evaluate::SameKindExprsHelper
Definition: tools.h:465
Fortran::evaluate::Component
Definition: variable.h:73
Fortran::evaluate::IsVariableHelper
Definition: tools.h:35
Fortran::semantics::Symbol
Definition: symbol.h:479
Fortran::evaluate::ComplexPart
Definition: variable.h:347
Fortran::evaluate::GetSymbolVectorHelper
Definition: tools.h:822
Fortran::evaluate::UnexpandabilityFindingVisitor
Definition: tools.h:881
Fortran::evaluate::DataRef
Definition: variable.h:286
Fortran::evaluate::ArrayRef
Definition: variable.h:196
Fortran::evaluate::ExtractCoindexedObjectHelper
Definition: tools.h:264
Fortran::evaluate::ProcedureDesignator
Definition: call.h:159
Fortran::evaluate::FunctionRef
Definition: call.h:218
Fortran::evaluate::Traverse
Definition: traverse.h:44
Fortran::evaluate::GetLastSymbolHelper
Definition: tools.h:742
Fortran::evaluate::SomeKind
Definition: type.h:372
Fortran::evaluate::Designator
Definition: variable.h:369
Fortran::evaluate::NamedEntity
Definition: variable.h:99
Fortran::evaluate::AnyTraverse
Definition: traverse.h:271
Fortran::evaluate::Expr
Definition: common.h:207
Fortran::evaluate::ConvertToKindHelper
Definition: tools.h:438