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/enum-set.h"
14#include "flang/Common/idioms.h"
15#include "flang/Common/template.h"
16#include "flang/Common/unwrap.h"
17#include "flang/Evaluate/constant.h"
18#include "flang/Evaluate/expression.h"
19#include "flang/Evaluate/shape.h"
20#include "flang/Evaluate/type.h"
21#include "flang/Parser/message.h"
22#include "flang/Semantics/attr.h"
23#include "flang/Semantics/scope.h"
24#include "flang/Semantics/symbol.h"
25#include <algorithm>
26#include <array>
27#include <optional>
28#include <set>
29#include <type_traits>
30#include <utility>
31
32namespace Fortran::evaluate {
33
34// Some expression predicates and extractors.
35
36// Predicate: true when an expression is a variable reference, not an
37// operation. Be advised: a call to a function that returns an object
38// pointer is a "variable" in Fortran (it can be the left-hand side of
39// an assignment).
40struct IsVariableHelper
41 : public AnyTraverse<IsVariableHelper, std::optional<bool>> {
42 using Result = std::optional<bool>; // effectively tri-state
43 using Base = AnyTraverse<IsVariableHelper, Result>;
44 IsVariableHelper() : Base{*this} {}
45 using Base::operator();
46 Result operator()(const StaticDataObject &) const { return false; }
47 Result operator()(const Symbol &) const;
48 Result operator()(const Component &) const;
49 Result operator()(const ArrayRef &) const;
50 Result operator()(const Substring &) const;
51 Result operator()(const CoarrayRef &) const { return true; }
52 Result operator()(const ComplexPart &) const { return true; }
53 Result operator()(const ProcedureDesignator &) const;
54 template <typename T> Result operator()(const ConditionalExpr<T> &) const {
55 return false;
56 }
57 template <typename T> Result operator()(const Expr<T> &x) const {
58 if constexpr (common::HasMember<T, AllIntrinsicTypes> ||
59 std::is_same_v<T, SomeDerived>) {
60 // Expression with a specific type
61 if (std::holds_alternative<Designator<T>>(x.u) ||
62 std::holds_alternative<FunctionRef<T>>(x.u)) {
63 if (auto known{(*this)(x.u)}) {
64 return known;
65 }
66 }
67 return false;
68 } else if constexpr (std::is_same_v<T, SomeType>) {
69 if (std::holds_alternative<ProcedureDesignator>(x.u) ||
70 std::holds_alternative<ProcedureRef>(x.u)) {
71 return false; // procedure pointer
72 } else {
73 return (*this)(x.u);
74 }
75 } else {
76 return (*this)(x.u);
77 }
78 }
79};
80
81template <typename A> bool IsVariable(const A &x) {
82 if (auto known{IsVariableHelper{}(x)}) {
83 return *known;
84 } else {
85 return false;
86 }
87}
88
89// Finds the corank of an entity, possibly packaged in various ways.
90// Unlike rank, only data references have corank > 0.
91int GetCorank(const ActualArgument &);
92static inline int GetCorank(const Symbol &symbol) { return symbol.Corank(); }
93template <typename A> int GetCorank(const A &) { return 0; }
94template <typename T> int GetCorank(const Designator<T> &designator) {
95 return designator.Corank();
96}
97template <typename T> int GetCorank(const Expr<T> &expr) {
98 return common::visit([](const auto &x) { return GetCorank(x); }, expr.u);
99}
100template <typename A> int GetCorank(const std::optional<A> &x) {
101 return x ? GetCorank(*x) : 0;
102}
103template <typename A> int GetCorank(const A *x) {
104 return x ? GetCorank(*x) : 0;
105}
106
107// Predicate: true when an expression is a coarray (corank > 0)
108template <typename A> bool IsCoarray(const A &x) { return GetCorank(x) > 0; }
109
110// Generalizing packagers: these take operations and expressions of more
111// specific types and wrap them in Expr<> containers of more abstract types.
112
113template <typename A> common::IfNoLvalue<Expr<ResultType<A>>, A> AsExpr(A &&x) {
114 return Expr<ResultType<A>>{std::move(x)};
115}
116
117template <typename T, typename U = typename Relational<T>::Result>
118Expr<U> AsExpr(Relational<T> &&x) {
119 // The variant in Expr<Type<TypeCategory::Logical, KIND>> only contains
120 // Relational<SomeType>, not other Relational<T>s. Wrap the Relational<T>
121 // in Relational<SomeType> before creating Expr<>.
122 return Expr<U>(Relational<SomeType>{std::move(x)});
123}
124
125template <typename T> Expr<T> AsExpr(Expr<T> &&x) {
126 static_assert(IsSpecificIntrinsicType<T>);
127 return std::move(x);
128}
129
130template <TypeCategory CATEGORY>
131Expr<SomeKind<CATEGORY>> AsCategoryExpr(Expr<SomeKind<CATEGORY>> &&x) {
132 return std::move(x);
133}
134
135template <typename A>
136common::IfNoLvalue<Expr<SomeType>, A> AsGenericExpr(A &&x) {
137 if constexpr (common::HasMember<A, TypelessExpression>) {
138 return Expr<SomeType>{std::move(x)};
139 } else {
140 return Expr<SomeType>{AsCategoryExpr(std::move(x))};
141 }
142}
143
144inline Expr<SomeType> AsGenericExpr(Expr<SomeType> &&x) { return std::move(x); }
145
146// These overloads wrap DataRefs and simple whole variables up into
147// generic expressions if they have a known type.
148std::optional<Expr<SomeType>> AsGenericExpr(DataRef &&);
149std::optional<Expr<SomeType>> AsGenericExpr(const Symbol &);
150
151// Propagate std::optional from input to output.
152template <typename A>
153std::optional<Expr<SomeType>> AsGenericExpr(std::optional<A> &&x) {
154 if (x) {
155 return AsGenericExpr(std::move(*x));
156 } else {
157 return std::nullopt;
158 }
159}
160
161template <typename A>
162common::IfNoLvalue<Expr<SomeKind<ResultType<A>::category>>, A> AsCategoryExpr(
163 A &&x) {
164 return Expr<SomeKind<ResultType<A>::category>>{AsExpr(std::move(x))};
165}
166
167Expr<SomeType> Parenthesize(Expr<SomeType> &&);
168
169template <typename A> constexpr bool IsNumericCategoryExpr() {
170 if constexpr (common::HasMember<A, TypelessExpression>) {
171 return false;
172 } else {
173 return common::HasMember<ResultType<A>, NumericCategoryTypes>;
174 }
175}
176
177// Specializing extractor. If an Expr wraps some type of object, perhaps
178// in several layers, return a pointer to it; otherwise null. Also works
179// with expressions contained in ActualArgument.
180template <typename A, typename B>
181auto UnwrapExpr(B &x) -> common::Constify<A, B> * {
182 using Ty = std::decay_t<B>;
183 if constexpr (std::is_same_v<A, Ty>) {
184 return &x;
185 } else if constexpr (std::is_same_v<Ty, ActualArgument>) {
186 if (auto *expr{x.UnwrapExpr()}) {
187 return UnwrapExpr<A>(*expr);
188 }
189 } else if constexpr (std::is_same_v<Ty, Expr<SomeType>>) {
190 return common::visit([](auto &x) { return UnwrapExpr<A>(x); }, x.u);
191 } else if constexpr (!common::HasMember<A, TypelessExpression>) {
192 if constexpr (std::is_same_v<Ty, Expr<ResultType<A>>> ||
193 std::is_same_v<Ty, Expr<SomeKind<ResultType<A>::category>>>) {
194 return common::visit([](auto &x) { return UnwrapExpr<A>(x); }, x.u);
195 }
196 }
197 return nullptr;
198}
199
200template <typename A, typename B>
201const A *UnwrapExpr(const std::optional<B> &x) {
202 if (x) {
203 return UnwrapExpr<A>(*x);
204 } else {
205 return nullptr;
206 }
207}
208
209template <typename A, typename B> A *UnwrapExpr(std::optional<B> &x) {
210 if (x) {
211 return UnwrapExpr<A>(*x);
212 } else {
213 return nullptr;
214 }
215}
216
217template <typename A, typename B> const A *UnwrapExpr(const B *x) {
218 if (x) {
219 return UnwrapExpr<A>(*x);
220 } else {
221 return nullptr;
222 }
223}
224
225template <typename A, typename B> A *UnwrapExpr(B *x) {
226 if (x) {
227 return UnwrapExpr<A>(*x);
228 } else {
229 return nullptr;
230 }
231}
232
233// A variant of UnwrapExpr above that also skips through (parentheses)
234// and conversions of kinds within a category. Useful for extracting LEN
235// type parameter inquiries, at least.
236template <typename A, typename B>
237auto UnwrapConvertedExpr(B &x) -> common::Constify<A, B> * {
238 using Ty = std::decay_t<B>;
239 if constexpr (std::is_same_v<A, Ty>) {
240 return &x;
241 } else if constexpr (std::is_same_v<Ty, ActualArgument>) {
242 if (auto *expr{x.UnwrapExpr()}) {
243 return UnwrapConvertedExpr<A>(*expr);
244 }
245 } else if constexpr (std::is_same_v<Ty, Expr<SomeType>>) {
246 return common::visit(
247 [](auto &x) { return UnwrapConvertedExpr<A>(x); }, x.u);
248 } else {
249 using DesiredResult = ResultType<A>;
250 if constexpr (std::is_same_v<Ty, Expr<DesiredResult>> ||
251 std::is_same_v<Ty, Expr<SomeKind<DesiredResult::category>>>) {
252 return common::visit(
253 [](auto &x) { return UnwrapConvertedExpr<A>(x); }, x.u);
254 } else {
255 using ThisResult = ResultType<B>;
256 if constexpr (std::is_same_v<Ty, Expr<ThisResult>>) {
257 return common::visit(
258 [](auto &x) { return UnwrapConvertedExpr<A>(x); }, x.u);
259 } else if constexpr (std::is_same_v<Ty, Parentheses<ThisResult>> ||
260 std::is_same_v<Ty, Convert<ThisResult, DesiredResult::category>>) {
261 return common::visit(
262 [](auto &x) { return UnwrapConvertedExpr<A>(x); }, x.left().u);
263 }
264 }
265 }
266 return nullptr;
267}
268
269// UnwrapProcedureRef() returns a pointer to a ProcedureRef when the whole
270// expression is a reference to a procedure.
271template <typename A> inline const ProcedureRef *UnwrapProcedureRef(const A &) {
272 return nullptr;
273}
274
275inline const ProcedureRef *UnwrapProcedureRef(const ProcedureRef &proc) {
276 // Reference to subroutine or to a function that returns
277 // an object pointer or procedure pointer
278 return &proc;
279}
280
281template <typename T>
282inline const ProcedureRef *UnwrapProcedureRef(const FunctionRef<T> &func) {
283 return &func; // reference to a function returning a non-pointer
284}
285
286template <typename T>
287inline const ProcedureRef *UnwrapProcedureRef(const Expr<T> &expr) {
288 return common::visit(
289 [](const auto &x) { return UnwrapProcedureRef(x); }, expr.u);
290}
291
292// When an expression is a "bare" LEN= derived type parameter inquiry,
293// possibly wrapped in integer kind conversions &/or parentheses, return
294// a pointer to the Symbol with TypeParamDetails.
295template <typename A> const Symbol *ExtractBareLenParameter(const A &expr) {
296 if (const auto *typeParam{
297 UnwrapConvertedExpr<evaluate::TypeParamInquiry>(expr)}) {
298 if (!typeParam->base()) {
299 const Symbol &symbol{typeParam->parameter()};
300 if (const auto *tpd{symbol.detailsIf<semantics::TypeParamDetails>()}) {
301 if (tpd->attr() == common::TypeParamAttr::Len) {
302 return &symbol;
303 }
304 }
305 }
306 }
307 return nullptr;
308}
309
310// If an expression simply wraps a DataRef, extract and return it.
311// The Boolean arguments control the handling of Substring and ComplexPart
312// references: when true (not default), it extracts the base DataRef
313// of a substring or complex part.
314template <typename A>
315common::IfNoLvalue<std::optional<DataRef>, A> ExtractDataRef(
316 const A &x, bool intoSubstring, bool intoComplexPart) {
317 if constexpr (common::HasMember<decltype(x), decltype(DataRef::u)>) {
318 return DataRef{x};
319 } else {
320 return std::nullopt; // default base case
321 }
322}
323
324std::optional<DataRef> ExtractSubstringBase(const Substring &);
325
326inline std::optional<DataRef> ExtractDataRef(const Substring &x,
327 bool intoSubstring = false, bool intoComplexPart = false) {
328 if (intoSubstring) {
329 return ExtractSubstringBase(x);
330 } else {
331 return std::nullopt;
332 }
333}
334inline std::optional<DataRef> ExtractDataRef(const ComplexPart &x,
335 bool intoSubstring = false, bool intoComplexPart = false) {
336 if (intoComplexPart) {
337 return x.complex();
338 } else {
339 return std::nullopt;
340 }
341}
342template <typename T>
343std::optional<DataRef> ExtractDataRef(const Designator<T> &d,
344 bool intoSubstring = false, bool intoComplexPart = false) {
345 return common::visit(
346 [=](const auto &x) -> std::optional<DataRef> {
347 return ExtractDataRef(x, intoSubstring, intoComplexPart);
348 },
349 d.u);
350}
351template <typename T>
352std::optional<DataRef> ExtractDataRef(const Expr<T> &expr,
353 bool intoSubstring = false, bool intoComplexPart = false) {
354 return common::visit(
355 [=](const auto &x) {
356 return ExtractDataRef(x, intoSubstring, intoComplexPart);
357 },
358 expr.u);
359}
360template <typename A>
361std::optional<DataRef> ExtractDataRef(const std::optional<A> &x,
362 bool intoSubstring = false, bool intoComplexPart = false) {
363 if (x) {
364 return ExtractDataRef(*x, intoSubstring, intoComplexPart);
365 } else {
366 return std::nullopt;
367 }
368}
369template <typename A>
370std::optional<DataRef> ExtractDataRef(
371 A *p, bool intoSubstring = false, bool intoComplexPart = false) {
372 if (p) {
373 return ExtractDataRef(std::as_const(*p), intoSubstring, intoComplexPart);
374 } else {
375 return std::nullopt;
376 }
377}
378std::optional<DataRef> ExtractDataRef(const ActualArgument &,
379 bool intoSubstring = false, bool intoComplexPart = false);
380
381// Predicate: is an expression is an array element reference?
382template <typename T>
383const Symbol *IsArrayElement(const Expr<T> &expr, bool intoSubstring = true,
384 bool skipComponents = false) {
385 if (auto dataRef{ExtractDataRef(expr, intoSubstring)}) {
386 for (const DataRef *ref{&*dataRef}; ref;) {
387 if (const Component * component{std::get_if<Component>(&ref->u)}) {
388 ref = skipComponents ? &component->base() : nullptr;
389 } else if (const auto *coarrayRef{std::get_if<CoarrayRef>(&ref->u)}) {
390 ref = &coarrayRef->base();
391 } else if (const auto *arrayRef{std::get_if<ArrayRef>(&ref->u)}) {
392 return &arrayRef->GetLastSymbol();
393 } else {
394 break;
395 }
396 }
397 }
398 return nullptr;
399}
400
401template <typename T>
402bool isStructureComponent(const Fortran::evaluate::Expr<T> &expr) {
403 if (auto dataRef{ExtractDataRef(expr, /*intoSubstring=*/false)}) {
404 const Fortran::evaluate::DataRef *ref{&*dataRef};
405 return std::holds_alternative<Fortran::evaluate::Component>(ref->u);
406 }
407
408 return false;
409}
410
411template <typename A>
412std::optional<NamedEntity> ExtractNamedEntity(const A &x) {
413 if (auto dataRef{ExtractDataRef(x)}) {
414 return common::visit(
415 common::visitors{
416 [](SymbolRef &&symbol) -> std::optional<NamedEntity> {
417 return NamedEntity{symbol};
418 },
419 [](Component &&component) -> std::optional<NamedEntity> {
420 return NamedEntity{std::move(component)};
421 },
422 [](auto &&) { return std::optional<NamedEntity>{}; },
423 },
424 std::move(dataRef->u));
425 } else {
426 return std::nullopt;
427 }
428}
429
431 template <typename A> std::optional<CoarrayRef> operator()(const A &) const {
432 return std::nullopt;
433 }
434 std::optional<CoarrayRef> operator()(const CoarrayRef &x) const { return x; }
435 template <typename A>
436 std::optional<CoarrayRef> operator()(const Expr<A> &expr) const {
437 return common::visit(*this, expr.u);
438 }
439 std::optional<CoarrayRef> operator()(const DataRef &dataRef) const {
440 return common::visit(*this, dataRef.u);
441 }
442 std::optional<CoarrayRef> operator()(const NamedEntity &named) const {
443 if (const Component * component{named.UnwrapComponent()}) {
444 return (*this)(*component);
445 } else {
446 return std::nullopt;
447 }
448 }
449 std::optional<CoarrayRef> operator()(const ProcedureDesignator &des) const {
450 if (const auto *component{
451 std::get_if<common::CopyableIndirection<Component>>(&des.u)}) {
452 return (*this)(component->value());
453 } else {
454 return std::nullopt;
455 }
456 }
457 std::optional<CoarrayRef> operator()(const Component &component) const {
458 return (*this)(component.base());
459 }
460 std::optional<CoarrayRef> operator()(const ArrayRef &arrayRef) const {
461 return (*this)(arrayRef.base());
462 }
463};
464
465static inline std::optional<CoarrayRef> ExtractCoarrayRef(const DataRef &x) {
467}
468
469template <typename A> std::optional<CoarrayRef> ExtractCoarrayRef(const A &x) {
470 if (auto dataRef{ExtractDataRef(x, true)}) {
471 return ExtractCoarrayRef(*dataRef);
472 } else {
474 }
475}
476
477template <typename TARGET> struct ExtractFromExprDesignatorHelper {
478 template <typename T> static std::optional<TARGET> visit(T &&) {
479 return std::nullopt;
480 }
481
482 static std::optional<TARGET> visit(const TARGET &t) { return t; }
483
484 template <typename T>
485 static std::optional<TARGET> visit(const Designator<T> &e) {
486 return common::visit([](auto &&s) { return visit(s); }, e.u);
487 }
488
489 template <typename T> static std::optional<TARGET> visit(const Expr<T> &e) {
490 return common::visit([](auto &&s) { return visit(s); }, e.u);
491 }
492};
493
494template <typename A> std::optional<Substring> ExtractSubstring(const A &x) {
495 return ExtractFromExprDesignatorHelper<Substring>::visit(x);
496}
497
498template <typename A>
499std::optional<ComplexPart> ExtractComplexPart(const A &x) {
500 return ExtractFromExprDesignatorHelper<ComplexPart>::visit(x);
501}
502
503// If an expression is simply a whole symbol data designator,
504// extract and return that symbol, else null.
505const Symbol *UnwrapWholeSymbolDataRef(const DataRef &);
506const Symbol *UnwrapWholeSymbolDataRef(const std::optional<DataRef> &);
507template <typename A> const Symbol *UnwrapWholeSymbolDataRef(const A &x) {
508 return UnwrapWholeSymbolDataRef(ExtractDataRef(x));
509}
510
511// If an expression is a whole symbol or a whole component desginator,
512// extract and return that symbol, else null.
513const Symbol *UnwrapWholeSymbolOrComponentDataRef(const DataRef &);
514const Symbol *UnwrapWholeSymbolOrComponentDataRef(
515 const std::optional<DataRef> &);
516template <typename A>
517const Symbol *UnwrapWholeSymbolOrComponentDataRef(const A &x) {
518 return UnwrapWholeSymbolOrComponentDataRef(ExtractDataRef(x));
519}
520
521// If an expression is a whole symbol or a whole component designator,
522// potentially followed by an image selector, extract and return that symbol,
523// else null.
524const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(const DataRef &);
525const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(
526 const std::optional<DataRef> &);
527template <typename A>
528const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(const A &x) {
529 return UnwrapWholeSymbolOrComponentOrCoarrayRef(ExtractDataRef(x));
530}
531
532// GetFirstSymbol(A%B%C[I]%D) -> A
533template <typename A> const Symbol *GetFirstSymbol(const A &x) {
534 if (auto dataRef{ExtractDataRef(x, true)}) {
535 return &dataRef->GetFirstSymbol();
536 } else {
537 return nullptr;
538 }
539}
540
541// GetLastPointerSymbol(A%PTR1%B%PTR2%C) -> PTR2
542const Symbol *GetLastPointerSymbol(const evaluate::DataRef &);
543
544// Creation of conversion expressions can be done to either a known
545// specific intrinsic type with ConvertToType<T>(x) or by converting
546// one arbitrary expression to the type of another with ConvertTo(to, from).
547
548template <typename TO, TypeCategory FROMCAT>
549Expr<TO> ConvertToType(Expr<SomeKind<FROMCAT>> &&x) {
550 static_assert(IsSpecificIntrinsicType<TO>);
551 if constexpr (FROMCAT == TO::category) {
552 if (auto *already{std::get_if<Expr<TO>>(&x.u)}) {
553 return std::move(*already);
554 } else {
555 return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}};
556 }
557 } else if constexpr (TO::category == TypeCategory::Complex) {
558 using Part = typename TO::Part;
559 Scalar<Part> zero;
561 ConvertToType<Part>(std::move(x)), Expr<Part>{Constant<Part>{zero}}}};
562 } else if constexpr (FROMCAT == TypeCategory::Complex) {
563 // Extract and convert the real component of a complex value
564 return common::visit(
565 [&](auto &&z) {
566 using ZType = ResultType<decltype(z)>;
567 using Part = typename ZType::Part;
568 return ConvertToType<TO, TypeCategory::Real>(Expr<SomeReal>{
569 Expr<Part>{ComplexComponent<Part::kind>{false, std::move(z)}}});
570 },
571 std::move(x.u));
572 } else {
573 return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}};
574 }
575}
576
577template <typename TO, TypeCategory FROMCAT, int FROMKIND>
578Expr<TO> ConvertToType(Expr<Type<FROMCAT, FROMKIND>> &&x) {
579 return ConvertToType<TO, FROMCAT>(Expr<SomeKind<FROMCAT>>{std::move(x)});
580}
581
582template <typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
583 static_assert(IsSpecificIntrinsicType<TO>);
584 if constexpr (TO::category == TypeCategory::Integer ||
585 TO::category == TypeCategory::Unsigned) {
586 return Expr<TO>{
587 Constant<TO>{Scalar<TO>::ConvertUnsigned(std::move(x)).value}};
588 } else {
589 static_assert(TO::category == TypeCategory::Real);
590 using Word = typename Scalar<TO>::Word;
591 return Expr<TO>{
592 Constant<TO>{Scalar<TO>{Word::ConvertUnsigned(std::move(x)).value}}};
593 }
594}
595
596template <typename T> bool IsBOZLiteral(const Expr<T> &expr) {
597 return std::holds_alternative<BOZLiteralConstant>(expr.u);
598}
599
600// Conversions to dynamic types
601std::optional<Expr<SomeType>> ConvertToType(
602 const DynamicType &, Expr<SomeType> &&);
603std::optional<Expr<SomeType>> ConvertToType(
604 const DynamicType &, std::optional<Expr<SomeType>> &&);
605std::optional<Expr<SomeType>> ConvertToType(const Symbol &, Expr<SomeType> &&);
606std::optional<Expr<SomeType>> ConvertToType(
607 const Symbol &, std::optional<Expr<SomeType>> &&);
608
609// Conversions to the type of another expression
610template <TypeCategory TC, int TK, typename FROM>
611common::IfNoLvalue<Expr<Type<TC, TK>>, FROM> ConvertTo(
612 const Expr<Type<TC, TK>> &, FROM &&x) {
613 return ConvertToType<Type<TC, TK>>(std::move(x));
614}
615
616template <TypeCategory TC, typename FROM>
617common::IfNoLvalue<Expr<SomeKind<TC>>, FROM> ConvertTo(
618 const Expr<SomeKind<TC>> &to, FROM &&from) {
619 return common::visit(
620 [&](const auto &toKindExpr) {
621 using KindExpr = std::decay_t<decltype(toKindExpr)>;
622 return AsCategoryExpr(
623 ConvertToType<ResultType<KindExpr>>(std::move(from)));
624 },
625 to.u);
626}
627
628template <typename FROM>
629common::IfNoLvalue<Expr<SomeType>, FROM> ConvertTo(
630 const Expr<SomeType> &to, FROM &&from) {
631 return common::visit(
632 [&](const auto &toCatExpr) {
633 return AsGenericExpr(ConvertTo(toCatExpr, std::move(from)));
634 },
635 to.u);
636}
637
638// Convert an expression of some known category to a dynamically chosen
639// kind of some category (usually but not necessarily distinct).
640template <TypeCategory TOCAT, typename VALUE> struct ConvertToKindHelper {
641 using Result = std::optional<Expr<SomeKind<TOCAT>>>;
642 using Types = CategoryTypes<TOCAT>;
643 ConvertToKindHelper(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
644 template <typename T> Result Test() {
645 if (kind == T::kind) {
646 return std::make_optional(
647 AsCategoryExpr(ConvertToType<T>(std::move(value))));
648 }
649 return std::nullopt;
650 }
651 int kind;
652 VALUE value;
653};
654
655template <TypeCategory TOCAT, typename VALUE>
656common::IfNoLvalue<Expr<SomeKind<TOCAT>>, VALUE> ConvertToKind(
657 int kind, VALUE &&x) {
658 auto result{common::SearchTypes(
659 ConvertToKindHelper<TOCAT, VALUE>{kind, std::move(x)})};
660 CHECK(result.has_value());
661 return *result;
662}
663
664// Given a type category CAT, SameKindExprs<CAT, N> is a variant that
665// holds an arrays of expressions of the same supported kind in that
666// category.
667template <typename A, int N = 2> using SameExprs = std::array<Expr<A>, N>;
668template <int N = 2> struct SameKindExprsHelper {
669 template <typename A> using SameExprs = std::array<Expr<A>, N>;
670};
671template <TypeCategory CAT, int N = 2>
672using SameKindExprs =
673 common::MapTemplate<SameKindExprsHelper<N>::template SameExprs,
674 CategoryTypes<CAT>>;
675
676// Given references to two expressions of arbitrary kind in the same type
677// category, convert one to the kind of the other when it has the smaller kind,
678// then return them in a type-safe package.
679template <TypeCategory CAT>
680SameKindExprs<CAT, 2> AsSameKindExprs(
682 return common::visit(
683 [&](auto &&kx, auto &&ky) -> SameKindExprs<CAT, 2> {
684 using XTy = ResultType<decltype(kx)>;
685 using YTy = ResultType<decltype(ky)>;
686 if constexpr (std::is_same_v<XTy, YTy>) {
687 return {SameExprs<XTy>{std::move(kx), std::move(ky)}};
688 } else if constexpr (XTy::kind < YTy::kind) {
689 return {SameExprs<YTy>{ConvertTo(ky, std::move(kx)), std::move(ky)}};
690 } else {
691 return {SameExprs<XTy>{std::move(kx), ConvertTo(kx, std::move(ky))}};
692 }
693#if !__clang__ && 100 * __GNUC__ + __GNUC_MINOR__ == 801
694 // Silence a bogus warning about a missing return with G++ 8.1.0.
695 // Doesn't execute, but must be correctly typed.
696 CHECK(!"can't happen");
697 return {SameExprs<XTy>{std::move(kx), std::move(kx)}};
698#endif
699 },
700 std::move(x.u), std::move(y.u));
701}
702
703// Ensure that both operands of an intrinsic REAL operation (or CMPLX()
704// constructor) are INTEGER or REAL, then convert them as necessary to the
705// same kind of REAL.
706using ConvertRealOperandsResult =
707 std::optional<SameKindExprs<TypeCategory::Real, 2>>;
708ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &,
709 Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
710
711// Per F'2018 R718, if both components are INTEGER, they are both converted
712// to default REAL and the result is default COMPLEX. Otherwise, the
713// kind of the result is the kind of most precise REAL component, and the other
714// component is converted if necessary to its type.
715std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
716 Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
717std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
718 std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&,
719 int defaultRealKind);
720
721template <typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
722 using Ty = TypeOf<A>;
723 static_assert(
724 std::is_same_v<Scalar<Ty>, std::decay_t<A>>, "TypeOf<> is broken");
725 return Expr<TypeOf<A>>{Constant<Ty>{x}};
726}
727
728// Combine two expressions of the same specific numeric type with an operation
729// to produce a new expression.
730template <template <typename> class OPR, typename SPECIFIC>
732 static_assert(IsSpecificIntrinsicType<SPECIFIC>);
733 return AsExpr(OPR<SPECIFIC>{std::move(x), std::move(y)});
734}
735
736// Given two expressions of arbitrary kind in the same intrinsic type
737// category, convert one of them if necessary to the larger kind of the
738// other, then combine the resulting homogenized operands with a given
739// operation, returning a new expression in the same type category.
740template <template <typename> class OPR, TypeCategory CAT>
741Expr<SomeKind<CAT>> PromoteAndCombine(
743 return common::visit(
744 [](auto &&xy) {
745 using Ty = ResultType<decltype(xy[0])>;
746 return AsCategoryExpr(
747 Combine<OPR, Ty>(std::move(xy[0]), std::move(xy[1])));
748 },
749 AsSameKindExprs(std::move(x), std::move(y)));
750}
751
752// Given two expressions of arbitrary type, try to combine them with a
753// binary numeric operation (e.g., Add), possibly with data type conversion of
754// one of the operands to the type of the other. Handles special cases with
755// typeless literal operands and with REAL/COMPLEX exponentiation to INTEGER
756// powers.
757template <template <typename> class OPR>
758std::optional<Expr<SomeType>> NumericOperation(parser::ContextualMessages &,
759 Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
760
761extern template std::optional<Expr<SomeType>> NumericOperation<Power>(
762 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
763 int defaultRealKind);
764extern template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
765 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
766 int defaultRealKind);
767extern template std::optional<Expr<SomeType>> NumericOperation<Divide>(
768 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
769 int defaultRealKind);
770extern template std::optional<Expr<SomeType>> NumericOperation<Add>(
771 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
772 int defaultRealKind);
773extern template std::optional<Expr<SomeType>> NumericOperation<Subtract>(
774 parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
775 int defaultRealKind);
776
777std::optional<Expr<SomeType>> Negation(
778 parser::ContextualMessages &, Expr<SomeType> &&);
779
780// Given two expressions of arbitrary type, try to combine them with a
781// relational operator (e.g., .LT.), possibly with data type conversion.
782std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &,
783 RelationalOperator, Expr<SomeType> &&, Expr<SomeType> &&);
784
785// Create a relational operation between two identically-typed operands
786// and wrap it up in an Expr<LogicalResult>.
787template <typename T>
788Expr<LogicalResult> PackageRelation(
789 RelationalOperator opr, Expr<T> &&x, Expr<T> &&y) {
790 static_assert(IsSpecificIntrinsicType<T>);
791 return Expr<LogicalResult>{
792 Relational<SomeType>{Relational<T>{opr, std::move(x), std::move(y)}}};
793}
794
795template <int K>
798 return AsExpr(Not<K>{std::move(x)});
799}
800
801Expr<SomeLogical> LogicalNegation(Expr<SomeLogical> &&);
802
803template <int K>
804Expr<Type<TypeCategory::Logical, K>> BinaryLogicalOperation(LogicalOperator opr,
807 return AsExpr(LogicalOperation<K>{opr, std::move(x), std::move(y)});
808}
809
810Expr<SomeLogical> BinaryLogicalOperation(
811 LogicalOperator, Expr<SomeLogical> &&, Expr<SomeLogical> &&);
812
813// Convenience functions and operator overloadings for expression construction.
814// These interfaces are defined only for those situations that can never
815// emit any message. Use the more general templates (above) in other
816// situations.
817
818template <TypeCategory C, int K>
819Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x) {
820 return AsExpr(Negate<Type<C, K>>{std::move(x)});
821}
822
823template <TypeCategory C, int K>
824Expr<Type<C, K>> operator+(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
825 return AsExpr(Combine<Add, Type<C, K>>(std::move(x), std::move(y)));
826}
827
828template <TypeCategory C, int K>
829Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
830 return AsExpr(Combine<Subtract, Type<C, K>>(std::move(x), std::move(y)));
831}
832
833template <TypeCategory C, int K>
834Expr<Type<C, K>> operator*(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
835 return AsExpr(Combine<Multiply, Type<C, K>>(std::move(x), std::move(y)));
836}
837
838template <TypeCategory C, int K>
839Expr<Type<C, K>> operator/(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
840 return AsExpr(Combine<Divide, Type<C, K>>(std::move(x), std::move(y)));
841}
842
843template <TypeCategory C> Expr<SomeKind<C>> operator-(Expr<SomeKind<C>> &&x) {
844 return common::visit(
845 [](auto &xk) { return Expr<SomeKind<C>>{-std::move(xk)}; }, x.u);
846}
847
848template <TypeCategory CAT>
849Expr<SomeKind<CAT>> operator+(
851 return PromoteAndCombine<Add, CAT>(std::move(x), std::move(y));
852}
853
854template <TypeCategory CAT>
855Expr<SomeKind<CAT>> operator-(
857 return PromoteAndCombine<Subtract, CAT>(std::move(x), std::move(y));
858}
859
860template <TypeCategory CAT>
861Expr<SomeKind<CAT>> operator*(
863 return PromoteAndCombine<Multiply, CAT>(std::move(x), std::move(y));
864}
865
866template <TypeCategory CAT>
867Expr<SomeKind<CAT>> operator/(
869 return PromoteAndCombine<Divide, CAT>(std::move(x), std::move(y));
870}
871
872// A utility for use with common::SearchTypes to create generic expressions
873// when an intrinsic type category for (say) a variable is known
874// but the kind parameter value is not.
875template <TypeCategory CAT, template <typename> class TEMPLATE, typename VALUE>
876struct TypeKindVisitor {
877 using Result = std::optional<Expr<SomeType>>;
878 using Types = CategoryTypes<CAT>;
879
880 TypeKindVisitor(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
881 TypeKindVisitor(int k, const VALUE &x) : kind{k}, value{x} {}
882
883 template <typename T> Result Test() {
884 if (kind == T::kind) {
885 return AsGenericExpr(TEMPLATE<T>{std::move(value)});
886 }
887 return std::nullopt;
888 }
889
890 int kind;
891 VALUE value;
892};
893
894// TypedWrapper() wraps a object in an explicitly typed representation
895// (e.g., Designator<> or FunctionRef<>) that has been instantiated on
896// a dynamically chosen Fortran type.
897template <TypeCategory CATEGORY, template <typename> typename WRAPPER,
898 typename WRAPPED>
899common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> WrapperHelper(
900 int kind, WRAPPED &&x) {
901 return common::SearchTypes(
903}
904
905template <template <typename> typename WRAPPER, typename WRAPPED>
906common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> TypedWrapper(
907 const DynamicType &dyType, WRAPPED &&x) {
908 switch (dyType.category()) {
909 SWITCH_COVERS_ALL_CASES
910 case TypeCategory::Integer:
911 return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>(
912 dyType.kind(), std::move(x));
913 case TypeCategory::Unsigned:
914 return WrapperHelper<TypeCategory::Unsigned, WRAPPER, WRAPPED>(
915 dyType.kind(), std::move(x));
916 case TypeCategory::Real:
917 return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>(
918 dyType.kind(), std::move(x));
919 case TypeCategory::Complex:
920 return WrapperHelper<TypeCategory::Complex, WRAPPER, WRAPPED>(
921 dyType.kind(), std::move(x));
922 case TypeCategory::Character:
923 return WrapperHelper<TypeCategory::Character, WRAPPER, WRAPPED>(
924 dyType.kind(), std::move(x));
925 case TypeCategory::Logical:
926 return WrapperHelper<TypeCategory::Logical, WRAPPER, WRAPPED>(
927 dyType.kind(), std::move(x));
928 case TypeCategory::Derived:
929 return AsGenericExpr(Expr<SomeDerived>{WRAPPER<SomeDerived>{std::move(x)}});
930 }
931}
932
933// GetLastSymbol() returns the rightmost symbol in an object or procedure
934// designator (which has perhaps been wrapped in an Expr<>), or a null pointer
935// when none is found. It will return an ASSOCIATE construct entity's symbol
936// rather than descending into its expression.
937struct GetLastSymbolHelper
938 : public AnyTraverse<GetLastSymbolHelper, std::optional<const Symbol *>> {
939 using Result = std::optional<const Symbol *>;
940 using Base = AnyTraverse<GetLastSymbolHelper, Result>;
941 GetLastSymbolHelper() : Base{*this} {}
942 using Base::operator();
943 Result operator()(const Symbol &x) const { return &x; }
944 Result operator()(const Component &x) const { return &x.GetLastSymbol(); }
945 Result operator()(const NamedEntity &x) const { return &x.GetLastSymbol(); }
946 Result operator()(const ProcedureDesignator &x) const {
947 return x.GetSymbol();
948 }
949 template <typename T> Result operator()(const Expr<T> &x) const {
950 if constexpr (common::HasMember<T, AllIntrinsicTypes> ||
951 std::is_same_v<T, SomeDerived>) {
952 if (const auto *designator{std::get_if<Designator<T>>(&x.u)}) {
953 if (auto known{(*this)(*designator)}) {
954 return known;
955 }
956 }
957 return nullptr;
958 } else {
959 return (*this)(x.u);
960 }
961 }
962};
963
964template <typename A> const Symbol *GetLastSymbol(const A &x) {
965 if (auto known{GetLastSymbolHelper{}(x)}) {
966 return *known;
967 } else {
968 return nullptr;
969 }
970}
971
972// For everyday variables: if GetLastSymbol() succeeds on the argument, return
973// its set of attributes, otherwise the empty set. Also works on variables that
974// are pointer results of functions.
975template <typename A> semantics::Attrs GetAttrs(const A &x) {
976 if (const Symbol * symbol{GetLastSymbol(x)}) {
977 return symbol->attrs();
978 } else {
979 return {};
980 }
981}
982
983template <>
984inline semantics::Attrs GetAttrs<Expr<SomeType>>(const Expr<SomeType> &x) {
985 if (IsVariable(x)) {
986 if (const auto *procRef{UnwrapProcedureRef(x)}) {
987 if (const Symbol * interface{procRef->proc().GetInterfaceSymbol()}) {
988 if (const auto *details{
989 interface->detailsIf<semantics::SubprogramDetails>()}) {
990 if (details->isFunction() &&
991 details->result().attrs().test(semantics::Attr::POINTER)) {
992 // N.B.: POINTER becomes TARGET in SetAttrsFromAssociation()
993 return details->result().attrs();
994 }
995 }
996 }
997 }
998 }
999 if (const Symbol * symbol{GetLastSymbol(x)}) {
1000 return symbol->attrs();
1001 } else {
1002 return {};
1003 }
1004}
1005
1006template <typename A> semantics::Attrs GetAttrs(const std::optional<A> &x) {
1007 if (x) {
1008 return GetAttrs(*x);
1009 } else {
1010 return {};
1011 }
1012}
1013
1014// GetBaseObject()
1015template <typename A> std::optional<BaseObject> GetBaseObject(const A &) {
1016 return std::nullopt;
1017}
1018template <typename T>
1019std::optional<BaseObject> GetBaseObject(const Designator<T> &x) {
1020 return x.GetBaseObject();
1021}
1022template <typename T>
1023std::optional<BaseObject> GetBaseObject(const Expr<T> &x) {
1024 return common::visit([](const auto &y) { return GetBaseObject(y); }, x.u);
1025}
1026template <typename A>
1027std::optional<BaseObject> GetBaseObject(const std::optional<A> &x) {
1028 if (x) {
1029 return GetBaseObject(*x);
1030 } else {
1031 return std::nullopt;
1032 }
1033}
1034
1035// Like IsAllocatableOrPointer, but accepts pointer function results as being
1036// pointers too.
1037bool IsAllocatableOrPointerObject(const Expr<SomeType> &);
1038
1039bool IsAllocatableDesignator(const Expr<SomeType> &);
1040
1041// Procedure and pointer detection predicates
1042bool IsProcedureDesignator(const Expr<SomeType> &);
1043bool IsFunctionDesignator(const Expr<SomeType> &);
1044bool IsPointer(const Expr<SomeType> &);
1045bool IsProcedurePointer(const Expr<SomeType> &);
1046bool IsProcedure(const Expr<SomeType> &);
1047bool IsProcedurePointerTarget(const Expr<SomeType> &);
1048bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type
1049bool IsNullObjectPointer(const Expr<SomeType> *); // NULL() or NULL(objptr)
1050bool IsNullProcedurePointer(const Expr<SomeType> *); // NULL() or NULL(procptr)
1051bool IsNullPointer(const Expr<SomeType> *); // NULL() or NULL(pointer)
1052bool IsNullAllocatable(const Expr<SomeType> *); // NULL(allocatable)
1053bool IsNullPointerOrAllocatable(const Expr<SomeType> *); // NULL of any form
1054bool IsObjectPointer(const Expr<SomeType> &);
1055
1056// Can Expr be passed as absent to an optional dummy argument.
1057// See 15.5.2.12 point 1 for more details.
1058bool MayBePassedAsAbsentOptional(const Expr<SomeType> &);
1059
1060// Extracts the chain of symbols from a designator, which has perhaps been
1061// wrapped in an Expr<>, removing all of the (co)subscripts. The
1062// base object will be the first symbol in the result vector.
1063struct GetSymbolVectorHelper
1064 : public Traverse<GetSymbolVectorHelper, SymbolVector> {
1065 using Result = SymbolVector;
1066 using Base = Traverse<GetSymbolVectorHelper, Result>;
1067 using Base::operator();
1068 GetSymbolVectorHelper() : Base{*this} {}
1069 Result Default() { return {}; }
1070 Result Combine(Result &&a, Result &&b) {
1071 a.insert(a.end(), b.begin(), b.end());
1072 return std::move(a);
1073 }
1074 Result operator()(const Symbol &) const;
1075 Result operator()(const Component &) const;
1076 Result operator()(const ArrayRef &) const;
1077 Result operator()(const CoarrayRef &) const;
1078};
1079template <typename A> SymbolVector GetSymbolVector(const A &x) {
1080 return GetSymbolVectorHelper{}(x);
1081}
1082
1083// GetLastTarget() returns the rightmost symbol in an object designator's
1084// SymbolVector that has the POINTER or TARGET attribute, or a null pointer
1085// when none is found.
1086const Symbol *GetLastTarget(const SymbolVector &);
1087
1088// Collects all of the Symbols in an expression
1089template <typename A> semantics::UnorderedSymbolSet CollectSymbols(const A &);
1090extern template semantics::UnorderedSymbolSet CollectSymbols(
1091 const Expr<SomeType> &);
1092extern template semantics::UnorderedSymbolSet CollectSymbols(
1093 const Expr<SomeInteger> &);
1094extern template semantics::UnorderedSymbolSet CollectSymbols(
1095 const Expr<SubscriptInteger> &);
1096extern template semantics::UnorderedSymbolSet CollectSymbols(
1097 const ProcedureDesignator &);
1098extern template semantics::UnorderedSymbolSet CollectSymbols(
1099 const Assignment &);
1100
1101// Collects Symbols of interest for the CUDA data transfer in an expression
1102template <typename A>
1103semantics::UnorderedSymbolSet CollectCudaSymbols(const A &);
1104extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
1105 const Expr<SomeType> &);
1106extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
1107 const Expr<SomeInteger> &);
1108extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
1109 const Expr<SubscriptInteger> &);
1110
1111// Predicate: does a variable contain a vector-valued subscript (not a triplet)?
1112bool HasVectorSubscript(const Expr<SomeType> &);
1113bool HasVectorSubscript(const ActualArgument &);
1114
1115// Predicate: is an expression a section of an array?
1116bool IsArraySection(const Expr<SomeType> &expr);
1117
1118// Predicate: does an expression contain constant?
1119bool HasConstant(const Expr<SomeType> &);
1120
1121// Predicate: Does an expression contain a component
1122bool HasStructureComponent(const Expr<SomeType> &expr);
1123
1124// Predicate: does an expression contain a procedure reference?
1125bool HasProcedureRef(const Expr<SomeType> &expr);
1126
1127// Predicate: does an expression contain a VOLATILE or ASYNCHRONOUS symbol?
1128bool HasVolatileOrAsynchronousSymbol(const Expr<SomeType> &expr);
1129
1130// Can a scalar real or complex RHS expression in an assignment be rewritten
1131// as a split sum expression tree?
1132bool CanBuildSplitSumExpressionTree(
1133 FoldingContext &, const Expr<SomeType> &lhs, const Expr<SomeType> &rhs);
1134
1135// Try to rewrite eligible scalar real or complex sums within an expression as
1136// split sum expression trees.
1137std::optional<Expr<SomeType>> TryBuildSplitSumExpressionTrees(
1138 const Expr<SomeType> &expr);
1139
1140// Utilities for attaching the location of the declaration of a symbol
1141// of interest to a message. Handles the case of USE association gracefully.
1142parser::Message *AttachDeclaration(parser::Message &, const Symbol &);
1143parser::Message *AttachDeclaration(parser::Message *, const Symbol &);
1144template <typename MESSAGES, typename... A>
1145parser::Message *SayWithDeclaration(
1146 MESSAGES &messages, const Symbol &symbol, A &&...x) {
1147 return AttachDeclaration(messages.Say(std::forward<A>(x)...), symbol);
1148}
1149template <typename... A>
1150parser::Message *WarnWithDeclaration(FoldingContext context,
1151 const Symbol &symbol, common::LanguageFeature feature, A &&...x) {
1152 return AttachDeclaration(
1153 context.Warn(feature, std::forward<A>(x)...), symbol);
1154}
1155template <typename... A>
1156parser::Message *WarnWithDeclaration(FoldingContext &context,
1157 const Symbol &symbol, common::UsageWarning warning, A &&...x) {
1158 return AttachDeclaration(
1159 context.Warn(warning, std::forward<A>(x)...), symbol);
1160}
1161
1162// Check for references to impure procedures; returns the name
1163// of one to complain about, if any exist.
1164std::optional<std::string> FindImpureCall(
1165 FoldingContext &, const Expr<SomeType> &);
1166std::optional<std::string> FindImpureCall(
1167 FoldingContext &, const ProcedureRef &);
1168
1169// Predicate: does an expression contain anything that would prevent it from
1170// being duplicated so that two instances of it then appear in the same
1171// expression?
1172class UnsafeToCopyVisitor : public AnyTraverse<UnsafeToCopyVisitor> {
1173public:
1174 using Base = AnyTraverse<UnsafeToCopyVisitor>;
1175 using Base::operator();
1176 explicit UnsafeToCopyVisitor(bool admitPureCall)
1177 : Base{*this}, admitPureCall_{admitPureCall} {}
1178 template <typename T> bool operator()(const FunctionRef<T> &procRef) {
1179 return !admitPureCall_ || !procRef.proc().IsPure();
1180 }
1181 bool operator()(const CoarrayRef &) { return true; }
1182
1183private:
1184 bool admitPureCall_{false};
1185};
1186
1187template <typename A>
1188bool IsSafelyCopyable(const A &x, bool admitPureCall = false) {
1189 return !UnsafeToCopyVisitor{admitPureCall}(x);
1190}
1191
1192// Predicate: is a scalar expression suitable for naive scalar expansion
1193// in the flattening of an array expression?
1194// TODO: capture such scalar expansions in temporaries, flatten everything
1195template <typename T>
1196bool IsExpandableScalar(const Expr<T> &expr, FoldingContext &context,
1197 const Shape &shape, bool admitPureCall = false) {
1198 if (IsSafelyCopyable(expr, admitPureCall)) {
1199 return true;
1200 } else {
1201 auto extents{AsConstantExtents(context, shape)};
1202 return extents && !HasNegativeExtent(*extents) && GetSize(*extents) == 1;
1203 }
1204}
1205
1206// Common handling for procedure pointer compatibility of left- and right-hand
1207// sides. Returns nullopt if they're compatible. Otherwise, it returns a
1208// message that needs to be augmented by the names of the left and right sides.
1209std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
1210 const std::optional<characteristics::Procedure> &lhsProcedure,
1211 const characteristics::Procedure *rhsProcedure,
1212 const SpecificIntrinsic *specificIntrinsic, std::string &whyNotCompatible,
1213 std::optional<std::string> &warning, bool ignoreImplicitVsExplicit);
1214
1215// Scalar constant expansion
1216class ScalarConstantExpander {
1217public:
1218 explicit ScalarConstantExpander(ConstantSubscripts &&extents)
1219 : extents_{std::move(extents)} {}
1220 ScalarConstantExpander(
1221 ConstantSubscripts &&extents, std::optional<ConstantSubscripts> &&lbounds)
1222 : extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {}
1223 ScalarConstantExpander(
1224 ConstantSubscripts &&extents, ConstantSubscripts &&lbounds)
1225 : extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {}
1226
1227 template <typename A> A Expand(A &&x) const {
1228 return std::move(x); // default case
1229 }
1230 template <typename T> Constant<T> Expand(Constant<T> &&x) {
1231 auto expanded{x.Reshape(std::move(extents_))};
1232 if (lbounds_) {
1233 expanded.set_lbounds(std::move(*lbounds_));
1234 }
1235 return expanded;
1236 }
1237 template <typename T> Expr<T> Expand(Parentheses<T> &&x) {
1238 return Expand(std::move(x.left())); // Constant<> can be parenthesized
1239 }
1240 template <typename T> Expr<T> Expand(Expr<T> &&x) {
1241 return common::visit(
1242 [&](auto &&x) { return Expr<T>{Expand(std::move(x))}; },
1243 std::move(x.u));
1244 }
1245
1246private:
1247 ConstantSubscripts extents_;
1248 std::optional<ConstantSubscripts> lbounds_;
1249};
1250
1251// Given a collection of element values, package them as a Constant.
1252// If the type is Character or a derived type, take the length or type
1253// (resp.) from a another Constant.
1254template <typename T>
1255Constant<T> PackageConstant(std::vector<Scalar<T>> &&elements,
1256 const Constant<T> &reference, const ConstantSubscripts &shape) {
1257 if constexpr (T::category == TypeCategory::Character) {
1258 return Constant<T>{
1259 reference.LEN(), std::move(elements), ConstantSubscripts{shape}};
1260 } else if constexpr (T::category == TypeCategory::Derived) {
1261 return Constant<T>{reference.GetType().GetDerivedTypeSpec(),
1262 std::move(elements), ConstantSubscripts{shape}};
1263 } else {
1264 return Constant<T>{std::move(elements), ConstantSubscripts{shape}};
1265 }
1266}
1267
1268// Nonstandard conversions of constants (integer->logical, logical->integer)
1269// that can appear in DATA statements as an extension.
1270std::optional<Expr<SomeType>> DataConstantConversionExtension(
1271 FoldingContext &, const DynamicType &, const Expr<SomeType> &);
1272
1273// Convert Hollerith or short character to a another type as if the
1274// Hollerith data had been BOZ.
1275std::optional<Expr<SomeType>> HollerithToBOZ(
1276 FoldingContext &, const Expr<SomeType> &, const DynamicType &);
1277
1278// Set explicit lower bounds on a constant array.
1279class ArrayConstantBoundChanger {
1280public:
1281 explicit ArrayConstantBoundChanger(ConstantSubscripts &&lbounds)
1282 : lbounds_{std::move(lbounds)} {}
1283
1284 template <typename A> A ChangeLbounds(A &&x) const {
1285 return std::move(x); // default case
1286 }
1287 template <typename T> Constant<T> ChangeLbounds(Constant<T> &&x) {
1288 x.set_lbounds(std::move(lbounds_));
1289 return std::move(x);
1290 }
1291 template <typename T> Expr<T> ChangeLbounds(Parentheses<T> &&x) {
1292 return ChangeLbounds(
1293 std::move(x.left())); // Constant<> can be parenthesized
1294 }
1295 template <typename T> Expr<T> ChangeLbounds(Expr<T> &&x) {
1296 return common::visit(
1297 [&](auto &&x) { return Expr<T>{ChangeLbounds(std::move(x))}; },
1298 std::move(x.u)); // recurse until we hit a constant
1299 }
1300
1301private:
1302 ConstantSubscripts &&lbounds_;
1303};
1304
1305// Predicate: should two expressions be considered identical for the purposes
1306// of determining whether two procedure interfaces are compatible, modulo
1307// naming of corresponding dummy arguments?
1308template <typename T>
1309std::optional<bool> AreEquivalentInInterface(const Expr<T> &, const Expr<T> &);
1310extern template std::optional<bool> AreEquivalentInInterface<SubscriptInteger>(
1312extern template std::optional<bool> AreEquivalentInInterface<SomeInteger>(
1313 const Expr<SomeInteger> &, const Expr<SomeInteger> &);
1314
1315bool CheckForCoindexedObject(parser::ContextualMessages &,
1316 const std::optional<ActualArgument> &, const std::string &procName,
1317 const std::string &argName);
1318
1319// Get the symbol vectors of the expression where symbols are grouped together
1320// if they are part of the same component expression.
1321//
1322// Example: a%b + c%d
1323// Will be grouped as: [(a, b), (c, d)]
1324std::vector<SymbolVector> GetSymbolVectors(const Expr<SomeType> &expr);
1325
1326bool IsCUDADeviceSymbol(const Symbol &sym);
1327bool IsCUDADeviceOnlySymbol(const Symbol &sym);
1328
1329inline bool IsCUDAManagedOrUnifiedSymbol(const Symbol &sym) {
1330 if (const auto *details =
1331 sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()) {
1332 if (details->cudaDataAttr() &&
1333 (*details->cudaDataAttr() == common::CUDADataAttr::Managed ||
1334 *details->cudaDataAttr() == common::CUDADataAttr::Unified)) {
1335 return true;
1336 }
1337 }
1338 return false;
1339}
1340
1341inline bool IsCUDADataAttrSymbol(const Symbol &sym, common::CUDADataAttr attr) {
1342 if (const auto *details =
1343 sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()) {
1344 return details->cudaDataAttr() && *details->cudaDataAttr() == attr;
1345 }
1346 return false;
1347}
1348
1349inline bool IsCUDAManagedSymbol(const Symbol &sym) {
1350 return IsCUDADataAttrSymbol(sym, common::CUDADataAttr::Managed);
1351}
1352
1353inline bool IsCUDAUnifiedSymbol(const Symbol &sym) {
1354 return IsCUDADataAttrSymbol(sym, common::CUDADataAttr::Unified);
1355}
1356
1357inline bool HasCUDADataAttr(const Symbol &sym) {
1358 const auto *details{
1359 sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()};
1360 return details && details->cudaDataAttr().has_value();
1361}
1362
1363// The data attribute of a component describes the data that the component
1364// designates, so it hides the attribute of the object that the component is
1365// taken from: in a%b, where a is managed and b is device, a%b designates
1366// device data. Collect the symbols of the expression, leaving out the ones
1367// that a component with an attribute hides.
1368template <typename A>
1369semantics::UnorderedSymbolSet CollectEffectiveCudaSymbols(const A &expr) {
1370 semantics::UnorderedSymbolSet result{CollectCudaSymbols(expr)};
1371 SymbolVector symbols{GetSymbolVector(expr)};
1372 // GetSymbolVector lists the base of a component chain before its components.
1373 // Reverse it to visit the innermost component of a chain first.
1374 std::reverse(symbols.begin(), symbols.end());
1375 bool hidden{false};
1376 for (const Symbol &sym : symbols) {
1377 bool isComponent{sym.owner().IsDerivedType()};
1378 if (hidden) {
1379 result.erase(sym);
1380 } else if (isComponent && HasCUDADataAttr(sym)) {
1381 hidden = true;
1382 }
1383 if (!isComponent) {
1384 hidden = false; // The base ends the component chain.
1385 }
1386 }
1387 return result;
1388}
1389
1390// Get the number of symbols with the CUDA managed attribute in a set.
1391inline int CountCUDAManagedSymbols(
1392 const semantics::UnorderedSymbolSet &symbols) {
1393 int count{0};
1394 for (const Symbol &sym : symbols) {
1395 if (IsCUDAManagedSymbol(sym)) {
1396 ++count;
1397 }
1398 }
1399 return count;
1400}
1401
1402// Get the number of symbols with a CUDA device attribute other than unified in
1403// a set.
1404inline int CountCUDANonUnifiedSymbols(
1405 const semantics::UnorderedSymbolSet &symbols) {
1406 int count{0};
1407 for (const Symbol &sym : symbols) {
1408 if (IsCUDADeviceSymbol(sym) && !IsCUDAUnifiedSymbol(sym)) {
1409 ++count;
1410 }
1411 }
1412 return count;
1413}
1414
1415// Non-allocatable module-level managed/unified variables use pointer
1416// indirection through a companion global in __nv_managed_data__.
1417// Explicit data transfers (cudaMemcpy) must be avoided for these
1418// variables since they would target the shadow address rather than
1419// the actual unified memory address.
1420inline bool IsNonAllocatableModuleCUDAManagedSymbol(const Symbol &sym) {
1421 const Symbol &ultimate = sym.GetUltimate();
1422 if (!IsCUDAManagedOrUnifiedSymbol(ultimate))
1423 return false;
1424 if (ultimate.attrs().test(semantics::Attr::ALLOCATABLE))
1425 return false;
1426 return ultimate.owner().IsModule();
1427}
1428
1429template <typename A>
1430inline bool HasNonAllocatableModuleCUDAManagedSymbols(const A &expr) {
1431 for (const Symbol &sym : CollectCudaSymbols(expr))
1432 if (IsNonAllocatableModuleCUDAManagedSymbol(sym))
1433 return true;
1434 return false;
1435}
1436
1437// Get the number of distinct symbols with CUDA device
1438// attribute in the expression.
1439template <typename A> inline int GetNbOfCUDADeviceSymbols(const A &expr) {
1440 semantics::UnorderedSymbolSet symbols;
1441 for (const Symbol &sym : CollectCudaSymbols(expr)) {
1442 if (IsCUDADeviceSymbol(sym)) {
1443 symbols.insert(sym);
1444 }
1445 }
1446 return symbols.size();
1447}
1448
1449// Get the number of unique symbols with CUDA device attribute.
1450int GetNbOfUniqueCUDADeviceSymbols(const Expr<SomeType> &expr);
1451
1452// Get the number of distinct symbols with CUDA managed or unified
1453// attribute in the expression.
1454template <typename A>
1455inline int GetNbOfCUDAManagedOrUnifiedSymbols(const A &expr) {
1456 semantics::UnorderedSymbolSet symbols;
1457 for (const Symbol &sym : CollectCudaSymbols(expr)) {
1458 if (IsCUDAManagedOrUnifiedSymbol(sym)) {
1459 symbols.insert(sym);
1460 }
1461 }
1462 return symbols.size();
1463}
1464
1465// Check if any of the symbols part of the expression has a CUDA device
1466// attribute.
1467template <typename A> inline bool HasCUDADeviceAttrs(const A &expr) {
1468 return GetNbOfCUDADeviceSymbols(expr) > 0;
1469}
1470
1471// True for a whole reference to a managed array: a whole array variable, or a
1472// whole array component that itself has the managed attribute (a%b where b is
1473// managed). An array section, an array element, a component of a managed object
1474// and a computed value are all false.
1475template <typename A> inline bool IsWholeManagedArray(const A &expr) {
1476 const Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
1477 return expr.Rank() > 0 && sym && IsCUDAManagedSymbol(*sym);
1478}
1479
1480// CUDA Fortran Programming Guide 3.4.1 defines which assignments in host code
1481// are copies. A copy that reads or writes device, managed or constant data runs
1482// on stream zero, so it waits for previously launched kernels.
1483// - Device or constant data on one side and host data on the other is a copy,
1484// and so is device data on both sides.
1485// - A whole managed variable or array is copied when the other side is a
1486// constant, a host variable, a host array or a host array section.
1487// - A managed array section is assigned by host code when the other side is
1488// host or managed data.
1489// - A managed variable, array or array section is copied when the other side is
1490// device data, in both directions.
1491// One difference from the guide is that a managed array section is copied when
1492// the other side is a whole managed array, as the reference compiler does.
1493// Unified data is host memory that the device can also access, so it takes the
1494// place of host data in the rules above and an assignment between unified sides
1495// is host code.
1496// The side of an assignment is classified from the data it designates, so the
1497// attribute of a component prevails over the attribute of the object it is
1498// taken from.
1499// Return true if the assignment is one of the copies above.
1500template <typename A, typename B>
1501inline bool IsCUDADataTransfer(const A &lhs, const B &rhs) {
1502 semantics::UnorderedSymbolSet lhsSymbols{CollectEffectiveCudaSymbols(lhs)};
1503 semantics::UnorderedSymbolSet rhsSymbols{CollectEffectiveCudaSymbols(rhs)};
1504 // Unified data is left out of these counts and checks so that it is handled
1505 // as host data.
1506 bool lhsHasManaged{CountCUDAManagedSymbols(lhsSymbols) > 0};
1507 bool lhsIsHost{CountCUDANonUnifiedSymbols(lhsSymbols) == 0};
1508 int rhsNbManagedSymbols{CountCUDAManagedSymbols(rhsSymbols)};
1509 int rhsNbSymbols{CountCUDANonUnifiedSymbols(rhsSymbols)};
1510
1511 if (HasNonAllocatableModuleCUDAManagedSymbols(lhs))
1512 return false;
1513
1514 // The host can read and write managed data in place, and copying one section
1515 // at a time in a loop is slow, so only whole arrays are copied.
1516 bool wholeLhs{IsWholeManagedArray(lhs)};
1517 bool wholeRhs{IsWholeManagedArray(rhs)};
1518
1519 if (wholeLhs && rhsNbSymbols == 0 && rhsNbManagedSymbols == 0 &&
1520 (IsVariable(rhs) || IsConstantExpr(rhs))) {
1521 return true; // Whole managed array copied from constant or host data.
1522 }
1523
1524 // The host cannot reach device or constant data, unlike managed and unified
1525 // data, so an assignment with such a side is a copy, sections included.
1526 bool lhsIsDeviceOnly{!lhsHasManaged && !lhsIsHost};
1527 // The right-hand side can be an expression, so one device operand is enough.
1528 bool rhsHasDeviceOnly{rhsNbSymbols > rhsNbManagedSymbols};
1529
1530 // Assignments done on the host, with no copy.
1531 // - A whole allocatable left-hand side with no device data. The assignment
1532 // may reallocate it, which is done on the host.
1533 // - A managed left-hand side with no whole managed array on either side. Only
1534 // sections and elements are involved, and the host reads and writes them in
1535 // place.
1536 // - A host left-hand side assigned from a managed section or element.
1537 // - An expression involving managed data. Evaluating it on the host avoids a
1538 // temporary.
1539 // - A managed left-hand side assigned from host data. Whole arrays are copied
1540 // by the early return above.
1541 if ((IsAllocatableDesignator(lhs) && !lhsIsDeviceOnly && !rhsHasDeviceOnly &&
1542 (lhsHasManaged || rhsNbManagedSymbols >= 1)) ||
1543 (lhsHasManaged && !rhsHasDeviceOnly && !(wholeLhs || wholeRhs)) ||
1544 (lhsIsHost && rhsNbManagedSymbols >= 1 && !rhsHasDeviceOnly &&
1545 !wholeRhs) ||
1546 (rhsNbManagedSymbols >= 1 && !IsVariable(rhs) && !lhsIsDeviceOnly) ||
1547 (lhsHasManaged && rhsNbSymbols == 0)) {
1548 return false;
1549 }
1550 return !lhsIsHost || rhsNbSymbols > 0;
1551}
1552
1555bool HasCUDAImplicitTransfer(const Expr<SomeType> &expr);
1556
1559
1560// Checks whether the symbol on the LHS is present in the RHS expression.
1561bool CheckForSymbolMatch(const Expr<SomeType> *lhs, const Expr<SomeType> *rhs);
1562
1563namespace operation {
1564
1565enum class Operator {
1566 Unknown,
1567 Add,
1568 And,
1569 Associated,
1570 Call,
1571 Constant,
1572 Convert,
1573 Conditional,
1574 Div,
1575 Eq,
1576 Eqv,
1577 False,
1578 Ge,
1579 Gt,
1580 Identity,
1581 Intrinsic,
1582 Le,
1583 Lt,
1584 Max,
1585 Min,
1586 Mul,
1587 Ne,
1588 Neqv,
1589 Not,
1590 Or,
1591 Pow,
1592 Resize, // Convert within the same TypeCategory
1593 Sub,
1594 True,
1595};
1596
1597using OperatorSet = common::EnumSet<Operator, 32>;
1598
1599std::string ToString(Operator op);
1600
1601template <int Kind> Operator OperationCode(const LogicalOperation<Kind> &op) {
1602 switch (op.logicalOperator) {
1603 case common::LogicalOperator::And:
1604 return Operator::And;
1605 case common::LogicalOperator::Or:
1606 return Operator::Or;
1607 case common::LogicalOperator::Eqv:
1608 return Operator::Eqv;
1609 case common::LogicalOperator::Neqv:
1610 return Operator::Neqv;
1611 case common::LogicalOperator::Not:
1612 return Operator::Not;
1613 }
1614 return Operator::Unknown;
1615}
1616
1617Operator OperationCode(const Relational<SomeType> &op);
1618
1619template <typename T> Operator OperationCode(const Relational<T> &op) {
1620 switch (op.opr) {
1621 case common::RelationalOperator::LT:
1622 return Operator::Lt;
1623 case common::RelationalOperator::LE:
1624 return Operator::Le;
1625 case common::RelationalOperator::EQ:
1626 return Operator::Eq;
1627 case common::RelationalOperator::NE:
1628 return Operator::Ne;
1629 case common::RelationalOperator::GE:
1630 return Operator::Ge;
1631 case common::RelationalOperator::GT:
1632 return Operator::Gt;
1633 }
1634 return Operator::Unknown;
1635}
1636
1637template <typename T> Operator OperationCode(const Add<T> &op) {
1638 return Operator::Add;
1639}
1640
1641template <typename T> Operator OperationCode(const Subtract<T> &op) {
1642 return Operator::Sub;
1643}
1644
1645template <typename T> Operator OperationCode(const Multiply<T> &op) {
1646 return Operator::Mul;
1647}
1648
1649template <typename T> Operator OperationCode(const Divide<T> &op) {
1650 return Operator::Div;
1651}
1652
1653template <typename T> Operator OperationCode(const Power<T> &op) {
1654 return Operator::Pow;
1655}
1656
1657template <typename T> Operator OperationCode(const RealToIntPower<T> &op) {
1658 return Operator::Pow;
1659}
1660
1661template <typename T, common::TypeCategory C>
1662Operator OperationCode(const Convert<T, C> &op) {
1663 if constexpr (C == T::category) {
1664 return Operator::Resize;
1665 } else {
1666 return Operator::Convert;
1667 }
1668}
1669
1670template <typename T> Operator OperationCode(const Extremum<T> &op) {
1671 if (op.ordering == Ordering::Greater) {
1672 return Operator::Max;
1673 } else {
1674 return Operator::Min;
1675 }
1676}
1677
1678template <typename T> Operator OperationCode(const Constant<T> &x) {
1679 return Operator::Constant;
1680}
1681
1682template <typename T> Operator OperationCode(const Designator<T> &x) {
1683 return Operator::Identity;
1684}
1685
1686template <typename T> Operator OperationCode(const T &) {
1687 return Operator::Unknown;
1688}
1689
1690Operator OperationCode(const ProcedureDesignator &proc);
1691
1692} // namespace operation
1693
1694// Return information about the top-level operation (ignoring parentheses):
1695// the operation code and the list of arguments.
1696std::pair<operation::Operator, std::vector<Expr<SomeType>>>
1697GetTopLevelOperation(const Expr<SomeType> &expr);
1698
1699// Return information about the top-level operation (ignoring parentheses, and
1700// resizing converts)
1701std::pair<operation::Operator, std::vector<Expr<SomeType>>>
1702GetTopLevelOperationIgnoreResizing(const Expr<SomeType> &expr);
1703
1704// Check if expr is same as x, or a sequence of Convert operations on x.
1705bool IsSameOrConvertOf(const Expr<SomeType> &expr, const Expr<SomeType> &x);
1706
1707// Check if the Variable appears as a subexpression of the expression.
1708bool IsVarSubexpressionOf(
1709 const Expr<SomeType> &var, const Expr<SomeType> &super);
1710
1711// Strip away any top-level Convert operations (if any exist) and return
1712// the input value. A ComplexConstructor(x, 0) is also considered as a
1713// convert operation.
1714// If the input is not Operation, Designator, FunctionRef or Constant,
1715// it returns std::nullopt.
1716std::optional<Expr<SomeType>> GetConvertInput(const Expr<SomeType> &x);
1717
1718// How many ancestors does have a derived type have?
1719std::optional<int> CountDerivedTypeAncestors(const semantics::Scope &);
1720
1721// For an expression of enumeration type, extract the value of the hidden
1722// __ordinal component. Returns std::nullopt if the expression is not a
1723// constant or structure constructor of an enumeration-type value.
1724std::optional<Expr<SomeType>> GetEnumerationOrdinal(Expr<SomeDerived> &);
1725
1726} // namespace Fortran::evaluate
1727
1728namespace Fortran::semantics {
1729
1730class Scope;
1731
1732// If a symbol represents an ENTRY, return the symbol of the main entry
1733// point to its subprogram.
1734const Symbol *GetMainEntry(const Symbol *);
1735
1736inline bool IsAlternateEntry(const Symbol *symbol) {
1737 // If symbol is not alternate entry symbol, GetMainEntry() returns the same
1738 // symbol.
1739 return symbol && GetMainEntry(symbol) != symbol;
1740}
1741
1742// These functions are used in Evaluate so they are defined here rather than in
1743// Semantics to avoid a link-time dependency on Semantics.
1744// All of these apply GetUltimate() or ResolveAssociations() to their arguments.
1745bool IsVariableName(const Symbol &);
1746bool IsPureProcedure(const Symbol &);
1747bool IsPureProcedure(const Scope &);
1748bool IsSimpleProcedure(const Symbol &);
1749bool IsSimpleProcedure(const Scope &);
1750bool IsExplicitlyImpureProcedure(const Symbol &);
1751bool IsElementalProcedure(const Symbol &);
1752bool IsFunction(const Symbol &);
1753bool IsFunction(const Scope &);
1754bool IsProcedure(const Symbol &);
1755bool IsProcedure(const Scope &);
1756bool IsProcedurePointer(const Symbol *);
1757bool IsProcedurePointer(const Symbol &);
1758bool IsObjectPointer(const Symbol *);
1759bool IsAllocatableOrObjectPointer(const Symbol *);
1760bool IsAutomatic(const Symbol &);
1761bool IsSaved(const Symbol &); // saved implicitly or explicitly
1762bool IsDummy(const Symbol &);
1763
1764bool IsAssumedRank(const Symbol &);
1765template <typename A> bool IsAssumedRank(const A &x) {
1766 auto *symbol{UnwrapWholeSymbolDataRef(x)};
1767 return symbol && IsAssumedRank(*symbol);
1768}
1769
1770bool IsAssumedShape(const Symbol &);
1771template <typename A> bool IsAssumedShape(const A &x) {
1772 auto *symbol{UnwrapWholeSymbolDataRef(x)};
1773 return symbol && IsAssumedShape(*symbol);
1774}
1775
1776bool IsDeferredShape(const Symbol &);
1777bool IsFunctionResult(const Symbol &);
1778bool IsKindTypeParameter(const Symbol &);
1779bool IsLenTypeParameter(const Symbol &);
1780bool IsExtensibleType(const DerivedTypeSpec *);
1781bool IsSequenceOrBindCType(const DerivedTypeSpec *);
1782bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name);
1783bool IsBuiltinCPtr(const Symbol &);
1784bool IsFromBuiltinModule(const Symbol &);
1785bool IsEventType(const DerivedTypeSpec *);
1786bool IsLockType(const DerivedTypeSpec *);
1787bool IsNotifyType(const DerivedTypeSpec *);
1788// Is this derived type IEEE_FLAG_TYPE from module ISO_IEEE_EXCEPTIONS?
1789bool IsIeeeFlagType(const DerivedTypeSpec *);
1790// Is this derived type IEEE_ROUND_TYPE from module ISO_IEEE_ARITHMETIC?
1791bool IsIeeeRoundType(const DerivedTypeSpec *);
1792// Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV?
1793bool IsTeamType(const DerivedTypeSpec *);
1794// Is this derived type TEAM_TYPE, C_PTR, or C_FUNPTR?
1795bool IsBadCoarrayType(const DerivedTypeSpec *);
1796// Is this derived type either C_PTR or C_FUNPTR from module ISO_C_BINDING
1797bool IsIsoCType(const DerivedTypeSpec *);
1798bool IsEventTypeOrLockType(const DerivedTypeSpec *);
1799inline bool IsAssumedSizeArray(const Symbol &symbol) {
1800 if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
1801 return (object->isDummy() || symbol.test(Symbol::Flag::CrayPointee)) &&
1802 object->shape().CanBeAssumedSize();
1803 } else if (const auto *assoc{symbol.detailsIf<AssocEntityDetails>()}) {
1804 return assoc->IsAssumedSize();
1805 } else {
1806 return false;
1807 }
1808}
1809
1810// ResolveAssociations() traverses use associations and host associations
1811// like GetUltimate(), but also resolves through whole variable associations
1812// with ASSOCIATE(x => y) and related constructs. GetAssociationRoot()
1813// applies ResolveAssociations() and then, in the case of resolution to
1814// a construct association with part of a variable that does not involve a
1815// vector subscript, returns the first symbol of that variable instead
1816// of the construct entity.
1817// (E.g., for ASSOCIATE(x => y%z), ResolveAssociations(x) returns x,
1818// while GetAssociationRoot(x) returns y.)
1819// In a SELECT RANK construct, ResolveAssociations() stops at a
1820// RANK(n) or RANK(*) case symbol, but traverses the selector for
1821// RANK DEFAULT.
1822const Symbol &ResolveAssociations(const Symbol &, bool stopAtTypeGuard = false);
1823const Symbol &GetAssociationRoot(const Symbol &, bool stopAtTypeGuard = false);
1824
1825const Symbol *FindCommonBlockContaining(const Symbol &);
1826int CountLenParameters(const DerivedTypeSpec &);
1827int CountNonConstantLenParameters(const DerivedTypeSpec &);
1828
1829const Symbol &GetUsedModule(const UseDetails &);
1830const Symbol *FindFunctionResult(const Symbol &);
1831
1832// Type compatibility predicate: are x and y effectively the same type?
1833// Uses DynamicType::IsTkCompatible(), which handles the case of distinct
1834// but identical derived types.
1835bool AreTkCompatibleTypes(const DeclTypeSpec *x, const DeclTypeSpec *y);
1836
1837common::IgnoreTKRSet GetIgnoreTKR(const Symbol &);
1838
1839std::optional<int> GetDummyArgumentNumber(const Symbol *);
1840
1841const Symbol *FindAncestorModuleProcedure(const Symbol *symInSubmodule);
1842
1843// Given a Cray pointee symbol, returns the related Cray pointer symbol.
1844const Symbol &GetCrayPointer(const Symbol &crayPointee);
1845
1846} // namespace Fortran::semantics
1847
1848#endif // FORTRAN_EVALUATE_TOOLS_H_
Definition variable.h:205
Definition variable.h:243
Definition variable.h:357
Definition variable.h:73
Definition expression.h:394
Definition constant.h:147
Definition variable.h:381
Definition type.h:73
Definition common.h:215
Definition common.h:217
Definition call.h:394
Definition variable.h:101
Definition call.h:334
Definition expression.h:700
Definition static-data.h:29
Definition variable.h:304
Definition type.h:56
Definition message.h:397
Definition scope.h:68
Definition symbol.h:910
Definition symbol.h:721
Definition call.h:34
bool HasCUDAImplicitTransfer(const Expr< SomeType > &expr)
Definition tools.cpp:1289
bool HasOnlyCUDAConstntImplicitTransfer(const Expr< SomeType > &expr)
Check if the expression is a mix of host and constant variables.
Definition tools.cpp:1295
Definition expression.h:295
Definition expression.h:256
Definition expression.h:356
Definition expression.h:210
Definition variable.h:288
Definition expression.h:316
Definition expression.h:378
Definition expression.h:309
Definition expression.h:246
Definition expression.h:271
Definition expression.h:228
Definition type.h:404
Definition expression.h:302
Definition characteristics.h:367