9#ifndef FORTRAN_EVALUATE_TOOLS_H_
10#define FORTRAN_EVALUATE_TOOLS_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"
40struct IsVariableHelper
41 :
public AnyTraverse<IsVariableHelper, std::optional<bool>> {
42 using Result = std::optional<bool>;
43 using Base = AnyTraverse<IsVariableHelper, Result>;
44 IsVariableHelper() : Base{*
this} {}
45 using Base::operator();
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; }
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>) {
63 if (
auto known{(*this)(x.u)}) {
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)) {
81template <
typename A>
bool IsVariable(
const A &x) {
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();
97template <
typename T>
int GetCorank(
const Expr<T> &expr) {
98 return common::visit([](
const auto &x) {
return GetCorank(x); }, expr.u);
100template <
typename A>
int GetCorank(
const std::optional<A> &x) {
101 return x ? GetCorank(*x) : 0;
103template <
typename A>
int GetCorank(
const A *x) {
104 return x ? GetCorank(*x) : 0;
108template <
typename A>
bool IsCoarray(
const A &x) {
return GetCorank(x) > 0; }
113template <
typename A> common::IfNoLvalue<Expr<ResultType<A>>, A> AsExpr(A &&x) {
117template <typename T, typename U = typename Relational<T>::Result>
126 static_assert(IsSpecificIntrinsicType<T>);
130template <TypeCategory CATEGORY>
136common::IfNoLvalue<Expr<SomeType>, A> AsGenericExpr(A &&x) {
137 if constexpr (common::HasMember<A, TypelessExpression>) {
148std::optional<Expr<SomeType>> AsGenericExpr(
DataRef &&);
149std::optional<Expr<SomeType>> AsGenericExpr(
const Symbol &);
153std::optional<Expr<SomeType>> AsGenericExpr(std::optional<A> &&x) {
155 return AsGenericExpr(std::move(*x));
162common::IfNoLvalue<Expr<SomeKind<ResultType<A>::category>>, A> AsCategoryExpr(
169template <
typename A>
constexpr bool IsNumericCategoryExpr() {
170 if constexpr (common::HasMember<A, TypelessExpression>) {
173 return common::HasMember<ResultType<A>, NumericCategoryTypes>;
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>) {
185 }
else if constexpr (std::is_same_v<Ty, ActualArgument>) {
186 if (
auto *expr{x.UnwrapExpr()}) {
187 return UnwrapExpr<A>(*expr);
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);
200template <
typename A,
typename B>
201const A *UnwrapExpr(
const std::optional<B> &x) {
203 return UnwrapExpr<A>(*x);
209template <
typename A,
typename B> A *UnwrapExpr(std::optional<B> &x) {
211 return UnwrapExpr<A>(*x);
217template <
typename A,
typename B>
const A *UnwrapExpr(
const B *x) {
219 return UnwrapExpr<A>(*x);
225template <
typename A,
typename B> A *UnwrapExpr(B *x) {
227 return UnwrapExpr<A>(*x);
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>) {
241 }
else if constexpr (std::is_same_v<Ty, ActualArgument>) {
242 if (
auto *expr{x.UnwrapExpr()}) {
243 return UnwrapConvertedExpr<A>(*expr);
245 }
else if constexpr (std::is_same_v<Ty, Expr<SomeType>>) {
246 return common::visit(
247 [](
auto &x) {
return UnwrapConvertedExpr<A>(x); }, x.u);
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);
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);
271template <
typename A>
inline const ProcedureRef *UnwrapProcedureRef(
const A &) {
288 return common::visit(
289 [](
const auto &x) {
return UnwrapProcedureRef(x); }, expr.u);
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) {
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)>) {
324std::optional<DataRef> ExtractSubstringBase(
const Substring &);
326inline std::optional<DataRef> ExtractDataRef(
const Substring &x,
327 bool intoSubstring =
false,
bool intoComplexPart =
false) {
329 return ExtractSubstringBase(x);
334inline std::optional<DataRef> ExtractDataRef(
const ComplexPart &x,
335 bool intoSubstring =
false,
bool intoComplexPart =
false) {
336 if (intoComplexPart) {
344 bool intoSubstring =
false,
bool intoComplexPart =
false) {
345 return common::visit(
346 [=](
const auto &x) -> std::optional<DataRef> {
347 return ExtractDataRef(x, intoSubstring, intoComplexPart);
352std::optional<DataRef> ExtractDataRef(
const Expr<T> &expr,
353 bool intoSubstring =
false,
bool intoComplexPart =
false) {
354 return common::visit(
356 return ExtractDataRef(x, intoSubstring, intoComplexPart);
361std::optional<DataRef> ExtractDataRef(
const std::optional<A> &x,
362 bool intoSubstring =
false,
bool intoComplexPart =
false) {
364 return ExtractDataRef(*x, intoSubstring, intoComplexPart);
370std::optional<DataRef> ExtractDataRef(
371 A *p,
bool intoSubstring =
false,
bool intoComplexPart =
false) {
373 return ExtractDataRef(std::as_const(*p), intoSubstring, intoComplexPart);
379 bool intoSubstring =
false,
bool intoComplexPart =
false);
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();
402bool isStructureComponent(
const Fortran::evaluate::Expr<T> &expr) {
403 if (
auto dataRef{ExtractDataRef(expr,
false)}) {
404 const Fortran::evaluate::DataRef *ref{&*dataRef};
405 return std::holds_alternative<Fortran::evaluate::Component>(ref->u);
412std::optional<NamedEntity> ExtractNamedEntity(
const A &x) {
413 if (
auto dataRef{ExtractDataRef(x)}) {
414 return common::visit(
416 [](SymbolRef &&symbol) -> std::optional<NamedEntity> {
419 [](
Component &&component) -> std::optional<NamedEntity> {
422 [](
auto &&) {
return std::optional<NamedEntity>{}; },
424 std::move(dataRef->u));
431 template <
typename A> std::optional<CoarrayRef> operator()(
const A &)
const {
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);
439 std::optional<CoarrayRef> operator()(
const DataRef &dataRef)
const {
440 return common::visit(*
this, dataRef.u);
442 std::optional<CoarrayRef> operator()(
const NamedEntity &named)
const {
443 if (
const Component * component{named.UnwrapComponent()}) {
444 return (*
this)(*component);
450 if (
const auto *component{
451 std::get_if<common::CopyableIndirection<Component>>(&des.u)}) {
452 return (*
this)(component->value());
457 std::optional<CoarrayRef> operator()(
const Component &component)
const {
458 return (*
this)(component.base());
460 std::optional<CoarrayRef> operator()(
const ArrayRef &arrayRef)
const {
461 return (*
this)(arrayRef.base());
465static inline std::optional<CoarrayRef> ExtractCoarrayRef(
const DataRef &x) {
469template <
typename A> std::optional<CoarrayRef> ExtractCoarrayRef(
const A &x) {
470 if (
auto dataRef{ExtractDataRef(x,
true)}) {
471 return ExtractCoarrayRef(*dataRef);
478 template <
typename T>
static std::optional<TARGET> visit(T &&) {
482 static std::optional<TARGET> visit(
const TARGET &t) {
return t; }
484 template <
typename T>
486 return common::visit([](
auto &&s) {
return visit(s); }, e.u);
489 template <
typename T>
static std::optional<TARGET> visit(
const Expr<T> &e) {
490 return common::visit([](
auto &&s) {
return visit(s); }, e.u);
494template <
typename A> std::optional<Substring> ExtractSubstring(
const A &x) {
495 return ExtractFromExprDesignatorHelper<Substring>::visit(x);
499std::optional<ComplexPart> ExtractComplexPart(
const A &x) {
500 return ExtractFromExprDesignatorHelper<ComplexPart>::visit(x);
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));
513const Symbol *UnwrapWholeSymbolOrComponentDataRef(
const DataRef &);
514const Symbol *UnwrapWholeSymbolOrComponentDataRef(
515 const std::optional<DataRef> &);
517const Symbol *UnwrapWholeSymbolOrComponentDataRef(
const A &x) {
518 return UnwrapWholeSymbolOrComponentDataRef(ExtractDataRef(x));
524const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(
const DataRef &);
525const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(
526 const std::optional<DataRef> &);
528const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(
const A &x) {
529 return UnwrapWholeSymbolOrComponentOrCoarrayRef(ExtractDataRef(x));
533template <
typename A>
const Symbol *GetFirstSymbol(
const A &x) {
534 if (
auto dataRef{ExtractDataRef(x,
true)}) {
535 return &dataRef->GetFirstSymbol();
542const Symbol *GetLastPointerSymbol(
const evaluate::DataRef &);
548template <
typename TO, TypeCategory FROMCAT>
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);
557 }
else if constexpr (TO::category == TypeCategory::Complex) {
558 using Part =
typename TO::Part;
562 }
else if constexpr (FROMCAT == TypeCategory::Complex) {
564 return common::visit(
566 using ZType = ResultType<
decltype(z)>;
567 using Part =
typename ZType::Part;
577template <
typename TO, TypeCategory FROMCAT,
int FROMKIND>
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) {
587 Constant<TO>{Scalar<TO>::ConvertUnsigned(std::move(x)).value}};
589 static_assert(TO::category == TypeCategory::Real);
590 using Word =
typename Scalar<TO>::Word;
592 Constant<TO>{Scalar<TO>{Word::ConvertUnsigned(std::move(x)).value}}};
596template <
typename T>
bool IsBOZLiteral(
const Expr<T> &expr) {
597 return std::holds_alternative<BOZLiteralConstant>(expr.u);
601std::optional<Expr<SomeType>> ConvertToType(
603std::optional<Expr<SomeType>> ConvertToType(
606std::optional<Expr<SomeType>> ConvertToType(
610template <TypeCategory TC,
int TK,
typename FROM>
611common::IfNoLvalue<Expr<Type<TC, TK>>, FROM> ConvertTo(
613 return ConvertToType<Type<TC, TK>>(std::move(x));
616template <TypeCategory TC,
typename FROM>
617common::IfNoLvalue<Expr<SomeKind<TC>>, FROM> ConvertTo(
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)));
628template <
typename FROM>
629common::IfNoLvalue<Expr<SomeType>, FROM> ConvertTo(
631 return common::visit(
632 [&](
const auto &toCatExpr) {
633 return AsGenericExpr(ConvertTo(toCatExpr, std::move(from)));
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))));
655template <TypeCategory TOCAT,
typename VALUE>
656common::IfNoLvalue<Expr<SomeKind<TOCAT>>, VALUE> ConvertToKind(
657 int kind, VALUE &&x) {
658 auto result{common::SearchTypes(
660 CHECK(result.has_value());
667template <
typename A,
int N = 2>
using SameExprs = std::array<Expr<A>, N>;
669 template <
typename A>
using SameExprs = std::array<Expr<A>, N>;
671template <TypeCategory CAT,
int N = 2>
673 common::MapTemplate<SameKindExprsHelper<N>::template SameExprs,
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)}};
691 return {SameExprs<XTy>{std::move(kx), ConvertTo(kx, std::move(ky))}};
693#if !__clang__ && 100 * __GNUC__ + __GNUC_MINOR__ == 801
696 CHECK(!
"can't happen");
697 return {SameExprs<XTy>{std::move(kx), std::move(kx)}};
700 std::move(x.u), std::move(y.u));
706using ConvertRealOperandsResult =
707 std::optional<SameKindExprs<TypeCategory::Real, 2>>;
708ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &,
715std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
717std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
719 int defaultRealKind);
721template <
typename A>
Expr<TypeOf<A>> ScalarConstantToExpr(
const A &x) {
722 using Ty = TypeOf<A>;
724 std::is_same_v<Scalar<Ty>, std::decay_t<A>>,
"TypeOf<> is broken");
730template <
template <
typename>
class OPR,
typename SPECIFIC>
732 static_assert(IsSpecificIntrinsicType<SPECIFIC>);
733 return AsExpr(OPR<SPECIFIC>{std::move(x), std::move(y)});
740template <
template <
typename>
class OPR, TypeCategory CAT>
743 return common::visit(
745 using Ty = ResultType<
decltype(xy[0])>;
746 return AsCategoryExpr(
747 Combine<OPR, Ty>(std::move(xy[0]), std::move(xy[1])));
749 AsSameKindExprs(std::move(x), std::move(y)));
757template <
template <
typename>
class OPR>
758std::optional<Expr<SomeType>> NumericOperation(parser::ContextualMessages &,
761extern template std::optional<Expr<SomeType>> NumericOperation<Power>(
763 int defaultRealKind);
764extern template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
766 int defaultRealKind);
767extern template std::optional<Expr<SomeType>> NumericOperation<Divide>(
769 int defaultRealKind);
770extern template std::optional<Expr<SomeType>> NumericOperation<Add>(
772 int defaultRealKind);
773extern template std::optional<Expr<SomeType>> NumericOperation<Subtract>(
775 int defaultRealKind);
777std::optional<Expr<SomeType>> Negation(
782std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &,
790 static_assert(IsSpecificIntrinsicType<T>);
798 return AsExpr(
Not<K>{std::move(x)});
818template <TypeCategory C,
int K>
823template <TypeCategory C,
int K>
825 return AsExpr(Combine<
Add,
Type<C, K>>(std::move(x), std::move(y)));
828template <TypeCategory C,
int K>
833template <TypeCategory C,
int K>
838template <TypeCategory C,
int K>
844 return common::visit(
848template <TypeCategory CAT>
851 return PromoteAndCombine<Add, CAT>(std::move(x), std::move(y));
854template <TypeCategory CAT>
857 return PromoteAndCombine<Subtract, CAT>(std::move(x), std::move(y));
860template <TypeCategory CAT>
863 return PromoteAndCombine<Multiply, CAT>(std::move(x), std::move(y));
866template <TypeCategory CAT>
869 return PromoteAndCombine<Divide, CAT>(std::move(x), std::move(y));
875template <TypeCategory CAT,
template <
typename>
class TEMPLATE,
typename VALUE>
876struct TypeKindVisitor {
877 using Result = std::optional<Expr<SomeType>>;
878 using Types = CategoryTypes<CAT>;
880 TypeKindVisitor(
int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
881 TypeKindVisitor(
int k,
const VALUE &x) : kind{k}, value{x} {}
883 template <
typename T> Result Test() {
884 if (kind == T::kind) {
885 return AsGenericExpr(TEMPLATE<T>{std::move(value)});
897template <TypeCategory CATEGORY,
template <
typename>
typename WRAPPER,
899common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> WrapperHelper(
900 int kind, WRAPPED &&x) {
901 return common::SearchTypes(
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)}});
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(); }
947 return x.GetSymbol();
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)}) {
964template <
typename A>
const Symbol *GetLastSymbol(
const A &x) {
975template <
typename A> semantics::Attrs GetAttrs(
const A &x) {
976 if (
const Symbol * symbol{GetLastSymbol(x)}) {
977 return symbol->attrs();
984inline semantics::Attrs GetAttrs<Expr<SomeType>>(
const Expr<SomeType> &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)) {
993 return details->result().attrs();
999 if (
const Symbol * symbol{GetLastSymbol(x)}) {
1000 return symbol->attrs();
1006template <
typename A> semantics::Attrs GetAttrs(
const std::optional<A> &x) {
1008 return GetAttrs(*x);
1015template <
typename A> std::optional<BaseObject> GetBaseObject(
const A &) {
1016 return std::nullopt;
1018template <
typename T>
1019std::optional<BaseObject> GetBaseObject(
const Designator<T> &x) {
1020 return x.GetBaseObject();
1022template <
typename T>
1023std::optional<BaseObject> GetBaseObject(
const Expr<T> &x) {
1024 return common::visit([](
const auto &y) {
return GetBaseObject(y); }, x.u);
1026template <
typename A>
1027std::optional<BaseObject> GetBaseObject(
const std::optional<A> &x) {
1029 return GetBaseObject(*x);
1031 return std::nullopt;
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);
1074 Result operator()(
const Symbol &)
const;
1075 Result operator()(
const Component &)
const;
1076 Result operator()(
const ArrayRef &)
const;
1079template <
typename A> SymbolVector GetSymbolVector(
const A &x) {
1086const Symbol *GetLastTarget(
const SymbolVector &);
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 &);
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> &);
1112bool HasVectorSubscript(
const Expr<SomeType> &);
1113bool HasVectorSubscript(
const ActualArgument &);
1116bool IsArraySection(
const Expr<SomeType> &expr);
1119bool HasConstant(
const Expr<SomeType> &);
1122bool HasStructureComponent(
const Expr<SomeType> &expr);
1125bool HasProcedureRef(
const Expr<SomeType> &expr);
1128bool HasVolatileOrAsynchronousSymbol(
const Expr<SomeType> &expr);
1132bool CanBuildSplitSumExpressionTree(
1133 FoldingContext &,
const Expr<SomeType> &lhs,
const Expr<SomeType> &rhs);
1137std::optional<Expr<SomeType>> TryBuildSplitSumExpressionTrees(
1138 const Expr<SomeType> &expr);
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);
1149template <
typename... A>
1151 const Symbol &symbol, common::LanguageFeature feature, A &&...x) {
1152 return AttachDeclaration(
1153 context.Warn(feature, std::forward<A>(x)...), symbol);
1155template <
typename... A>
1157 const Symbol &symbol, common::UsageWarning warning, A &&...x) {
1158 return AttachDeclaration(
1159 context.Warn(warning, std::forward<A>(x)...), symbol);
1164std::optional<std::string> FindImpureCall(
1166std::optional<std::string> FindImpureCall(
1172class UnsafeToCopyVisitor :
public AnyTraverse<UnsafeToCopyVisitor> {
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();
1181 bool operator()(
const CoarrayRef &) {
return true; }
1184 bool admitPureCall_{
false};
1187template <
typename A>
1188bool IsSafelyCopyable(
const A &x,
bool admitPureCall =
false) {
1195template <
typename T>
1196bool IsExpandableScalar(
const Expr<T> &expr, FoldingContext &context,
1197 const Shape &shape,
bool admitPureCall =
false) {
1198 if (IsSafelyCopyable(expr, admitPureCall)) {
1201 auto extents{AsConstantExtents(context, shape)};
1202 return extents && !HasNegativeExtent(*extents) && GetSize(*extents) == 1;
1209std::optional<parser::MessageFixedText> CheckProcCompatibility(
bool isCall,
1210 const std::optional<characteristics::Procedure> &lhsProcedure,
1213 std::optional<std::string> &warning,
bool ignoreImplicitVsExplicit);
1216class ScalarConstantExpander {
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)} {}
1227 template <
typename A> A Expand(A &&x)
const {
1228 return std::move(x);
1231 auto expanded{x.Reshape(std::move(extents_))};
1233 expanded.set_lbounds(std::move(*lbounds_));
1238 return Expand(std::move(x.left()));
1241 return common::visit(
1242 [&](
auto &&x) {
return Expr<T>{Expand(std::move(x))}; },
1247 ConstantSubscripts extents_;
1248 std::optional<ConstantSubscripts> lbounds_;
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) {
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}};
1264 return Constant<T>{std::move(elements), ConstantSubscripts{shape}};
1270std::optional<Expr<SomeType>> DataConstantConversionExtension(
1275std::optional<Expr<SomeType>> HollerithToBOZ(
1279class ArrayConstantBoundChanger {
1281 explicit ArrayConstantBoundChanger(ConstantSubscripts &&lbounds)
1282 : lbounds_{std::move(lbounds)} {}
1284 template <
typename A> A ChangeLbounds(A &&x)
const {
1285 return std::move(x);
1288 x.set_lbounds(std::move(lbounds_));
1289 return std::move(x);
1292 return ChangeLbounds(
1293 std::move(x.left()));
1296 return common::visit(
1297 [&](
auto &&x) {
return Expr<T>{ChangeLbounds(std::move(x))}; },
1302 ConstantSubscripts &&lbounds_;
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>(
1316 const std::optional<ActualArgument> &,
const std::string &procName,
1317 const std::string &argName);
1324std::vector<SymbolVector> GetSymbolVectors(
const Expr<SomeType> &expr);
1326bool IsCUDADeviceSymbol(
const Symbol &sym);
1327bool IsCUDADeviceOnlySymbol(
const Symbol &sym);
1329inline bool IsCUDAManagedOrUnifiedSymbol(
const Symbol &sym) {
1330 if (
const auto *details =
1332 if (details->cudaDataAttr() &&
1333 (*details->cudaDataAttr() == common::CUDADataAttr::Managed ||
1334 *details->cudaDataAttr() == common::CUDADataAttr::Unified)) {
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;
1349inline bool IsCUDAManagedSymbol(
const Symbol &sym) {
1350 return IsCUDADataAttrSymbol(sym, common::CUDADataAttr::Managed);
1353inline bool IsCUDAUnifiedSymbol(
const Symbol &sym) {
1354 return IsCUDADataAttrSymbol(sym, common::CUDADataAttr::Unified);
1357inline bool HasCUDADataAttr(
const Symbol &sym) {
1358 const auto *details{
1359 sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()};
1360 return details && details->cudaDataAttr().has_value();
1368template <
typename A>
1369semantics::UnorderedSymbolSet CollectEffectiveCudaSymbols(
const A &expr) {
1370 semantics::UnorderedSymbolSet result{CollectCudaSymbols(expr)};
1371 SymbolVector symbols{GetSymbolVector(expr)};
1374 std::reverse(symbols.begin(), symbols.end());
1376 for (
const Symbol &sym : symbols) {
1377 bool isComponent{sym.owner().IsDerivedType()};
1380 }
else if (isComponent && HasCUDADataAttr(sym)) {
1391inline int CountCUDAManagedSymbols(
1392 const semantics::UnorderedSymbolSet &symbols) {
1394 for (
const Symbol &sym : symbols) {
1395 if (IsCUDAManagedSymbol(sym)) {
1404inline int CountCUDANonUnifiedSymbols(
1405 const semantics::UnorderedSymbolSet &symbols) {
1407 for (
const Symbol &sym : symbols) {
1408 if (IsCUDADeviceSymbol(sym) && !IsCUDAUnifiedSymbol(sym)) {
1420inline bool IsNonAllocatableModuleCUDAManagedSymbol(
const Symbol &sym) {
1421 const Symbol &ultimate = sym.GetUltimate();
1422 if (!IsCUDAManagedOrUnifiedSymbol(ultimate))
1424 if (ultimate.attrs().test(semantics::Attr::ALLOCATABLE))
1426 return ultimate.owner().IsModule();
1429template <
typename A>
1430inline bool HasNonAllocatableModuleCUDAManagedSymbols(
const A &expr) {
1431 for (
const Symbol &sym : CollectCudaSymbols(expr))
1432 if (IsNonAllocatableModuleCUDAManagedSymbol(sym))
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);
1446 return symbols.size();
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);
1462 return symbols.size();
1467template <
typename A>
inline bool HasCUDADeviceAttrs(
const A &expr) {
1468 return GetNbOfCUDADeviceSymbols(expr) > 0;
1475template <
typename A>
inline bool IsWholeManagedArray(
const A &expr) {
1476 const Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
1477 return expr.Rank() > 0 && sym && IsCUDAManagedSymbol(*sym);
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)};
1506 bool lhsHasManaged{CountCUDAManagedSymbols(lhsSymbols) > 0};
1507 bool lhsIsHost{CountCUDANonUnifiedSymbols(lhsSymbols) == 0};
1508 int rhsNbManagedSymbols{CountCUDAManagedSymbols(rhsSymbols)};
1509 int rhsNbSymbols{CountCUDANonUnifiedSymbols(rhsSymbols)};
1511 if (HasNonAllocatableModuleCUDAManagedSymbols(lhs))
1516 bool wholeLhs{IsWholeManagedArray(lhs)};
1517 bool wholeRhs{IsWholeManagedArray(rhs)};
1519 if (wholeLhs && rhsNbSymbols == 0 && rhsNbManagedSymbols == 0 &&
1520 (IsVariable(rhs) || IsConstantExpr(rhs))) {
1526 bool lhsIsDeviceOnly{!lhsHasManaged && !lhsIsHost};
1528 bool rhsHasDeviceOnly{rhsNbSymbols > rhsNbManagedSymbols};
1541 if ((IsAllocatableDesignator(lhs) && !lhsIsDeviceOnly && !rhsHasDeviceOnly &&
1542 (lhsHasManaged || rhsNbManagedSymbols >= 1)) ||
1543 (lhsHasManaged && !rhsHasDeviceOnly && !(wholeLhs || wholeRhs)) ||
1544 (lhsIsHost && rhsNbManagedSymbols >= 1 && !rhsHasDeviceOnly &&
1546 (rhsNbManagedSymbols >= 1 && !IsVariable(rhs) && !lhsIsDeviceOnly) ||
1547 (lhsHasManaged && rhsNbSymbols == 0)) {
1550 return !lhsIsHost || rhsNbSymbols > 0;
1563namespace operation {
1565enum class Operator {
1597using OperatorSet = common::EnumSet<Operator, 32>;
1599std::string ToString(Operator op);
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;
1614 return Operator::Unknown;
1617Operator OperationCode(
const Relational<SomeType> &op);
1619template <
typename T> Operator OperationCode(
const Relational<T> &op) {
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;
1634 return Operator::Unknown;
1637template <
typename T> Operator OperationCode(
const Add<T> &op) {
1638 return Operator::Add;
1641template <
typename T> Operator OperationCode(
const Subtract<T> &op) {
1642 return Operator::Sub;
1645template <
typename T> Operator OperationCode(
const Multiply<T> &op) {
1646 return Operator::Mul;
1649template <
typename T> Operator OperationCode(
const Divide<T> &op) {
1650 return Operator::Div;
1653template <
typename T> Operator OperationCode(
const Power<T> &op) {
1654 return Operator::Pow;
1657template <
typename T> Operator OperationCode(
const RealToIntPower<T> &op) {
1658 return Operator::Pow;
1661template <
typename T, common::TypeCategory C>
1662Operator OperationCode(
const Convert<T, C> &op) {
1663 if constexpr (C == T::category) {
1664 return Operator::Resize;
1666 return Operator::Convert;
1670template <
typename T> Operator OperationCode(
const Extremum<T> &op) {
1671 if (op.ordering == Ordering::Greater) {
1672 return Operator::Max;
1674 return Operator::Min;
1678template <
typename T> Operator OperationCode(
const Constant<T> &x) {
1679 return Operator::Constant;
1682template <
typename T> Operator OperationCode(
const Designator<T> &x) {
1683 return Operator::Identity;
1686template <
typename T> Operator OperationCode(
const T &) {
1687 return Operator::Unknown;
1690Operator OperationCode(
const ProcedureDesignator &proc);
1696std::pair<operation::Operator, std::vector<Expr<SomeType>>>
1701std::pair<operation::Operator, std::vector<Expr<SomeType>>>
1708bool IsVarSubexpressionOf(
1716std::optional<Expr<SomeType>> GetConvertInput(
const Expr<SomeType> &x);
1719std::optional<int> CountDerivedTypeAncestors(
const semantics::Scope &);
1728namespace Fortran::semantics {
1736inline bool IsAlternateEntry(
const Symbol *symbol) {
1739 return symbol && GetMainEntry(symbol) != symbol;
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 &);
1762bool IsDummy(
const Symbol &);
1764bool IsAssumedRank(
const Symbol &);
1765template <
typename A>
bool IsAssumedRank(
const A &x) {
1766 auto *symbol{UnwrapWholeSymbolDataRef(x)};
1767 return symbol && IsAssumedRank(*symbol);
1770bool IsAssumedShape(
const Symbol &);
1771template <
typename A>
bool IsAssumedShape(
const A &x) {
1772 auto *symbol{UnwrapWholeSymbolDataRef(x)};
1773 return symbol && IsAssumedShape(*symbol);
1776bool IsDeferredShape(
const Symbol &);
1777bool IsFunctionResult(
const Symbol &);
1778bool IsKindTypeParameter(
const Symbol &);
1779bool IsLenTypeParameter(
const Symbol &);
1782bool IsBuiltinDerivedType(
const DerivedTypeSpec *derived,
const char *name);
1783bool IsBuiltinCPtr(
const Symbol &);
1784bool IsFromBuiltinModule(
const Symbol &);
1799inline bool IsAssumedSizeArray(
const Symbol &symbol) {
1801 return (object->isDummy() || symbol.test(Symbol::Flag::CrayPointee)) &&
1802 object->shape().CanBeAssumedSize();
1804 return assoc->IsAssumedSize();
1822const Symbol &ResolveAssociations(
const Symbol &,
bool stopAtTypeGuard =
false);
1823const Symbol &GetAssociationRoot(
const Symbol &,
bool stopAtTypeGuard =
false);
1825const Symbol *FindCommonBlockContaining(
const Symbol &);
1837common::IgnoreTKRSet GetIgnoreTKR(
const Symbol &);
1839std::optional<int> GetDummyArgumentNumber(
const Symbol *);
1841const Symbol *FindAncestorModuleProcedure(
const Symbol *symInSubmodule);
1844const Symbol &GetCrayPointer(
const Symbol &crayPointee);
Definition variable.h:205
Definition variable.h:243
Definition variable.h:357
Definition expression.h:394
Definition constant.h:147
Definition variable.h:381
Definition variable.h:101
Definition expression.h:700
Definition static-data.h:29
Definition variable.h:304
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 expression.h:302
Definition characteristics.h:367