Warning: This file is not a C or C++ file. It does not have highlighting.

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

Warning: This file is not a C or C++ file. It does not have highlighting.

source code of flang/include/flang/Evaluate/tools.h