[flang] Infrastructure improvements in utility routines
[lldb.git] / flang / include / flang / Evaluate / 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 template <typename A>
227 std::optional<DataRef> ExtractDataRef(const A *p, bool intoSubstring = false) {
228   if (p) {
229     return ExtractDataRef(*p, intoSubstring);
230   } else {
231     return std::nullopt;
232   }
233 }
234 std::optional<DataRef> ExtractSubstringBase(const Substring &);
235
236 // Predicate: is an expression is an array element reference?
237 template <typename T>
238 bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = true,
239     bool skipComponents = false) {
240   if (auto dataRef{ExtractDataRef(expr, intoSubstring)}) {
241     const DataRef *ref{&*dataRef};
242     if (skipComponents) {
243       while (const Component * component{std::get_if<Component>(&ref->u)}) {
244         ref = &component->base();
245       }
246     }
247     if (const auto *coarrayRef{std::get_if<CoarrayRef>(&ref->u)}) {
248       return !coarrayRef->subscript().empty();
249     } else {
250       return std::holds_alternative<ArrayRef>(ref->u);
251     }
252   } else {
253     return false;
254   }
255 }
256
257 template <typename A>
258 std::optional<NamedEntity> ExtractNamedEntity(const A &x) {
259   if (auto dataRef{ExtractDataRef(x, true)}) {
260     return std::visit(
261         common::visitors{
262             [](SymbolRef &&symbol) -> std::optional<NamedEntity> {
263               return NamedEntity{symbol};
264             },
265             [](Component &&component) -> std::optional<NamedEntity> {
266               return NamedEntity{std::move(component)};
267             },
268             [](CoarrayRef &&co) -> std::optional<NamedEntity> {
269               return co.GetBase();
270             },
271             [](auto &&) { return std::optional<NamedEntity>{}; },
272         },
273         std::move(dataRef->u));
274   } else {
275     return std::nullopt;
276   }
277 }
278
279 struct ExtractCoindexedObjectHelper {
280   template <typename A> std::optional<CoarrayRef> operator()(const A &) const {
281     return std::nullopt;
282   }
283   std::optional<CoarrayRef> operator()(const CoarrayRef &x) const { return x; }
284   template <typename A>
285   std::optional<CoarrayRef> operator()(const Expr<A> &expr) const {
286     return std::visit(*this, expr.u);
287   }
288   std::optional<CoarrayRef> operator()(const DataRef &dataRef) const {
289     return std::visit(*this, dataRef.u);
290   }
291   std::optional<CoarrayRef> operator()(const NamedEntity &named) const {
292     if (const Component * component{named.UnwrapComponent()}) {
293       return (*this)(*component);
294     } else {
295       return std::nullopt;
296     }
297   }
298   std::optional<CoarrayRef> operator()(const ProcedureDesignator &des) const {
299     if (const auto *component{
300             std::get_if<common::CopyableIndirection<Component>>(&des.u)}) {
301       return (*this)(component->value());
302     } else {
303       return std::nullopt;
304     }
305   }
306   std::optional<CoarrayRef> operator()(const Component &component) const {
307     return (*this)(component.base());
308   }
309   std::optional<CoarrayRef> operator()(const ArrayRef &arrayRef) const {
310     return (*this)(arrayRef.base());
311   }
312 };
313
314 template <typename A> std::optional<CoarrayRef> ExtractCoarrayRef(const A &x) {
315   if (auto dataRef{ExtractDataRef(x, true)}) {
316     return ExtractCoindexedObjectHelper{}(*dataRef);
317   } else {
318     return ExtractCoindexedObjectHelper{}(x);
319   }
320 }
321
322 // If an expression is simply a whole symbol data designator,
323 // extract and return that symbol, else null.
324 template <typename A> const Symbol *UnwrapWholeSymbolDataRef(const A &x) {
325   if (auto dataRef{ExtractDataRef(x)}) {
326     if (const SymbolRef * p{std::get_if<SymbolRef>(&dataRef->u)}) {
327       return &p->get();
328     }
329   }
330   return nullptr;
331 }
332
333 // GetFirstSymbol(A%B%C[I]%D) -> A
334 template <typename A> const Symbol *GetFirstSymbol(const A &x) {
335   if (auto dataRef{ExtractDataRef(x, true)}) {
336     return &dataRef->GetFirstSymbol();
337   } else {
338     return nullptr;
339   }
340 }
341
342 // GetLastPointerSymbol(A%PTR1%B%PTR2%C) -> PTR2
343 const Symbol *GetLastPointerSymbol(const evaluate::DataRef &);
344
345 // Creation of conversion expressions can be done to either a known
346 // specific intrinsic type with ConvertToType<T>(x) or by converting
347 // one arbitrary expression to the type of another with ConvertTo(to, from).
348
349 template <typename TO, TypeCategory FROMCAT>
350 Expr<TO> ConvertToType(Expr<SomeKind<FROMCAT>> &&x) {
351   static_assert(IsSpecificIntrinsicType<TO>);
352   if constexpr (FROMCAT == TO::category) {
353     if (auto *already{std::get_if<Expr<TO>>(&x.u)}) {
354       return std::move(*already);
355     } else {
356       return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}};
357     }
358   } else if constexpr (TO::category == TypeCategory::Complex) {
359     using Part = typename TO::Part;
360     Scalar<Part> zero;
361     return Expr<TO>{ComplexConstructor<TO::kind>{
362         ConvertToType<Part>(std::move(x)), Expr<Part>{Constant<Part>{zero}}}};
363   } else if constexpr (FROMCAT == TypeCategory::Complex) {
364     // Extract and convert the real component of a complex value
365     return std::visit(
366         [&](auto &&z) {
367           using ZType = ResultType<decltype(z)>;
368           using Part = typename ZType::Part;
369           return ConvertToType<TO, TypeCategory::Real>(Expr<SomeReal>{
370               Expr<Part>{ComplexComponent<Part::kind>{false, std::move(z)}}});
371         },
372         std::move(x.u));
373   } else {
374     return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}};
375   }
376 }
377
378 template <typename TO, TypeCategory FROMCAT, int FROMKIND>
379 Expr<TO> ConvertToType(Expr<Type<FROMCAT, FROMKIND>> &&x) {
380   return ConvertToType<TO, FROMCAT>(Expr<SomeKind<FROMCAT>>{std::move(x)});
381 }
382
383 template <typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
384   static_assert(IsSpecificIntrinsicType<TO>);
385   if constexpr (TO::category == TypeCategory::Integer) {
386     return Expr<TO>{
387         Constant<TO>{Scalar<TO>::ConvertUnsigned(std::move(x)).value}};
388   } else {
389     static_assert(TO::category == TypeCategory::Real);
390     using Word = typename Scalar<TO>::Word;
391     return Expr<TO>{
392         Constant<TO>{Scalar<TO>{Word::ConvertUnsigned(std::move(x)).value}}};
393   }
394 }
395
396 // Conversions to dynamic types
397 std::optional<Expr<SomeType>> ConvertToType(
398     const DynamicType &, Expr<SomeType> &&);
399 std::optional<Expr<SomeType>> ConvertToType(
400     const DynamicType &, std::optional<Expr<SomeType>> &&);
401 std::optional<Expr<SomeType>> ConvertToType(const Symbol &, Expr<SomeType> &&);
402 std::optional<Expr<SomeType>> ConvertToType(
403     const Symbol &, std::optional<Expr<SomeType>> &&);
404
405 // Conversions to the type of another expression
406 template <TypeCategory TC, int TK, typename FROM>
407 common::IfNoLvalue<Expr<Type<TC, TK>>, FROM> ConvertTo(
408     const Expr<Type<TC, TK>> &, FROM &&x) {
409   return ConvertToType<Type<TC, TK>>(std::move(x));
410 }
411
412 template <TypeCategory TC, typename FROM>
413 common::IfNoLvalue<Expr<SomeKind<TC>>, FROM> ConvertTo(
414     const Expr<SomeKind<TC>> &to, FROM &&from) {
415   return std::visit(
416       [&](const auto &toKindExpr) {
417         using KindExpr = std::decay_t<decltype(toKindExpr)>;
418         return AsCategoryExpr(
419             ConvertToType<ResultType<KindExpr>>(std::move(from)));
420       },
421       to.u);
422 }
423
424 template <typename FROM>
425 common::IfNoLvalue<Expr<SomeType>, FROM> ConvertTo(
426     const Expr<SomeType> &to, FROM &&from) {
427   return std::visit(
428       [&](const auto &toCatExpr) {
429         return AsGenericExpr(ConvertTo(toCatExpr, std::move(from)));
430       },
431       to.u);
432 }
433
434 // Convert an expression of some known category to a dynamically chosen
435 // kind of some category (usually but not necessarily distinct).
436 template <TypeCategory TOCAT, typename VALUE> struct ConvertToKindHelper {
437   using Result = std::optional<Expr<SomeKind<TOCAT>>>;
438   using Types = CategoryTypes<TOCAT>;
439   ConvertToKindHelper(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
440   template <typename T> Result Test() {
441     if (kind == T::kind) {
442       return std::make_optional(
443           AsCategoryExpr(ConvertToType<T>(std::move(value))));
444     }
445     return std::nullopt;
446   }
447   int kind;
448   VALUE value;
449 };
450
451 template <TypeCategory TOCAT, typename VALUE>
452 common::IfNoLvalue<Expr<SomeKind<TOCAT>>, VALUE> ConvertToKind(
453     int kind, VALUE &&x) {
454   return common::SearchTypes(
455       ConvertToKindHelper<TOCAT, VALUE>{kind, std::move(x)})
456       .value();
457 }
458
459 // Given a type category CAT, SameKindExprs<CAT, N> is a variant that
460 // holds an arrays of expressions of the same supported kind in that
461 // category.
462 template <typename A, int N = 2> using SameExprs = std::array<Expr<A>, N>;
463 template <int N = 2> struct SameKindExprsHelper {
464   template <typename A> using SameExprs = std::array<Expr<A>, N>;
465 };
466 template <TypeCategory CAT, int N = 2>
467 using SameKindExprs =
468     common::MapTemplate<SameKindExprsHelper<N>::template SameExprs,
469         CategoryTypes<CAT>>;
470
471 // Given references to two expressions of arbitrary kind in the same type
472 // category, convert one to the kind of the other when it has the smaller kind,
473 // then return them in a type-safe package.
474 template <TypeCategory CAT>
475 SameKindExprs<CAT, 2> AsSameKindExprs(
476     Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
477   return std::visit(
478       [&](auto &&kx, auto &&ky) -> SameKindExprs<CAT, 2> {
479         using XTy = ResultType<decltype(kx)>;
480         using YTy = ResultType<decltype(ky)>;
481         if constexpr (std::is_same_v<XTy, YTy>) {
482           return {SameExprs<XTy>{std::move(kx), std::move(ky)}};
483         } else if constexpr (XTy::kind < YTy::kind) {
484           return {SameExprs<YTy>{ConvertTo(ky, std::move(kx)), std::move(ky)}};
485         } else {
486           return {SameExprs<XTy>{std::move(kx), ConvertTo(kx, std::move(ky))}};
487         }
488 #if !__clang__ && 100 * __GNUC__ + __GNUC_MINOR__ == 801
489         // Silence a bogus warning about a missing return with G++ 8.1.0.
490         // Doesn't execute, but must be correctly typed.
491         CHECK(!"can't happen");
492         return {SameExprs<XTy>{std::move(kx), std::move(kx)}};
493 #endif
494       },
495       std::move(x.u), std::move(y.u));
496 }
497
498 // Ensure that both operands of an intrinsic REAL operation (or CMPLX()
499 // constructor) are INTEGER or REAL, then convert them as necessary to the
500 // same kind of REAL.
501 using ConvertRealOperandsResult =
502     std::optional<SameKindExprs<TypeCategory::Real, 2>>;
503 ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &,
504     Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
505
506 // Per F'2018 R718, if both components are INTEGER, they are both converted
507 // to default REAL and the result is default COMPLEX.  Otherwise, the
508 // kind of the result is the kind of most precise REAL component, and the other
509 // component is converted if necessary to its type.
510 std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
511     Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
512 std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
513     std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&,
514     int defaultRealKind);
515
516 template <typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
517   using Ty = TypeOf<A>;
518   static_assert(
519       std::is_same_v<Scalar<Ty>, std::decay_t<A>>, "TypeOf<> is broken");
520   return Expr<TypeOf<A>>{Constant<Ty>{x}};
521 }
522
523 // Combine two expressions of the same specific numeric type with an operation
524 // to produce a new expression.
525 template <template <typename> class OPR, typename SPECIFIC>
526 Expr<SPECIFIC> Combine(Expr<SPECIFIC> &&x, Expr<SPECIFIC> &&y) {
527   static_assert(IsSpecificIntrinsicType<SPECIFIC>);
528   return AsExpr(OPR<SPECIFIC>{std::move(x), std::move(y)});
529 }
530
531 // Given two expressions of arbitrary kind in the same intrinsic type
532 // category, convert one of them if necessary to the larger kind of the
533 // other, then combine the resulting homogenized operands with a given
534 // operation, returning a new expression in the same type category.
535 template <template <typename> class OPR, TypeCategory CAT>
536 Expr<SomeKind<CAT>> PromoteAndCombine(
537     Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
538   return std::visit(
539       [](auto &&xy) {
540         using Ty = ResultType<decltype(xy[0])>;
541         return AsCategoryExpr(
542             Combine<OPR, Ty>(std::move(xy[0]), std::move(xy[1])));
543       },
544       AsSameKindExprs(std::move(x), std::move(y)));
545 }
546
547 // Given two expressions of arbitrary type, try to combine them with a
548 // binary numeric operation (e.g., Add), possibly with data type conversion of
549 // one of the operands to the type of the other.  Handles special cases with
550 // typeless literal operands and with REAL/COMPLEX exponentiation to INTEGER
551 // powers.
552 template <template <typename> class OPR>
553 std::optional<Expr<SomeType>> NumericOperation(parser::ContextualMessages &,
554     Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
555
556 extern template std::optional<Expr<SomeType>> NumericOperation<Power>(
557     parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
558     int defaultRealKind);
559 extern template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
560     parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
561     int defaultRealKind);
562 extern template std::optional<Expr<SomeType>> NumericOperation<Divide>(
563     parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
564     int defaultRealKind);
565 extern template std::optional<Expr<SomeType>> NumericOperation<Add>(
566     parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
567     int defaultRealKind);
568 extern template std::optional<Expr<SomeType>> NumericOperation<Subtract>(
569     parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
570     int defaultRealKind);
571
572 std::optional<Expr<SomeType>> Negation(
573     parser::ContextualMessages &, Expr<SomeType> &&);
574
575 // Given two expressions of arbitrary type, try to combine them with a
576 // relational operator (e.g., .LT.), possibly with data type conversion.
577 std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &,
578     RelationalOperator, Expr<SomeType> &&, Expr<SomeType> &&);
579
580 template <int K>
581 Expr<Type<TypeCategory::Logical, K>> LogicalNegation(
582     Expr<Type<TypeCategory::Logical, K>> &&x) {
583   return AsExpr(Not<K>{std::move(x)});
584 }
585
586 Expr<SomeLogical> LogicalNegation(Expr<SomeLogical> &&);
587
588 template <int K>
589 Expr<Type<TypeCategory::Logical, K>> BinaryLogicalOperation(LogicalOperator opr,
590     Expr<Type<TypeCategory::Logical, K>> &&x,
591     Expr<Type<TypeCategory::Logical, K>> &&y) {
592   return AsExpr(LogicalOperation<K>{opr, std::move(x), std::move(y)});
593 }
594
595 Expr<SomeLogical> BinaryLogicalOperation(
596     LogicalOperator, Expr<SomeLogical> &&, Expr<SomeLogical> &&);
597
598 // Convenience functions and operator overloadings for expression construction.
599 // These interfaces are defined only for those situations that can never
600 // emit any message.  Use the more general templates (above) in other
601 // situations.
602
603 template <TypeCategory C, int K>
604 Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x) {
605   return AsExpr(Negate<Type<C, K>>{std::move(x)});
606 }
607
608 template <TypeCategory C, int K>
609 Expr<Type<C, K>> operator+(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
610   return AsExpr(Combine<Add, Type<C, K>>(std::move(x), std::move(y)));
611 }
612
613 template <TypeCategory C, int K>
614 Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
615   return AsExpr(Combine<Subtract, Type<C, K>>(std::move(x), std::move(y)));
616 }
617
618 template <TypeCategory C, int K>
619 Expr<Type<C, K>> operator*(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
620   return AsExpr(Combine<Multiply, Type<C, K>>(std::move(x), std::move(y)));
621 }
622
623 template <TypeCategory C, int K>
624 Expr<Type<C, K>> operator/(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
625   return AsExpr(Combine<Divide, Type<C, K>>(std::move(x), std::move(y)));
626 }
627
628 template <TypeCategory C> Expr<SomeKind<C>> operator-(Expr<SomeKind<C>> &&x) {
629   return std::visit(
630       [](auto &xk) { return Expr<SomeKind<C>>{-std::move(xk)}; }, x.u);
631 }
632
633 template <TypeCategory CAT>
634 Expr<SomeKind<CAT>> operator+(
635     Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
636   return PromoteAndCombine<Add, CAT>(std::move(x), std::move(y));
637 }
638
639 template <TypeCategory CAT>
640 Expr<SomeKind<CAT>> operator-(
641     Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
642   return PromoteAndCombine<Subtract, CAT>(std::move(x), std::move(y));
643 }
644
645 template <TypeCategory CAT>
646 Expr<SomeKind<CAT>> operator*(
647     Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
648   return PromoteAndCombine<Multiply, CAT>(std::move(x), std::move(y));
649 }
650
651 template <TypeCategory CAT>
652 Expr<SomeKind<CAT>> operator/(
653     Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
654   return PromoteAndCombine<Divide, CAT>(std::move(x), std::move(y));
655 }
656
657 // A utility for use with common::SearchTypes to create generic expressions
658 // when an intrinsic type category for (say) a variable is known
659 // but the kind parameter value is not.
660 template <TypeCategory CAT, template <typename> class TEMPLATE, typename VALUE>
661 struct TypeKindVisitor {
662   using Result = std::optional<Expr<SomeType>>;
663   using Types = CategoryTypes<CAT>;
664
665   TypeKindVisitor(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
666   TypeKindVisitor(int k, const VALUE &x) : kind{k}, value{x} {}
667
668   template <typename T> Result Test() {
669     if (kind == T::kind) {
670       return AsGenericExpr(TEMPLATE<T>{std::move(value)});
671     }
672     return std::nullopt;
673   }
674
675   int kind;
676   VALUE value;
677 };
678
679 // TypedWrapper() wraps a object in an explicitly typed representation
680 // (e.g., Designator<> or FunctionRef<>) that has been instantiated on
681 // a dynamically chosen Fortran type.
682 template <TypeCategory CATEGORY, template <typename> typename WRAPPER,
683     typename WRAPPED>
684 common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> WrapperHelper(
685     int kind, WRAPPED &&x) {
686   return common::SearchTypes(
687       TypeKindVisitor<CATEGORY, WRAPPER, WRAPPED>{kind, std::move(x)});
688 }
689
690 template <template <typename> typename WRAPPER, typename WRAPPED>
691 common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> TypedWrapper(
692     const DynamicType &dyType, WRAPPED &&x) {
693   switch (dyType.category()) {
694     SWITCH_COVERS_ALL_CASES
695   case TypeCategory::Integer:
696     return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>(
697         dyType.kind(), std::move(x));
698   case TypeCategory::Real:
699     return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>(
700         dyType.kind(), std::move(x));
701   case TypeCategory::Complex:
702     return WrapperHelper<TypeCategory::Complex, WRAPPER, WRAPPED>(
703         dyType.kind(), std::move(x));
704   case TypeCategory::Character:
705     return WrapperHelper<TypeCategory::Character, WRAPPER, WRAPPED>(
706         dyType.kind(), std::move(x));
707   case TypeCategory::Logical:
708     return WrapperHelper<TypeCategory::Logical, WRAPPER, WRAPPED>(
709         dyType.kind(), std::move(x));
710   case TypeCategory::Derived:
711     return AsGenericExpr(Expr<SomeDerived>{WRAPPER<SomeDerived>{std::move(x)}});
712   }
713 }
714
715 // GetLastSymbol() returns the rightmost symbol in an object or procedure
716 // designator (which has perhaps been wrapped in an Expr<>), or a null pointer
717 // when none is found.
718 struct GetLastSymbolHelper
719     : public AnyTraverse<GetLastSymbolHelper, std::optional<const Symbol *>> {
720   using Result = std::optional<const Symbol *>;
721   using Base = AnyTraverse<GetLastSymbolHelper, Result>;
722   GetLastSymbolHelper() : Base{*this} {}
723   using Base::operator();
724   Result operator()(const Symbol &x) const { return &x; }
725   Result operator()(const Component &x) const { return &x.GetLastSymbol(); }
726   Result operator()(const NamedEntity &x) const { return &x.GetLastSymbol(); }
727   Result operator()(const ProcedureDesignator &x) const {
728     return x.GetSymbol();
729   }
730   template <typename T> Result operator()(const Expr<T> &x) const {
731     if constexpr (common::HasMember<T, AllIntrinsicTypes> ||
732         std::is_same_v<T, SomeDerived>) {
733       if (const auto *designator{std::get_if<Designator<T>>(&x.u)}) {
734         if (auto known{(*this)(*designator)}) {
735           return known;
736         }
737       }
738       return nullptr;
739     } else {
740       return (*this)(x.u);
741     }
742   }
743 };
744
745 template <typename A> const Symbol *GetLastSymbol(const A &x) {
746   if (auto known{GetLastSymbolHelper{}(x)}) {
747     return *known;
748   } else {
749     return nullptr;
750   }
751 }
752
753 // Convenience: If GetLastSymbol() succeeds on the argument, return its
754 // set of attributes, otherwise the empty set.
755 template <typename A> semantics::Attrs GetAttrs(const A &x) {
756   if (const Symbol * symbol{GetLastSymbol(x)}) {
757     return symbol->attrs();
758   } else {
759     return {};
760   }
761 }
762
763 // GetBaseObject()
764 template <typename A> std::optional<BaseObject> GetBaseObject(const A &) {
765   return std::nullopt;
766 }
767 template <typename T>
768 std::optional<BaseObject> GetBaseObject(const Designator<T> &x) {
769   return x.GetBaseObject();
770 }
771 template <typename T>
772 std::optional<BaseObject> GetBaseObject(const Expr<T> &x) {
773   return std::visit([](const auto &y) { return GetBaseObject(y); }, x.u);
774 }
775 template <typename A>
776 std::optional<BaseObject> GetBaseObject(const std::optional<A> &x) {
777   if (x) {
778     return GetBaseObject(*x);
779   } else {
780     return std::nullopt;
781   }
782 }
783
784 // Predicate: IsAllocatableOrPointer()
785 template <typename A> bool IsAllocatableOrPointer(const A &x) {
786   return GetAttrs(x).HasAny(
787       semantics::Attrs{semantics::Attr::POINTER, semantics::Attr::ALLOCATABLE});
788 }
789
790 // Procedure and pointer detection predicates
791 bool IsProcedure(const Expr<SomeType> &);
792 bool IsFunction(const Expr<SomeType> &);
793 bool IsProcedurePointer(const Expr<SomeType> &);
794 bool IsNullPointer(const Expr<SomeType> &);
795 bool IsObjectPointer(const Expr<SomeType> &, FoldingContext &);
796
797 // Extracts the chain of symbols from a designator, which has perhaps been
798 // wrapped in an Expr<>, removing all of the (co)subscripts.  The
799 // base object will be the first symbol in the result vector.
800 struct GetSymbolVectorHelper
801     : public Traverse<GetSymbolVectorHelper, SymbolVector> {
802   using Result = SymbolVector;
803   using Base = Traverse<GetSymbolVectorHelper, Result>;
804   using Base::operator();
805   GetSymbolVectorHelper() : Base{*this} {}
806   Result Default() { return {}; }
807   Result Combine(Result &&a, Result &&b) {
808     a.insert(a.end(), b.begin(), b.end());
809     return std::move(a);
810   }
811   Result operator()(const Symbol &) const;
812   Result operator()(const Component &) const;
813   Result operator()(const ArrayRef &) const;
814   Result operator()(const CoarrayRef &) const;
815 };
816 template <typename A> SymbolVector GetSymbolVector(const A &x) {
817   return GetSymbolVectorHelper{}(x);
818 }
819
820 // GetLastTarget() returns the rightmost symbol in an object designator's
821 // SymbolVector that has the POINTER or TARGET attribute, or a null pointer
822 // when none is found.
823 const Symbol *GetLastTarget(const SymbolVector &);
824
825 // Collects all of the Symbols in an expression
826 template <typename A> semantics::SymbolSet CollectSymbols(const A &);
827 extern template semantics::SymbolSet CollectSymbols(const Expr<SomeType> &);
828 extern template semantics::SymbolSet CollectSymbols(const Expr<SomeInteger> &);
829 extern template semantics::SymbolSet CollectSymbols(
830     const Expr<SubscriptInteger> &);
831
832 // Predicate: does a variable contain a vector-valued subscript (not a triplet)?
833 bool HasVectorSubscript(const Expr<SomeType> &);
834
835 // Utilities for attaching the location of the declaration of a symbol
836 // of interest to a message, if both pointers are non-null.  Handles
837 // the case of USE association gracefully.
838 parser::Message *AttachDeclaration(parser::Message &, const Symbol &);
839 parser::Message *AttachDeclaration(parser::Message *, const Symbol &);
840 template <typename MESSAGES, typename... A>
841 parser::Message *SayWithDeclaration(
842     MESSAGES &messages, const Symbol &symbol, A &&...x) {
843   return AttachDeclaration(messages.Say(std::forward<A>(x)...), symbol);
844 }
845
846 // Check for references to impure procedures; returns the name
847 // of one to complain about, if any exist.
848 std::optional<std::string> FindImpureCall(
849     FoldingContext &, const Expr<SomeType> &);
850 std::optional<std::string> FindImpureCall(
851     FoldingContext &, const ProcedureRef &);
852
853 // Predicate: is a scalar expression suitable for naive scalar expansion
854 // in the flattening of an array expression?
855 // TODO: capture such scalar expansions in temporaries, flatten everything
856 struct UnexpandabilityFindingVisitor
857     : public AnyTraverse<UnexpandabilityFindingVisitor> {
858   using Base = AnyTraverse<UnexpandabilityFindingVisitor>;
859   using Base::operator();
860   UnexpandabilityFindingVisitor() : Base{*this} {}
861   template <typename T> bool operator()(const FunctionRef<T> &) { return true; }
862   bool operator()(const CoarrayRef &) { return true; }
863 };
864
865 template <typename T> bool IsExpandableScalar(const Expr<T> &expr) {
866   return !UnexpandabilityFindingVisitor{}(expr);
867 }
868
869 // Common handling for procedure pointer compatibility of left- and right-hand
870 // sides.  Returns nullopt if they're compatible.  Otherwise, it returns a
871 // message that needs to be augmented by the names of the left and right sides
872 std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
873     const std::optional<characteristics::Procedure> &lhsProcedure,
874     const characteristics::Procedure *rhsProcedure);
875
876 // Scalar constant expansion
877 class ScalarConstantExpander {
878 public:
879   explicit ScalarConstantExpander(ConstantSubscripts &&extents)
880       : extents_{std::move(extents)} {}
881   ScalarConstantExpander(
882       ConstantSubscripts &&extents, std::optional<ConstantSubscripts> &&lbounds)
883       : extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {}
884   ScalarConstantExpander(
885       ConstantSubscripts &&extents, ConstantSubscripts &&lbounds)
886       : extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {}
887
888   template <typename A> A Expand(A &&x) const {
889     return std::move(x); // default case
890   }
891   template <typename T> Constant<T> Expand(Constant<T> &&x) {
892     auto expanded{x.Reshape(std::move(extents_))};
893     if (lbounds_) {
894       expanded.set_lbounds(std::move(*lbounds_));
895     }
896     return expanded;
897   }
898   template <typename T> Constant<T> Expand(Parentheses<T> &&x) {
899     return Expand(std::move(x)); // Constant<> can be parenthesized
900   }
901   template <typename T> Expr<T> Expand(Expr<T> &&x) {
902     return std::visit([&](auto &&x) { return Expr<T>{Expand(std::move(x))}; },
903         std::move(x.u));
904   }
905
906 private:
907   ConstantSubscripts extents_;
908   std::optional<ConstantSubscripts> lbounds_;
909 };
910
911 } // namespace Fortran::evaluate
912
913 namespace Fortran::semantics {
914
915 class Scope;
916
917 // These functions are used in Evaluate so they are defined here rather than in
918 // Semantics to avoid a link-time dependency on Semantics.
919 // All of these apply GetUltimate() or ResolveAssociations() to their arguments.
920 bool IsVariableName(const Symbol &);
921 bool IsPureProcedure(const Symbol &);
922 bool IsPureProcedure(const Scope &);
923 bool IsFunction(const Symbol &);
924 bool IsFunction(const Scope &);
925 bool IsProcedure(const Symbol &);
926 bool IsProcedure(const Scope &);
927 bool IsProcedurePointer(const Symbol &);
928 bool IsSaved(const Symbol &); // saved implicitly or explicitly
929 bool IsDummy(const Symbol &);
930 bool IsFunctionResult(const Symbol &);
931 bool IsKindTypeParameter(const Symbol &);
932 bool IsLenTypeParameter(const Symbol &);
933
934 // ResolveAssociations() traverses use associations and host associations
935 // like GetUltimate(), but also resolves through whole variable associations
936 // with ASSOCIATE(x => y) and related constructs.  GetAssociationRoot()
937 // applies ResolveAssociations() and then, in the case of resolution to
938 // a construct association with part of a variable that does not involve a
939 // vector subscript, returns the first symbol of that variable instead
940 // of the construct entity.
941 // (E.g., for ASSOCIATE(x => y%z), ResolveAssociations(x) returns x,
942 // while GetAssociationRoot(x) returns y.)
943 const Symbol &ResolveAssociations(const Symbol &);
944 const Symbol &GetAssociationRoot(const Symbol &);
945
946 const Symbol *FindCommonBlockContaining(const Symbol &);
947 int CountLenParameters(const DerivedTypeSpec &);
948 int CountNonConstantLenParameters(const DerivedTypeSpec &);
949 const Symbol &GetUsedModule(const UseDetails &);
950
951 } // namespace Fortran::semantics
952
953 #endif // FORTRAN_EVALUATE_TOOLS_H_