//===-- lib/Evaluate/intrinsics-library.cpp -------------------------------===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// // This file defines host runtime functions that can be used for folding // intrinsic functions. // The default host runtime folders are built with and // functions that are guaranteed to exist from the C++ standard. #include "flang/Evaluate/intrinsics-library.h" #include "fold-implementation.h" #include "host.h" #include "flang/Common/erfc-scaled.h" #include "flang/Common/idioms.h" #include "flang/Common/static-multimap-view.h" #include "flang/Evaluate/expression.h" #include #include #include #include #if HAS_QUADMATHLIB #include "quadmath.h" #endif #include "flang/Common/float128.h" #include "flang/Common/float80.h" #include namespace Fortran::evaluate { // Define a vector like class that can hold an arbitrary number of // Dynamic type and be built at compile time. This is like a // std::vector, but constexpr only. template struct TypeVectorStorage { static constexpr DynamicType values[]{FortranType{}.GetType()...}; static constexpr const DynamicType *start{&values[0]}; static constexpr const DynamicType *end{start + sizeof...(FortranType)}; }; template <> struct TypeVectorStorage<> { static constexpr const DynamicType *start{nullptr}, *end{nullptr}; }; struct TypeVector { template static constexpr TypeVector Create() { using storage = TypeVectorStorage; return TypeVector{storage::start, storage::end, sizeof...(FortranType)}; } constexpr size_t size() const { return size_; }; using const_iterator = const DynamicType *; constexpr const_iterator begin() const { return startPtr; } constexpr const_iterator end() const { return endPtr; } const DynamicType &operator[](size_t i) const { return *(startPtr + i); } const DynamicType *startPtr{nullptr}; const DynamicType *endPtr{nullptr}; const size_t size_; }; inline bool operator==( const TypeVector &lhs, const std::vector &rhs) { if (lhs.size() != rhs.size()) { return false; } for (size_t i{0}; i < lhs.size(); ++i) { if (lhs[i] != rhs[i]) { return false; } } return true; } // HostRuntimeFunction holds a pointer to a Folder function that can fold // a Fortran scalar intrinsic using host runtime functions (e.g libm). // The folder take care of all conversions between Fortran types and the related // host types as well as setting and cleaning-up the floating point environment. // HostRuntimeFunction are intended to be built at compile time (members are all // constexpr constructible) so that they can be stored in a compile time static // map. struct HostRuntimeFunction { using Folder = Expr (*)( FoldingContext &, std::vector> &&); using Key = std::string_view; // Needed for implicit compare with keys. constexpr operator Key() const { return key; } // Name of the related Fortran intrinsic. Key key; // DynamicType of the Expr returns by folder. DynamicType resultType; // DynamicTypes expected for the Expr arguments of the folder. // The folder will crash if provided arguments of different types. TypeVector argumentTypes; // Folder to be called to fold the intrinsic with host runtime. The provided // Expr arguments must wrap scalar constants of the type described // in argumentTypes, otherwise folder will crash. Any floating point issue // raised while executing the host runtime will be reported in FoldingContext // messages. Folder folder; }; // Translate a host function type signature (template arguments) into a // constexpr data representation based on Fortran DynamicType that can be // stored. template using FuncPointer = TR (*)(TA...); template struct FuncTypeAnalyzer {}; template struct FuncTypeAnalyzer> { static constexpr DynamicType result{host::FortranType{}.GetType()}; static constexpr TypeVector arguments{ TypeVector::Create...>()}; }; // Define helpers to deal with host floating environment. template static void CheckFloatingPointIssues( host::HostFloatingPointEnvironment &hostFPE, const Scalar &x) { if constexpr (TR::category == TypeCategory::Complex || TR::category == TypeCategory::Real) { if (x.IsNotANumber()) { hostFPE.SetFlag(RealFlag::InvalidArgument); } else if (x.IsInfinite()) { hostFPE.SetFlag(RealFlag::Overflow); } } } // Software Subnormal Flushing helper. // Only flush floating-points. Forward other scalars untouched. // Software flushing is only performed if hardware flushing is not available // because it may not result in the same behavior as hardware flushing. // Some runtime implementations are "working around" subnormal flushing to // return results that they deem better than returning the result they would // with a null argument. An example is logf that should return -inf if arguments // are flushed to zero, but some implementations return -1.03972076416015625e2_4 // for all subnormal values instead. It is impossible to reproduce this with the // simple software flushing below. template static constexpr inline const Scalar FlushSubnormals(Scalar &&x) { if constexpr (T::category == TypeCategory::Real || T::category == TypeCategory::Complex) { return x.FlushSubnormalToZero(); } return x; } // This is the kernel called by all HostRuntimeFunction folders, it convert the // Fortran Expr to the host runtime function argument types, calls // the runtime function, and wrap back the result into an Expr. // It deals with host floating point environment set-up and clean-up. template static Expr ApplyHostFunctionHelper(FuncType func, FoldingContext &context, std::vector> &&args, std::index_sequence) { host::HostFloatingPointEnvironment hostFPE; hostFPE.SetUpHostFloatingPointEnvironment(context); host::HostType hostResult{}; Scalar result{}; std::tuple...> scalarArgs{ GetScalarConstantValue(args[I]).value()...}; if (context.targetCharacteristics().areSubnormalsFlushedToZero() && !hostFPE.hasSubnormalFlushingHardwareControl()) { hostResult = func(host::CastFortranToHost( FlushSubnormals(std::move(std::get(scalarArgs))))...); result = FlushSubnormals(host::CastHostToFortran(hostResult)); } else { hostResult = func(host::CastFortranToHost(std::get(scalarArgs))...); result = host::CastHostToFortran(hostResult); } if (!hostFPE.hardwareFlagsAreReliable()) { CheckFloatingPointIssues(hostFPE, result); } hostFPE.CheckAndRestoreFloatingPointEnvironment(context); return AsGenericExpr(Constant(std::move(result))); } template Expr ApplyHostFunction(FuncPointer func, FoldingContext &context, std::vector> &&args) { return ApplyHostFunctionHelper, host::FortranType...>( func, context, std::move(args), std::index_sequence_for{}); } // FolderFactory builds a HostRuntimeFunction for the host runtime function // passed as a template argument. // Its static member function "fold" is the resulting folder. It captures the // host runtime function pointer and pass it to the host runtime function folder // kernel. template class FolderFactory { public: static constexpr HostRuntimeFunction Create(const std::string_view &name) { return HostRuntimeFunction{name, FuncTypeAnalyzer::result, FuncTypeAnalyzer::arguments, &Fold}; } private: static Expr Fold( FoldingContext &context, std::vector> &&args) { return ApplyHostFunction(func, context, std::move(args)); } }; // Define host runtime libraries that can be used for folding and // fill their description if they are available. enum class LibraryVersion { Libm, LibmExtensions, PgmathFast, PgmathRelaxed, PgmathPrecise }; template struct HostRuntimeLibrary { // When specialized, this class holds a static constexpr table containing // all the HostRuntimeLibrary for functions of library LibraryVersion // that returns a value of type HostT. }; using HostRuntimeMap = common::StaticMultimapView; // Map numerical intrinsic to / functions // (Note: ABS() is folded in fold-real.cpp.) template struct HostRuntimeLibrary { using F = FuncPointer; using F2 = FuncPointer; static constexpr HostRuntimeFunction table[]{ FolderFactory::Create("acos"), FolderFactory::Create("acosh"), FolderFactory::Create("asin"), FolderFactory::Create("asinh"), FolderFactory::Create("atan"), FolderFactory::Create("atan2"), FolderFactory::Create("atanh"), FolderFactory::Create("cos"), FolderFactory::Create("cosh"), FolderFactory::Create("erf"), FolderFactory::Create("erfc"), FolderFactory::Create("erfc_scaled"), FolderFactory::Create("exp"), FolderFactory::Create("gamma"), FolderFactory::Create("log"), FolderFactory::Create("log10"), FolderFactory::Create("log_gamma"), FolderFactory::Create("pow"), FolderFactory::Create("sin"), FolderFactory::Create("sinh"), FolderFactory::Create("tan"), FolderFactory::Create("tanh"), }; // Note: cmath does not have modulo and erfc_scaled equivalent // Note regarding lack of bessel function support: // C++17 defined standard Bessel math functions std::cyl_bessel_j // and std::cyl_neumann that can be used for Fortran j and y // bessel functions. However, they are not yet implemented in // clang libc++ (ok in GNU libstdc++). C maths functions j0... // are not C standard but a GNU extension so they are not used // to avoid introducing incompatibilities. // Use libpgmath to get bessel function folding support. // TODO: Add Bessel functions when possible. static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; // Helpers to map complex std::pow whose resolution in F2{std::pow} is // ambiguous as of clang++ 20. template static std::complex StdPowF2( const std::complex &x, const std::complex &y) { return std::pow(x, y); } template static std::complex StdPowF2A( const HostT &x, const std::complex &y) { return std::pow(x, y); } template static std::complex StdPowF2B( const std::complex &x, const HostT &y) { return std::pow(x, y); } #ifdef _AIX #ifdef __clang_major__ #pragma clang diagnostic ignored "-Wc99-extensions" #endif extern "C" { float _Complex cacosf(float _Complex); double _Complex cacos(double _Complex); float _Complex csqrtf(float _Complex); double _Complex csqrt(double _Complex); } enum CRI { Real, Imag }; template static TR &reIm(TA &x, CRI n) { return reinterpret_cast(x)[n]; } template static TR CppToC(const std::complex &x) { TR r; reIm(r, CRI::Real) = x.real(); reIm(r, CRI::Imag) = x.imag(); return r; } template static std::complex CToCpp(const TA &x) { TA &z{const_cast(x)}; return std::complex(reIm(z, CRI::Real), reIm(z, CRI::Imag)); } #endif template static std::complex CSqrt(const std::complex &x) { std::complex res; #ifdef _AIX // On AIX, the implementation of csqrt[f] and std::sqrt is different, // use csqrt[f] in folding. if constexpr (std::is_same_v) { float _Complex r{csqrtf(CppToC(x))}; res = CToCpp(r); } else if constexpr (std::is_same_v) { double _Complex r{csqrt(CppToC(x))}; res = CToCpp(r); } else { DIE("bad complex component type"); } #else res = std::sqrt(x); #endif return res; } template static std::complex CAcos(const std::complex &x) { std::complex res; #ifdef _AIX // On AIX, the implementation of cacos[f] and std::acos is different, // use cacos[f] in folding. if constexpr (std::is_same_v) { float _Complex r{cacosf(CppToC(x))}; res = CToCpp(r); } else if constexpr (std::is_same_v) { double _Complex r{cacos(CppToC(x))}; res = CToCpp(r); } else { DIE("bad complex component type"); } #else res = std::acos(x); #endif return res; } template struct HostRuntimeLibrary, LibraryVersion::Libm> { using F = FuncPointer, const std::complex &>; using F2 = FuncPointer, const std::complex &, const std::complex &>; using F2A = FuncPointer, const HostT &, const std::complex &>; using F2B = FuncPointer, const std::complex &, const HostT &>; static constexpr HostRuntimeFunction table[]{ FolderFactory::Create("acos"), FolderFactory::Create("acosh"), FolderFactory::Create("asin"), FolderFactory::Create("asinh"), FolderFactory::Create("atan"), FolderFactory::Create("atanh"), FolderFactory::Create("cos"), FolderFactory::Create("cosh"), FolderFactory::Create("exp"), FolderFactory::Create("log"), FolderFactory::Create("pow"), FolderFactory::Create("pow"), FolderFactory::Create("pow"), FolderFactory::Create("sin"), FolderFactory::Create("sinh"), FolderFactory::Create("sqrt"), FolderFactory::Create("tan"), FolderFactory::Create("tanh"), }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; // Note regarding cmath: // - cmath does not have modulo and erfc_scaled equivalent // - C++17 defined standard Bessel math functions std::cyl_bessel_j // and std::cyl_neumann that can be used for Fortran j and y // bessel functions. However, they are not yet implemented in // clang libc++ (ok in GNU libstdc++). Instead, the Posix libm // extensions are used when available below. #if _POSIX_C_SOURCE >= 200112L || _XOPEN_SOURCE >= 600 /// Define libm extensions /// Bessel functions are defined in POSIX.1-2001. // Remove float bessel functions for AIX and Darwin as they are not supported #if !defined(_AIX) && !defined(__APPLE__) template <> struct HostRuntimeLibrary { using F = FuncPointer; using FN = FuncPointer; static constexpr HostRuntimeFunction table[]{ FolderFactory::Create("bessel_j0"), FolderFactory::Create("bessel_j1"), FolderFactory::Create("bessel_jn"), FolderFactory::Create("bessel_y0"), FolderFactory::Create("bessel_y1"), FolderFactory::Create("bessel_yn"), }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; #endif #if HAS_QUADMATHLIB template <> struct HostRuntimeLibrary<__float128, LibraryVersion::Libm> { using F = FuncPointer<__float128, __float128>; using F2 = FuncPointer<__float128, __float128, __float128>; using FN = FuncPointer<__float128, int, __float128>; static constexpr HostRuntimeFunction table[]{ FolderFactory::Create("acos"), FolderFactory::Create("acosh"), FolderFactory::Create("asin"), FolderFactory::Create("asinh"), FolderFactory::Create("atan"), FolderFactory::Create("atan2"), FolderFactory::Create("atanh"), FolderFactory::Create("bessel_j0"), FolderFactory::Create("bessel_j1"), FolderFactory::Create("bessel_jn"), FolderFactory::Create("bessel_y0"), FolderFactory::Create("bessel_y1"), FolderFactory::Create("bessel_yn"), FolderFactory::Create("cos"), FolderFactory::Create("cosh"), FolderFactory::Create("erf"), FolderFactory::Create("erfc"), FolderFactory::Create("exp"), FolderFactory::Create("gamma"), FolderFactory::Create("log"), FolderFactory::Create("log10"), FolderFactory::Create("log_gamma"), FolderFactory::Create("pow"), FolderFactory::Create("sin"), FolderFactory::Create("sinh"), FolderFactory::Create("tan"), FolderFactory::Create("tanh"), }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; template <> struct HostRuntimeLibrary<__complex128, LibraryVersion::Libm> { using F = FuncPointer<__complex128, __complex128>; using F2 = FuncPointer<__complex128, __complex128, __complex128>; static constexpr HostRuntimeFunction table[]{ FolderFactory::Create("acos"), FolderFactory::Create("acosh"), FolderFactory::Create("asin"), FolderFactory::Create("asinh"), FolderFactory::Create("atan"), FolderFactory::Create("atanh"), FolderFactory::Create("cos"), FolderFactory::Create("cosh"), FolderFactory::Create("exp"), FolderFactory::Create("log"), FolderFactory::Create("pow"), FolderFactory::Create("sin"), FolderFactory::Create("sinh"), FolderFactory::Create("sqrt"), FolderFactory::Create("tan"), FolderFactory::Create("tanh"), }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; #endif template <> struct HostRuntimeLibrary { using F = FuncPointer; using FN = FuncPointer; static constexpr HostRuntimeFunction table[]{ FolderFactory::Create("bessel_j0"), FolderFactory::Create("bessel_j1"), FolderFactory::Create("bessel_jn"), FolderFactory::Create("bessel_y0"), FolderFactory::Create("bessel_y1"), FolderFactory::Create("bessel_yn"), }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; #if defined(__GLIBC__) && (HAS_FLOAT80 || HAS_LDBL128) template <> struct HostRuntimeLibrary { using F = FuncPointer; using FN = FuncPointer; static constexpr HostRuntimeFunction table[]{ FolderFactory::Create("bessel_j0"), FolderFactory::Create("bessel_j1"), FolderFactory::Create("bessel_jn"), FolderFactory::Create("bessel_y0"), FolderFactory::Create("bessel_y1"), FolderFactory::Create("bessel_yn"), }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; #endif // HAS_FLOAT80 || HAS_LDBL128 #endif //_POSIX_C_SOURCE >= 200112L || _XOPEN_SOURCE >= 600 /// Define pgmath description #if LINK_WITH_LIBPGMATH // Only use libpgmath for folding if it is available. // First declare all libpgmaths functions #define PGMATH_LINKING #define PGMATH_DECLARE #include "flang/Evaluate/pgmath.h.inc" #define REAL_FOLDER(name, func) \ FolderFactory::Create(#name) template <> struct HostRuntimeLibrary { static constexpr HostRuntimeFunction table[]{ #define PGMATH_FAST #define PGMATH_USE_S(name, func) REAL_FOLDER(name, func), #include "flang/Evaluate/pgmath.h.inc" }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; template <> struct HostRuntimeLibrary { static constexpr HostRuntimeFunction table[]{ #define PGMATH_FAST #define PGMATH_USE_D(name, func) REAL_FOLDER(name, func), #include "flang/Evaluate/pgmath.h.inc" }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; template <> struct HostRuntimeLibrary { static constexpr HostRuntimeFunction table[]{ #define PGMATH_RELAXED #define PGMATH_USE_S(name, func) REAL_FOLDER(name, func), #include "flang/Evaluate/pgmath.h.inc" }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; template <> struct HostRuntimeLibrary { static constexpr HostRuntimeFunction table[]{ #define PGMATH_RELAXED #define PGMATH_USE_D(name, func) REAL_FOLDER(name, func), #include "flang/Evaluate/pgmath.h.inc" }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; template <> struct HostRuntimeLibrary { static constexpr HostRuntimeFunction table[]{ #define PGMATH_PRECISE #define PGMATH_USE_S(name, func) REAL_FOLDER(name, func), #include "flang/Evaluate/pgmath.h.inc" }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; template <> struct HostRuntimeLibrary { static constexpr HostRuntimeFunction table[]{ #define PGMATH_PRECISE #define PGMATH_USE_D(name, func) REAL_FOLDER(name, func), #include "flang/Evaluate/pgmath.h.inc" }; static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; // TODO: double _Complex/float _Complex have been removed from llvm flang // pgmath.h.inc because they caused warnings, they need to be added back // so that the complex pgmath versions can be used when requested. #endif /* LINK_WITH_LIBPGMATH */ // Helper to check if a HostRuntimeLibrary specialization exists template struct IsAvailable : std::false_type {}; template struct IsAvailable : std::true_type {}; // Define helpers to find host runtime library map according to desired version // and type. template static const HostRuntimeMap *GetHostRuntimeMapHelper( [[maybe_unused]] DynamicType resultType) { // A library must only be instantiated if LibraryVersion is // available on the host and if HostT maps to a Fortran type. // For instance, whenever long double and double are both 64-bits, double // is mapped to Fortran 64bits real type, and long double will be left // unmapped. if constexpr (host::FortranTypeExists()) { using Lib = HostRuntimeLibrary; if constexpr (IsAvailable::value) { if (host::FortranType{}.GetType() == resultType) { return &Lib::map; } } } return nullptr; } template static const HostRuntimeMap *GetHostRuntimeMapVersion(DynamicType resultType) { if (resultType.category() == TypeCategory::Real) { if (const auto *map{GetHostRuntimeMapHelper(resultType)}) { return map; } if (const auto *map{GetHostRuntimeMapHelper(resultType)}) { return map; } if (const auto *map{ GetHostRuntimeMapHelper(resultType)}) { return map; } #if HAS_QUADMATHLIB if (const auto *map{ GetHostRuntimeMapHelper<__float128, version>(resultType)}) { return map; } #endif } if (resultType.category() == TypeCategory::Complex) { if (const auto *map{GetHostRuntimeMapHelper, version>( resultType)}) { return map; } if (const auto *map{GetHostRuntimeMapHelper, version>( resultType)}) { return map; } if (const auto *map{ GetHostRuntimeMapHelper, version>( resultType)}) { return map; } #if HAS_QUADMATHLIB if (const auto *map{ GetHostRuntimeMapHelper<__complex128, version>(resultType)}) { return map; } #endif } return nullptr; } static const HostRuntimeMap *GetHostRuntimeMap( LibraryVersion version, DynamicType resultType) { switch (version) { case LibraryVersion::Libm: return GetHostRuntimeMapVersion(resultType); case LibraryVersion::LibmExtensions: return GetHostRuntimeMapVersion(resultType); case LibraryVersion::PgmathPrecise: return GetHostRuntimeMapVersion(resultType); case LibraryVersion::PgmathRelaxed: return GetHostRuntimeMapVersion(resultType); case LibraryVersion::PgmathFast: return GetHostRuntimeMapVersion(resultType); } return nullptr; } static const HostRuntimeFunction *SearchInHostRuntimeMap( const HostRuntimeMap &map, const std::string &name, DynamicType resultType, const std::vector &argTypes) { auto sameNameRange{map.equal_range(name)}; for (const auto *iter{sameNameRange.first}; iter != sameNameRange.second; ++iter) { if (iter->resultType == resultType && iter->argumentTypes == argTypes) { return &*iter; } } return nullptr; } // Search host runtime libraries for an exact type match. static const HostRuntimeFunction *SearchHostRuntime(const std::string &name, DynamicType resultType, const std::vector &argTypes) { // TODO: When command line options regarding targeted numerical library is // available, this needs to be revisited to take it into account. So far, // default to libpgmath if F18 is built with it. #if LINK_WITH_LIBPGMATH if (const auto *map{ GetHostRuntimeMap(LibraryVersion::PgmathPrecise, resultType)}) { if (const auto *hostFunction{ SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) { return hostFunction; } } // Default to libm if functions or types are not available in pgmath. #endif if (const auto *map{GetHostRuntimeMap(LibraryVersion::Libm, resultType)}) { if (const auto *hostFunction{ SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) { return hostFunction; } } if (const auto *map{ GetHostRuntimeMap(LibraryVersion::LibmExtensions, resultType)}) { if (const auto *hostFunction{ SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) { return hostFunction; } } return nullptr; } // Return a DynamicType that can hold all values of a given type. // This is used to allow 16bit float to be folded with 32bits and // x87 float to be folded with IEEE 128bits. static DynamicType BiggerType(DynamicType type) { if (type.category() == TypeCategory::Real || type.category() == TypeCategory::Complex) { // 16 bits floats to IEEE 32 bits float if (type.kind() == common::RealKindForPrecision(11) || type.kind() == common::RealKindForPrecision(8)) { return {type.category(), common::RealKindForPrecision(24)}; } // x87 float to IEEE 128 bits float if (type.kind() == common::RealKindForPrecision(64)) { return {type.category(), common::RealKindForPrecision(113)}; } } return type; } /// Structure to register intrinsic argument checks that must be performed. using ArgumentVerifierFunc = bool (*)( const std::vector> &, FoldingContext &); struct ArgumentVerifier { using Key = std::string_view; // Needed for implicit compare with keys. constexpr operator Key() const { return key; } Key key; ArgumentVerifierFunc verifier; }; static constexpr int lastArg{-1}; static constexpr int firstArg{0}; static const Expr &GetArg( int position, const std::vector> &args) { if (position == lastArg) { CHECK(!args.empty()); return args.back(); } CHECK(position >= 0 && static_cast(position) < args.size()); return args[position]; } template static bool IsInRange(const Expr &expr, int lb, int ub) { if (auto scalar{GetScalarConstantValue(expr)}) { auto lbValue{Scalar::FromInteger(value::Integer<8>{lb}).value}; auto ubValue{Scalar::FromInteger(value::Integer<8>{ub}).value}; return Satisfies(RelationalOperator::LE, lbValue.Compare(*scalar)) && Satisfies(RelationalOperator::LE, scalar->Compare(ubValue)); } return true; } /// Verify that the argument in an intrinsic call belongs to [lb, ub] if is /// real. template static bool VerifyInRangeIfReal( const std::vector> &args, FoldingContext &context) { if (const auto *someReal{ std::get_if>(&GetArg(firstArg, args).u)}) { bool isInRange{ std::visit([&](const auto &x) -> bool { return IsInRange(x, lb, ub); }, someReal->u)}; if (!isInRange) { context.messages().Say( "argument is out of range [%d., %d.]"_warn_en_US, lb, ub); } return isInRange; } return true; } template static bool VerifyStrictlyPositiveIfReal( const std::vector> &args, FoldingContext &context) { if (const auto *someReal = std::get_if>(&GetArg(argPosition, args).u)) { const bool isStrictlyPositive{std::visit( [&](const auto &x) -> bool { using T = typename std::decay_t::Result; auto scalar{GetScalarConstantValue(x)}; return Satisfies( RelationalOperator::LT, Scalar{}.Compare(*scalar)); }, someReal->u)}; if (!isStrictlyPositive) { context.messages().Say( "argument '%s' must be strictly positive"_warn_en_US, argName); } return isStrictlyPositive; } return true; } /// Verify that an intrinsic call argument is not zero if it is real. template static bool VerifyNotZeroIfReal( const std::vector> &args, FoldingContext &context) { if (const auto *someReal = std::get_if>(&GetArg(argPosition, args).u)) { const bool isNotZero{std::visit( [&](const auto &x) -> bool { using T = typename std::decay_t::Result; auto scalar{GetScalarConstantValue(x)}; return !scalar || !scalar->IsZero(); }, someReal->u)}; if (!isNotZero) { context.messages().Say( "argument '%s' must be different from zero"_warn_en_US, argName); } return isNotZero; } return true; } /// Verify that the argument in an intrinsic call is not zero if is complex. static bool VerifyNotZeroIfComplex( const std::vector> &args, FoldingContext &context) { if (const auto *someComplex = std::get_if>(&GetArg(firstArg, args).u)) { const bool isNotZero{std::visit( [&](const auto &z) -> bool { using T = typename std::decay_t::Result; auto scalar{GetScalarConstantValue(z)}; return !scalar || !scalar->IsZero(); }, someComplex->u)}; if (!isNotZero) { context.messages().Say( "complex argument must be different from zero"_warn_en_US); } return isNotZero; } return true; } // Verify that the argument in an intrinsic call is not zero and not a negative // integer. static bool VerifyGammaLikeArgument( const std::vector> &args, FoldingContext &context) { if (const auto *someReal = std::get_if>(&GetArg(firstArg, args).u)) { const bool isValid{std::visit( [&](const auto &x) -> bool { using T = typename std::decay_t::Result; auto scalar{GetScalarConstantValue(x)}; if (scalar) { return !scalar->IsZero() && !(scalar->IsNegative() && scalar->ToWholeNumber().value == scalar); } return true; }, someReal->u)}; if (!isValid) { context.messages().Say( "argument must not be a negative integer or zero"_warn_en_US); } return isValid; } return true; } // Verify that two real arguments are not both zero. static bool VerifyAtan2LikeArguments( const std::vector> &args, FoldingContext &context) { if (const auto *someReal = std::get_if>(&GetArg(firstArg, args).u)) { const bool isValid{std::visit( [&](const auto &typedExpr) -> bool { using T = typename std::decay_t::Result; auto x{GetScalarConstantValue(typedExpr)}; auto y{GetScalarConstantValue(GetArg(lastArg, args))}; if (x && y) { return !(x->IsZero() && y->IsZero()); } return true; }, someReal->u)}; if (!isValid) { context.messages().Say( "'x' and 'y' arguments must not be both zero"_warn_en_US); } return isValid; } return true; } template static bool CombineVerifiers( const std::vector> &args, FoldingContext &context) { return (... && F(args, context)); } /// Define argument names to be used error messages when the intrinsic have /// several arguments. static constexpr char xName[]{"x"}; static constexpr char pName[]{"p"}; /// Register argument verifiers for all intrinsics folded with runtime. static constexpr ArgumentVerifier intrinsicArgumentVerifiers[]{ {"acos", VerifyInRangeIfReal<-1, 1>}, {"asin", VerifyInRangeIfReal<-1, 1>}, {"atan2", VerifyAtan2LikeArguments}, {"bessel_y0", VerifyStrictlyPositiveIfReal}, {"bessel_y1", VerifyStrictlyPositiveIfReal}, {"bessel_yn", VerifyStrictlyPositiveIfReal}, {"gamma", VerifyGammaLikeArgument}, {"log", CombineVerifiers, VerifyNotZeroIfComplex>}, {"log10", VerifyStrictlyPositiveIfReal}, {"log_gamma", VerifyGammaLikeArgument}, {"mod", VerifyNotZeroIfReal}, }; const ArgumentVerifierFunc *findVerifier(const std::string &intrinsicName) { static constexpr Fortran::common::StaticMultimapView verifiers(intrinsicArgumentVerifiers); static_assert(verifiers.Verify(), "map must be sorted"); auto range{verifiers.equal_range(intrinsicName)}; if (range.first != range.second) { return &range.first->verifier; } return nullptr; } /// Ensure argument verifiers, if any, are run before calling the runtime /// wrapper to fold an intrinsic. static HostRuntimeWrapper AddArgumentVerifierIfAny( const std::string &intrinsicName, const HostRuntimeFunction &hostFunction) { if (const auto *verifier{findVerifier(intrinsicName)}) { const HostRuntimeFunction *hostFunctionPtr = &hostFunction; return [hostFunctionPtr, verifier]( FoldingContext &context, std::vector> &&args) { const bool validArguments{(*verifier)(args, context)}; if (!validArguments) { // Silence fp signal warnings since a more detailed warning about // invalid arguments was already emitted. parser::Messages localBuffer; parser::ContextualMessages localMessages{&localBuffer}; FoldingContext localContext{context, localMessages}; return hostFunctionPtr->folder(localContext, std::move(args)); } return hostFunctionPtr->folder(context, std::move(args)); }; } return hostFunction.folder; } std::optional GetHostRuntimeWrapper(const std::string &name, DynamicType resultType, const std::vector &argTypes) { if (const auto *hostFunction{SearchHostRuntime(name, resultType, argTypes)}) { return AddArgumentVerifierIfAny(name, *hostFunction); } // If no exact match, search with "bigger" types and insert type // conversions around the folder. std::vector biggerArgTypes; evaluate::DynamicType biggerResultType{BiggerType(resultType)}; for (auto type : argTypes) { biggerArgTypes.emplace_back(BiggerType(type)); } if (const auto *hostFunction{ SearchHostRuntime(name, biggerResultType, biggerArgTypes)}) { auto hostFolderWithChecks{AddArgumentVerifierIfAny(name, *hostFunction)}; return [hostFunction, resultType, hostFolderWithChecks]( FoldingContext &context, std::vector> &&args) { auto nArgs{args.size()}; for (size_t i{0}; i < nArgs; ++i) { args[i] = Fold(context, ConvertToType(hostFunction->argumentTypes[i], std::move(args[i])) .value()); } return Fold(context, ConvertToType( resultType, hostFolderWithChecks(context, std::move(args))) .value()); }; } return std::nullopt; } } // namespace Fortran::evaluate