1065 lines · cpp
1//===-- lib/Evaluate/intrinsics-library.cpp -------------------------------===//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-exception6//7//===----------------------------------------------------------------------===//8 9// This file defines host runtime functions that can be used for folding10// intrinsic functions.11// The default host runtime folders are built with <cmath> and12// <complex> functions that are guaranteed to exist from the C++ standard.13 14#include "flang/Evaluate/intrinsics-library.h"15#include "fold-implementation.h"16#include "host.h"17#include "flang/Common/erfc-scaled.h"18#include "flang/Common/idioms.h"19#include "flang/Common/static-multimap-view.h"20#include "flang/Evaluate/expression.h"21#include <cfloat>22#include <cmath>23#include <complex>24#include <functional>25#if HAS_QUADMATHLIB26#include "quadmath_wrapper.h"27#endif28#include "flang/Common/float128.h"29#include "flang/Common/float80.h"30#include <type_traits>31 32namespace Fortran::evaluate {33 34// Define a vector like class that can hold an arbitrary number of35// Dynamic type and be built at compile time. This is like a36// std::vector<DynamicType>, but constexpr only.37template <typename... FortranType> struct TypeVectorStorage {38 static constexpr DynamicType values[]{FortranType{}.GetType()...};39 static constexpr const DynamicType *start{&values[0]};40 static constexpr const DynamicType *end{start + sizeof...(FortranType)};41};42template <> struct TypeVectorStorage<> {43 static constexpr const DynamicType *start{nullptr}, *end{nullptr};44};45struct TypeVector {46 template <typename... FortranType> static constexpr TypeVector Create() {47 using storage = TypeVectorStorage<FortranType...>;48 return TypeVector{storage::start, storage::end, sizeof...(FortranType)};49 }50 constexpr size_t size() const { return size_; };51 using const_iterator = const DynamicType *;52 constexpr const_iterator begin() const { return startPtr; }53 constexpr const_iterator end() const { return endPtr; }54 const DynamicType &operator[](size_t i) const { return *(startPtr + i); }55 56 const DynamicType *startPtr{nullptr};57 const DynamicType *endPtr{nullptr};58 const size_t size_;59};60inline bool operator==(61 const TypeVector &lhs, const std::vector<DynamicType> &rhs) {62 if (lhs.size() != rhs.size()) {63 return false;64 }65 for (size_t i{0}; i < lhs.size(); ++i) {66 if (lhs[i] != rhs[i]) {67 return false;68 }69 }70 return true;71}72 73// HostRuntimeFunction holds a pointer to a Folder function that can fold74// a Fortran scalar intrinsic using host runtime functions (e.g libm).75// The folder take care of all conversions between Fortran types and the related76// host types as well as setting and cleaning-up the floating point environment.77// HostRuntimeFunction are intended to be built at compile time (members are all78// constexpr constructible) so that they can be stored in a compile time static79// map.80struct HostRuntimeFunction {81 using Folder = Expr<SomeType> (*)(82 FoldingContext &, std::vector<Expr<SomeType>> &&);83 using Key = std::string_view;84 // Needed for implicit compare with keys.85 constexpr operator Key() const { return key; }86 // Name of the related Fortran intrinsic.87 Key key;88 // DynamicType of the Expr<SomeType> returns by folder.89 DynamicType resultType;90 // DynamicTypes expected for the Expr<SomeType> arguments of the folder.91 // The folder will crash if provided arguments of different types.92 TypeVector argumentTypes;93 // Folder to be called to fold the intrinsic with host runtime. The provided94 // Expr<SomeType> arguments must wrap scalar constants of the type described95 // in argumentTypes, otherwise folder will crash. Any floating point issue96 // raised while executing the host runtime will be reported in FoldingContext97 // messages.98 Folder folder;99};100 101// Translate a host function type signature (template arguments) into a102// constexpr data representation based on Fortran DynamicType that can be103// stored.104template <typename TR, typename... TA> using FuncPointer = TR (*)(TA...);105template <typename T> struct FuncTypeAnalyzer {};106template <typename HostTR, typename... HostTA>107struct FuncTypeAnalyzer<FuncPointer<HostTR, HostTA...>> {108 static constexpr DynamicType result{host::FortranType<HostTR>{}.GetType()};109 static constexpr TypeVector arguments{110 TypeVector::Create<host::FortranType<HostTA>...>()};111};112 113// Define helpers to deal with host floating environment.114template <typename TR>115static void CheckFloatingPointIssues(116 host::HostFloatingPointEnvironment &hostFPE, const Scalar<TR> &x) {117 if constexpr (TR::category == TypeCategory::Complex ||118 TR::category == TypeCategory::Real) {119 if (x.IsNotANumber()) {120 hostFPE.SetFlag(RealFlag::InvalidArgument);121 } else if (x.IsInfinite()) {122 hostFPE.SetFlag(RealFlag::Overflow);123 }124 }125}126// Software Subnormal Flushing helper.127// Only flush floating-points. Forward other scalars untouched.128// Software flushing is only performed if hardware flushing is not available129// because it may not result in the same behavior as hardware flushing.130// Some runtime implementations are "working around" subnormal flushing to131// return results that they deem better than returning the result they would132// with a null argument. An example is logf that should return -inf if arguments133// are flushed to zero, but some implementations return -1.03972076416015625e2_4134// for all subnormal values instead. It is impossible to reproduce this with the135// simple software flushing below.136template <typename T>137static constexpr inline const Scalar<T> FlushSubnormals(Scalar<T> &&x) {138 if constexpr (T::category == TypeCategory::Real ||139 T::category == TypeCategory::Complex) {140 return x.FlushSubnormalToZero();141 }142 return x;143}144 145// This is the kernel called by all HostRuntimeFunction folders, it convert the146// Fortran Expr<SomeType> to the host runtime function argument types, calls147// the runtime function, and wrap back the result into an Expr<SomeType>.148// It deals with host floating point environment set-up and clean-up.149template <typename FuncType, typename TR, typename... TA, size_t... I>150static Expr<SomeType> ApplyHostFunctionHelper(FuncType func,151 FoldingContext &context, std::vector<Expr<SomeType>> &&args,152 std::index_sequence<I...>) {153 host::HostFloatingPointEnvironment hostFPE;154 hostFPE.SetUpHostFloatingPointEnvironment(context);155 host::HostType<TR> hostResult{};156 Scalar<TR> result{};157 std::tuple<Scalar<TA>...> scalarArgs{158 GetScalarConstantValue<TA>(args[I]).value()...};159 if (context.targetCharacteristics().areSubnormalsFlushedToZero() &&160 !hostFPE.hasSubnormalFlushingHardwareControl()) {161 hostResult = func(host::CastFortranToHost<TA>(162 FlushSubnormals<TA>(std::move(std::get<I>(scalarArgs))))...);163 result = FlushSubnormals<TR>(host::CastHostToFortran<TR>(hostResult));164 } else {165 hostResult = func(host::CastFortranToHost<TA>(std::get<I>(scalarArgs))...);166 result = host::CastHostToFortran<TR>(hostResult);167 }168 if (!hostFPE.hardwareFlagsAreReliable()) {169 CheckFloatingPointIssues<TR>(hostFPE, result);170 }171 hostFPE.CheckAndRestoreFloatingPointEnvironment(context);172 return AsGenericExpr(Constant<TR>(std::move(result)));173}174template <typename HostTR, typename... HostTA>175Expr<SomeType> ApplyHostFunction(FuncPointer<HostTR, HostTA...> func,176 FoldingContext &context, std::vector<Expr<SomeType>> &&args) {177 return ApplyHostFunctionHelper<decltype(func), host::FortranType<HostTR>,178 host::FortranType<HostTA>...>(179 func, context, std::move(args), std::index_sequence_for<HostTA...>{});180}181 182// FolderFactory builds a HostRuntimeFunction for the host runtime function183// passed as a template argument.184// Its static member function "fold" is the resulting folder. It captures the185// host runtime function pointer and pass it to the host runtime function folder186// kernel.187template <typename HostFuncType, HostFuncType func> class FolderFactory {188public:189 static constexpr HostRuntimeFunction Create(const std::string_view &name) {190 return HostRuntimeFunction{name, FuncTypeAnalyzer<HostFuncType>::result,191 FuncTypeAnalyzer<HostFuncType>::arguments, &Fold};192 }193 194private:195 static Expr<SomeType> Fold(196 FoldingContext &context, std::vector<Expr<SomeType>> &&args) {197 return ApplyHostFunction(func, context, std::move(args));198 }199};200 201// Define host runtime libraries that can be used for folding and202// fill their description if they are available.203enum class LibraryVersion {204 Libm,205 LibmExtensions,206 PgmathFast,207 PgmathRelaxed,208 PgmathPrecise209};210template <typename HostT, LibraryVersion> struct HostRuntimeLibrary {211 // When specialized, this class holds a static constexpr table containing212 // all the HostRuntimeLibrary for functions of library LibraryVersion213 // that returns a value of type HostT.214};215 216using HostRuntimeMap = common::StaticMultimapView<HostRuntimeFunction>;217 218// Map numerical intrinsic to <cmath>/<complex> functions219// (Note: ABS() is folded in fold-real.cpp.)220template <typename HostT>221struct HostRuntimeLibrary<HostT, LibraryVersion::Libm> {222 using F = FuncPointer<HostT, HostT>;223 using F2 = FuncPointer<HostT, HostT, HostT>;224 static constexpr HostRuntimeFunction table[]{225 FolderFactory<F, F{std::acos}>::Create("acos"),226 FolderFactory<F, F{std::acosh}>::Create("acosh"),227 FolderFactory<F, F{std::asin}>::Create("asin"),228 FolderFactory<F, F{std::asinh}>::Create("asinh"),229 FolderFactory<F, F{std::atan}>::Create("atan"),230 FolderFactory<F2, F2{std::atan2}>::Create("atan2"),231 FolderFactory<F, F{std::atanh}>::Create("atanh"),232 FolderFactory<F, F{std::cos}>::Create("cos"),233 FolderFactory<F, F{std::cosh}>::Create("cosh"),234 FolderFactory<F, F{std::erf}>::Create("erf"),235 FolderFactory<F, F{std::erfc}>::Create("erfc"),236 FolderFactory<F, F{common::ErfcScaled}>::Create("erfc_scaled"),237 FolderFactory<F, F{std::exp}>::Create("exp"),238 FolderFactory<F, F{std::tgamma}>::Create("gamma"),239 FolderFactory<F, F{std::log}>::Create("log"),240 FolderFactory<F, F{std::log10}>::Create("log10"),241 FolderFactory<F, F{std::lgamma}>::Create("log_gamma"),242 FolderFactory<F2, F2{std::pow}>::Create("pow"),243 FolderFactory<F, F{std::sin}>::Create("sin"),244 FolderFactory<F, F{std::sinh}>::Create("sinh"),245 FolderFactory<F, F{std::tan}>::Create("tan"),246 FolderFactory<F, F{std::tanh}>::Create("tanh"),247 };248 // Note: cmath does not have modulo and erfc_scaled equivalent249 250 // Note regarding lack of bessel function support:251 // C++17 defined standard Bessel math functions std::cyl_bessel_j252 // and std::cyl_neumann that can be used for Fortran j and y253 // bessel functions. However, they are not yet implemented in254 // clang libc++ (ok in GNU libstdc++). C maths functions j0...255 // are not C standard but a GNU extension so they are not used256 // to avoid introducing incompatibilities.257 // Use libpgmath to get bessel function folding support.258 // TODO: Add Bessel functions when possible.259 static constexpr HostRuntimeMap map{table};260 static_assert(map.Verify(), "map must be sorted");261};262 263#define COMPLEX_SIGNATURES(HOST_T) \264 using F = FuncPointer<std::complex<HOST_T>, const std::complex<HOST_T> &>; \265 using F2 = FuncPointer<std::complex<HOST_T>, const std::complex<HOST_T> &, \266 const std::complex<HOST_T> &>; \267 using F2A = FuncPointer<std::complex<HOST_T>, const HOST_T &, \268 const std::complex<HOST_T> &>; \269 using F2B = FuncPointer<std::complex<HOST_T>, const std::complex<HOST_T> &, \270 const HOST_T &>;271 272#ifndef _AIX273// Helpers to map complex std::pow whose resolution in F2{std::pow} is274// ambiguous as of clang++ 20.275template <typename HostT>276static std::complex<HostT> StdPowF2(277 const std::complex<HostT> &x, const std::complex<HostT> &y) {278 return std::pow(x, y);279}280 281template <typename HostT>282static std::complex<HostT> StdPowF2A(283 const HostT &x, const std::complex<HostT> &y) {284 return std::pow(x, y);285}286 287template <typename HostT>288static std::complex<HostT> StdPowF2B(289 const std::complex<HostT> &x, const HostT &y) {290 return std::pow(x, y);291}292 293template <typename HostT>294struct HostRuntimeLibrary<std::complex<HostT>, LibraryVersion::Libm> {295 COMPLEX_SIGNATURES(HostT)296 static constexpr HostRuntimeFunction table[]{297 FolderFactory<F, F{std::acos}>::Create("acos"),298 FolderFactory<F, F{std::acosh}>::Create("acosh"),299 FolderFactory<F, F{std::asin}>::Create("asin"),300 FolderFactory<F, F{std::asinh}>::Create("asinh"),301 FolderFactory<F, F{std::atan}>::Create("atan"),302 FolderFactory<F, F{std::atanh}>::Create("atanh"),303 FolderFactory<F, F{std::cos}>::Create("cos"),304 FolderFactory<F, F{std::cosh}>::Create("cosh"),305 FolderFactory<F, F{std::exp}>::Create("exp"),306 FolderFactory<F, F{std::log}>::Create("log"),307 FolderFactory<F2, F2{StdPowF2}>::Create("pow"),308 FolderFactory<F2A, F2A{StdPowF2A}>::Create("pow"),309 FolderFactory<F2B, F2B{StdPowF2B}>::Create("pow"),310 FolderFactory<F, F{std::sin}>::Create("sin"),311 FolderFactory<F, F{std::sinh}>::Create("sinh"),312 FolderFactory<F, F{std::sqrt}>::Create("sqrt"),313 FolderFactory<F, F{std::tan}>::Create("tan"),314 FolderFactory<F, F{std::tanh}>::Create("tanh"),315 };316 static constexpr HostRuntimeMap map{table};317 static_assert(map.Verify(), "map must be sorted");318};319#else320// On AIX, call libm routines to preserve consistent value between321// runtime and compile time evaluation.322#ifdef __clang_major__323#pragma clang diagnostic ignored "-Wc99-extensions"324#endif325 326extern "C" {327float _Complex cacosf(float _Complex);328double _Complex cacos(double _Complex);329float _Complex cacoshf(float _Complex);330double _Complex cacosh(double _Complex);331float _Complex casinf(float _Complex);332double _Complex casin(double _Complex);333float _Complex casinhf(float _Complex);334double _Complex casinh(double _Complex);335float _Complex catanf(float _Complex);336double _Complex catan(double _Complex);337float _Complex catanhf(float _Complex);338double _Complex catanh(double _Complex);339float _Complex ccosf(float _Complex);340double _Complex ccos(double _Complex);341float _Complex ccoshf(float _Complex);342double _Complex ccosh(double _Complex);343float _Complex cexpf(float _Complex);344double _Complex cexp(double _Complex);345float _Complex clogf(float _Complex);346double _Complex __clog(double _Complex);347float _Complex cpowf(float _Complex, float _Complex);348double _Complex cpow(double _Complex, double _Complex);349float _Complex csinf(float _Complex);350double _Complex csin(double _Complex);351float _Complex csinhf(float _Complex);352double _Complex csinh(double _Complex);353float _Complex csqrtf(float _Complex);354double _Complex csqrt(double _Complex);355float _Complex ctanf(float _Complex);356double _Complex ctan(double _Complex);357float _Complex ctanhf(float _Complex);358double _Complex ctanh(double _Complex);359}360 361template <typename T> struct ToStdComplex {362 using Type = T;363 using AType = Type;364};365template <> struct ToStdComplex<float _Complex> {366 using Type = std::complex<float>;367 using AType = const Type &;368};369template <> struct ToStdComplex<double _Complex> {370 using Type = std::complex<double>;371 using AType = const Type &;372};373 374template <typename F, F func> struct CComplexFunc {};375template <typename R, typename... A, FuncPointer<R, A...> func>376struct CComplexFunc<FuncPointer<R, A...>, func> {377 static typename ToStdComplex<R>::Type wrapper(378 typename ToStdComplex<A>::AType... args) {379 R res{func(*reinterpret_cast<const A *>(&args)...)};380 return *reinterpret_cast<typename ToStdComplex<R>::Type *>(&res);381 }382};383#define C_COMPLEX_FUNC(func) CComplexFunc<decltype(&func), &func>::wrapper384 385template <>386struct HostRuntimeLibrary<std::complex<float>, LibraryVersion::Libm> {387 COMPLEX_SIGNATURES(float)388 static constexpr HostRuntimeFunction table[]{389 FolderFactory<F, C_COMPLEX_FUNC(cacosf)>::Create("acos"),390 FolderFactory<F, C_COMPLEX_FUNC(cacoshf)>::Create("acosh"),391 FolderFactory<F, C_COMPLEX_FUNC(casinf)>::Create("asin"),392 FolderFactory<F, C_COMPLEX_FUNC(casinhf)>::Create("asinh"),393 FolderFactory<F, C_COMPLEX_FUNC(catanf)>::Create("atan"),394 FolderFactory<F, C_COMPLEX_FUNC(catanhf)>::Create("atanh"),395 FolderFactory<F, C_COMPLEX_FUNC(ccosf)>::Create("cos"),396 FolderFactory<F, C_COMPLEX_FUNC(ccoshf)>::Create("cosh"),397 FolderFactory<F, C_COMPLEX_FUNC(cexpf)>::Create("exp"),398 FolderFactory<F, C_COMPLEX_FUNC(clogf)>::Create("log"),399 FolderFactory<F2, C_COMPLEX_FUNC(cpowf)>::Create("pow"),400 FolderFactory<F, C_COMPLEX_FUNC(csinf)>::Create("sin"),401 FolderFactory<F, C_COMPLEX_FUNC(csinhf)>::Create("sinh"),402 FolderFactory<F, C_COMPLEX_FUNC(csqrtf)>::Create("sqrt"),403 FolderFactory<F, C_COMPLEX_FUNC(ctanf)>::Create("tan"),404 FolderFactory<F, C_COMPLEX_FUNC(ctanhf)>::Create("tanh"),405 };406 static constexpr HostRuntimeMap map{table};407 static_assert(map.Verify(), "map must be sorted");408};409template <>410struct HostRuntimeLibrary<std::complex<double>, LibraryVersion::Libm> {411 COMPLEX_SIGNATURES(double)412 static constexpr HostRuntimeFunction table[]{413 FolderFactory<F, C_COMPLEX_FUNC(cacos)>::Create("acos"),414 FolderFactory<F, C_COMPLEX_FUNC(cacosh)>::Create("acosh"),415 FolderFactory<F, C_COMPLEX_FUNC(casin)>::Create("asin"),416 FolderFactory<F, C_COMPLEX_FUNC(casinh)>::Create("asinh"),417 FolderFactory<F, C_COMPLEX_FUNC(catan)>::Create("atan"),418 FolderFactory<F, C_COMPLEX_FUNC(catanh)>::Create("atanh"),419 FolderFactory<F, C_COMPLEX_FUNC(ccos)>::Create("cos"),420 FolderFactory<F, C_COMPLEX_FUNC(ccosh)>::Create("cosh"),421 FolderFactory<F, C_COMPLEX_FUNC(cexp)>::Create("exp"),422 FolderFactory<F, C_COMPLEX_FUNC(__clog)>::Create("log"),423 FolderFactory<F2, C_COMPLEX_FUNC(cpow)>::Create("pow"),424 FolderFactory<F, C_COMPLEX_FUNC(csin)>::Create("sin"),425 FolderFactory<F, C_COMPLEX_FUNC(csinh)>::Create("sinh"),426 FolderFactory<F, C_COMPLEX_FUNC(csqrt)>::Create("sqrt"),427 FolderFactory<F, C_COMPLEX_FUNC(ctan)>::Create("tan"),428 FolderFactory<F, C_COMPLEX_FUNC(ctanh)>::Create("tanh"),429 };430 static constexpr HostRuntimeMap map{table};431 static_assert(map.Verify(), "map must be sorted");432};433#endif // _AIX434 435// Note regarding cmath:436// - cmath does not have modulo and erfc_scaled equivalent437// - C++17 defined standard Bessel math functions std::cyl_bessel_j438// and std::cyl_neumann that can be used for Fortran j and y439// bessel functions. However, they are not yet implemented in440// clang libc++ (ok in GNU libstdc++). Instead, the Posix libm441// extensions are used when available below.442 443#if _POSIX_C_SOURCE >= 200112L || _XOPEN_SOURCE >= 600444/// Define libm extensions445/// Bessel functions are defined in POSIX.1-2001.446 447// Remove float bessel functions for AIX and Darwin as they are not supported448#if !defined(_AIX) && !defined(__APPLE__)449template <> struct HostRuntimeLibrary<float, LibraryVersion::LibmExtensions> {450 using F = FuncPointer<float, float>;451 using FN = FuncPointer<float, int, float>;452 static constexpr HostRuntimeFunction table[]{453 FolderFactory<F, F{::j0f}>::Create("bessel_j0"),454 FolderFactory<F, F{::j1f}>::Create("bessel_j1"),455 FolderFactory<FN, FN{::jnf}>::Create("bessel_jn"),456 FolderFactory<F, F{::y0f}>::Create("bessel_y0"),457 FolderFactory<F, F{::y1f}>::Create("bessel_y1"),458 FolderFactory<FN, FN{::ynf}>::Create("bessel_yn"),459 };460 static constexpr HostRuntimeMap map{table};461 static_assert(map.Verify(), "map must be sorted");462};463#endif464 465#if HAS_QUADMATHLIB466template <> struct HostRuntimeLibrary<__float128, LibraryVersion::Libm> {467 using F = FuncPointer<__float128, __float128>;468 using F2 = FuncPointer<__float128, __float128, __float128>;469 using FN = FuncPointer<__float128, int, __float128>;470 static constexpr HostRuntimeFunction table[]{471 FolderFactory<F, F{::acosq}>::Create("acos"),472 FolderFactory<F, F{::acoshq}>::Create("acosh"),473 FolderFactory<F, F{::asinq}>::Create("asin"),474 FolderFactory<F, F{::asinhq}>::Create("asinh"),475 FolderFactory<F, F{::atanq}>::Create("atan"),476 FolderFactory<F2, F2{::atan2q}>::Create("atan2"),477 FolderFactory<F, F{::atanhq}>::Create("atanh"),478 FolderFactory<F, F{::j0q}>::Create("bessel_j0"),479 FolderFactory<F, F{::j1q}>::Create("bessel_j1"),480 FolderFactory<FN, FN{::jnq}>::Create("bessel_jn"),481 FolderFactory<F, F{::y0q}>::Create("bessel_y0"),482 FolderFactory<F, F{::y1q}>::Create("bessel_y1"),483 FolderFactory<FN, FN{::ynq}>::Create("bessel_yn"),484 FolderFactory<F, F{::cosq}>::Create("cos"),485 FolderFactory<F, F{::coshq}>::Create("cosh"),486 FolderFactory<F, F{::erfq}>::Create("erf"),487 FolderFactory<F, F{::erfcq}>::Create("erfc"),488 FolderFactory<F, F{::expq}>::Create("exp"),489 FolderFactory<F, F{::tgammaq}>::Create("gamma"),490 FolderFactory<F, F{::logq}>::Create("log"),491 FolderFactory<F, F{::log10q}>::Create("log10"),492 FolderFactory<F, F{::lgammaq}>::Create("log_gamma"),493 FolderFactory<F2, F2{::powq}>::Create("pow"),494 FolderFactory<F, F{::sinq}>::Create("sin"),495 FolderFactory<F, F{::sinhq}>::Create("sinh"),496 FolderFactory<F, F{::tanq}>::Create("tan"),497 FolderFactory<F, F{::tanhq}>::Create("tanh"),498 };499 static constexpr HostRuntimeMap map{table};500 static_assert(map.Verify(), "map must be sorted");501};502template <> struct HostRuntimeLibrary<__complex128, LibraryVersion::Libm> {503 using F = FuncPointer<__complex128, __complex128>;504 using F2 = FuncPointer<__complex128, __complex128, __complex128>;505 static constexpr HostRuntimeFunction table[]{506 FolderFactory<F, F{::cacosq}>::Create("acos"),507 FolderFactory<F, F{::cacoshq}>::Create("acosh"),508 FolderFactory<F, F{::casinq}>::Create("asin"),509 FolderFactory<F, F{::casinhq}>::Create("asinh"),510 FolderFactory<F, F{::catanq}>::Create("atan"),511 FolderFactory<F, F{::catanhq}>::Create("atanh"),512 FolderFactory<F, F{::ccosq}>::Create("cos"),513 FolderFactory<F, F{::ccoshq}>::Create("cosh"),514 FolderFactory<F, F{::cexpq}>::Create("exp"),515 FolderFactory<F, F{::clogq}>::Create("log"),516 FolderFactory<F2, F2{::cpowq}>::Create("pow"),517 FolderFactory<F, F{::csinq}>::Create("sin"),518 FolderFactory<F, F{::csinhq}>::Create("sinh"),519 FolderFactory<F, F{::csqrtq}>::Create("sqrt"),520 FolderFactory<F, F{::ctanq}>::Create("tan"),521 FolderFactory<F, F{::ctanhq}>::Create("tanh"),522 };523 static constexpr HostRuntimeMap map{table};524 static_assert(map.Verify(), "map must be sorted");525};526#endif527 528template <> struct HostRuntimeLibrary<double, LibraryVersion::LibmExtensions> {529 using F = FuncPointer<double, double>;530 using FN = FuncPointer<double, int, double>;531 static constexpr HostRuntimeFunction table[]{532 FolderFactory<F, F{::j0}>::Create("bessel_j0"),533 FolderFactory<F, F{::j1}>::Create("bessel_j1"),534 FolderFactory<FN, FN{::jn}>::Create("bessel_jn"),535 FolderFactory<F, F{::y0}>::Create("bessel_y0"),536 FolderFactory<F, F{::y1}>::Create("bessel_y1"),537 FolderFactory<FN, FN{::yn}>::Create("bessel_yn"),538 };539 static constexpr HostRuntimeMap map{table};540 static_assert(map.Verify(), "map must be sorted");541};542 543#if defined(__GLIBC__) && (HAS_FLOAT80 || HAS_LDBL128)544template <>545struct HostRuntimeLibrary<long double, LibraryVersion::LibmExtensions> {546 using F = FuncPointer<long double, long double>;547 using FN = FuncPointer<long double, int, long double>;548 static constexpr HostRuntimeFunction table[]{549 FolderFactory<F, F{::j0l}>::Create("bessel_j0"),550 FolderFactory<F, F{::j1l}>::Create("bessel_j1"),551 FolderFactory<FN, FN{::jnl}>::Create("bessel_jn"),552 FolderFactory<F, F{::y0l}>::Create("bessel_y0"),553 FolderFactory<F, F{::y1l}>::Create("bessel_y1"),554 FolderFactory<FN, FN{::ynl}>::Create("bessel_yn"),555 };556 static constexpr HostRuntimeMap map{table};557 static_assert(map.Verify(), "map must be sorted");558};559#endif // HAS_FLOAT80 || HAS_LDBL128560#endif //_POSIX_C_SOURCE >= 200112L || _XOPEN_SOURCE >= 600561 562#ifdef _WIN32563template <> struct HostRuntimeLibrary<double, LibraryVersion::LibmExtensions> {564 using F = FuncPointer<double, double>;565 using FN = FuncPointer<double, int, double>;566 static constexpr HostRuntimeFunction table[]{567 FolderFactory<F, F{::_j0}>::Create("bessel_j0"),568 FolderFactory<F, F{::_j1}>::Create("bessel_j1"),569 FolderFactory<FN, FN{::_jn}>::Create("bessel_jn"),570 FolderFactory<F, F{::_y0}>::Create("bessel_y0"),571 FolderFactory<F, F{::_y1}>::Create("bessel_y1"),572 FolderFactory<FN, FN{::_yn}>::Create("bessel_yn"),573 };574 static constexpr HostRuntimeMap map{table};575 static_assert(map.Verify(), "map must be sorted");576};577#endif578 579/// Define pgmath description580#if LINK_WITH_LIBPGMATH581// Only use libpgmath for folding if it is available.582// First declare all libpgmaths functions583#define PGMATH_LINKING584#define PGMATH_DECLARE585#include "flang/Evaluate/pgmath.h.inc"586 587#define REAL_FOLDER(name, func) \588 FolderFactory<decltype(&func), &func>::Create(#name)589template <> struct HostRuntimeLibrary<float, LibraryVersion::PgmathFast> {590 static constexpr HostRuntimeFunction table[]{591#define PGMATH_FAST592#define PGMATH_USE_S(name, func) REAL_FOLDER(name, func),593#include "flang/Evaluate/pgmath.h.inc"594 };595 static constexpr HostRuntimeMap map{table};596 static_assert(map.Verify(), "map must be sorted");597};598template <> struct HostRuntimeLibrary<double, LibraryVersion::PgmathFast> {599 static constexpr HostRuntimeFunction table[]{600#define PGMATH_FAST601#define PGMATH_USE_D(name, func) REAL_FOLDER(name, func),602#include "flang/Evaluate/pgmath.h.inc"603 };604 static constexpr HostRuntimeMap map{table};605 static_assert(map.Verify(), "map must be sorted");606};607template <> struct HostRuntimeLibrary<float, LibraryVersion::PgmathRelaxed> {608 static constexpr HostRuntimeFunction table[]{609#define PGMATH_RELAXED610#define PGMATH_USE_S(name, func) REAL_FOLDER(name, func),611#include "flang/Evaluate/pgmath.h.inc"612 };613 static constexpr HostRuntimeMap map{table};614 static_assert(map.Verify(), "map must be sorted");615};616template <> struct HostRuntimeLibrary<double, LibraryVersion::PgmathRelaxed> {617 static constexpr HostRuntimeFunction table[]{618#define PGMATH_RELAXED619#define PGMATH_USE_D(name, func) REAL_FOLDER(name, func),620#include "flang/Evaluate/pgmath.h.inc"621 };622 static constexpr HostRuntimeMap map{table};623 static_assert(map.Verify(), "map must be sorted");624};625template <> struct HostRuntimeLibrary<float, LibraryVersion::PgmathPrecise> {626 static constexpr HostRuntimeFunction table[]{627#define PGMATH_PRECISE628#define PGMATH_USE_S(name, func) REAL_FOLDER(name, func),629#include "flang/Evaluate/pgmath.h.inc"630 };631 static constexpr HostRuntimeMap map{table};632 static_assert(map.Verify(), "map must be sorted");633};634template <> struct HostRuntimeLibrary<double, LibraryVersion::PgmathPrecise> {635 static constexpr HostRuntimeFunction table[]{636#define PGMATH_PRECISE637#define PGMATH_USE_D(name, func) REAL_FOLDER(name, func),638#include "flang/Evaluate/pgmath.h.inc"639 };640 static constexpr HostRuntimeMap map{table};641 static_assert(map.Verify(), "map must be sorted");642};643 644// TODO: double _Complex/float _Complex have been removed from llvm flang645// pgmath.h.inc because they caused warnings, they need to be added back646// so that the complex pgmath versions can be used when requested.647 648#endif /* LINK_WITH_LIBPGMATH */649 650// Helper to check if a HostRuntimeLibrary specialization exists651template <typename T, typename = void> struct IsAvailable : std::false_type {};652template <typename T>653struct IsAvailable<T, decltype((void)T::table, void())> : std::true_type {};654// Define helpers to find host runtime library map according to desired version655// and type.656template <typename HostT, LibraryVersion version>657static const HostRuntimeMap *GetHostRuntimeMapHelper(658 [[maybe_unused]] DynamicType resultType) {659 // A library must only be instantiated if LibraryVersion is660 // available on the host and if HostT maps to a Fortran type.661 // For instance, whenever long double and double are both 64-bits, double662 // is mapped to Fortran 64bits real type, and long double will be left663 // unmapped.664 if constexpr (host::FortranTypeExists<HostT>()) {665 using Lib = HostRuntimeLibrary<HostT, version>;666 if constexpr (IsAvailable<Lib>::value) {667 if (host::FortranType<HostT>{}.GetType() == resultType) {668 return &Lib::map;669 }670 }671 }672 return nullptr;673}674template <LibraryVersion version>675static const HostRuntimeMap *GetHostRuntimeMapVersion(DynamicType resultType) {676 if (resultType.category() == TypeCategory::Real) {677 if (const auto *map{GetHostRuntimeMapHelper<float, version>(resultType)}) {678 return map;679 }680 if (const auto *map{GetHostRuntimeMapHelper<double, version>(resultType)}) {681 return map;682 }683 if (const auto *map{684 GetHostRuntimeMapHelper<long double, version>(resultType)}) {685 return map;686 }687#if HAS_QUADMATHLIB688 if (const auto *map{689 GetHostRuntimeMapHelper<__float128, version>(resultType)}) {690 return map;691 }692#endif693 }694 if (resultType.category() == TypeCategory::Complex) {695 if (const auto *map{GetHostRuntimeMapHelper<std::complex<float>, version>(696 resultType)}) {697 return map;698 }699 if (const auto *map{GetHostRuntimeMapHelper<std::complex<double>, version>(700 resultType)}) {701 return map;702 }703 if (const auto *map{704 GetHostRuntimeMapHelper<std::complex<long double>, version>(705 resultType)}) {706 return map;707 }708#if HAS_QUADMATHLIB709 if (const auto *map{710 GetHostRuntimeMapHelper<__complex128, version>(resultType)}) {711 return map;712 }713#endif714 }715 return nullptr;716}717static const HostRuntimeMap *GetHostRuntimeMap(718 LibraryVersion version, DynamicType resultType) {719 switch (version) {720 case LibraryVersion::Libm:721 return GetHostRuntimeMapVersion<LibraryVersion::Libm>(resultType);722 case LibraryVersion::LibmExtensions:723 return GetHostRuntimeMapVersion<LibraryVersion::LibmExtensions>(resultType);724 case LibraryVersion::PgmathPrecise:725 return GetHostRuntimeMapVersion<LibraryVersion::PgmathPrecise>(resultType);726 case LibraryVersion::PgmathRelaxed:727 return GetHostRuntimeMapVersion<LibraryVersion::PgmathRelaxed>(resultType);728 case LibraryVersion::PgmathFast:729 return GetHostRuntimeMapVersion<LibraryVersion::PgmathFast>(resultType);730 }731 return nullptr;732}733 734static const HostRuntimeFunction *SearchInHostRuntimeMap(735 const HostRuntimeMap &map, const std::string &name, DynamicType resultType,736 const std::vector<DynamicType> &argTypes) {737 auto sameNameRange{map.equal_range(name)};738 for (const auto *iter{sameNameRange.first}; iter != sameNameRange.second;739 ++iter) {740 if (iter->resultType == resultType && iter->argumentTypes == argTypes) {741 return &*iter;742 }743 }744 return nullptr;745}746 747// Search host runtime libraries for an exact type match.748static const HostRuntimeFunction *SearchHostRuntime(const std::string &name,749 DynamicType resultType, const std::vector<DynamicType> &argTypes) {750 // TODO: When command line options regarding targeted numerical library is751 // available, this needs to be revisited to take it into account. So far,752 // default to libpgmath if F18 is built with it.753#if LINK_WITH_LIBPGMATH754 if (const auto *map{755 GetHostRuntimeMap(LibraryVersion::PgmathPrecise, resultType)}) {756 if (const auto *hostFunction{757 SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) {758 return hostFunction;759 }760 }761 // Default to libm if functions or types are not available in pgmath.762#endif763 if (const auto *map{GetHostRuntimeMap(LibraryVersion::Libm, resultType)}) {764 if (const auto *hostFunction{765 SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) {766 return hostFunction;767 }768 }769 if (const auto *map{770 GetHostRuntimeMap(LibraryVersion::LibmExtensions, resultType)}) {771 if (const auto *hostFunction{772 SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) {773 return hostFunction;774 }775 }776 return nullptr;777}778 779// Return a DynamicType that can hold all values of a given type.780// This is used to allow 16bit float to be folded with 32bits and781// x87 float to be folded with IEEE 128bits.782static DynamicType BiggerType(DynamicType type) {783 if (type.category() == TypeCategory::Real ||784 type.category() == TypeCategory::Complex) {785 // 16 bits floats to IEEE 32 bits float786 if (type.kind() == common::RealKindForPrecision(11) ||787 type.kind() == common::RealKindForPrecision(8)) {788 return {type.category(), common::RealKindForPrecision(24)};789 }790 // x87 float to IEEE 128 bits float791 if (type.kind() == common::RealKindForPrecision(64)) {792 return {type.category(), common::RealKindForPrecision(113)};793 }794 }795 return type;796}797 798/// Structure to register intrinsic argument checks that must be performed.799using ArgumentVerifierFunc = bool (*)(800 const std::vector<Expr<SomeType>> &, FoldingContext &);801struct ArgumentVerifier {802 using Key = std::string_view;803 // Needed for implicit compare with keys.804 constexpr operator Key() const { return key; }805 Key key;806 ArgumentVerifierFunc verifier;807};808 809static constexpr int lastArg{-1};810static constexpr int firstArg{0};811 812static const Expr<SomeType> &GetArg(813 int position, const std::vector<Expr<SomeType>> &args) {814 if (position == lastArg) {815 CHECK(!args.empty());816 return args.back();817 }818 CHECK(position >= 0 && static_cast<std::size_t>(position) < args.size());819 return args[position];820}821 822template <typename T>823static bool IsInRange(const Expr<T> &expr, int lb, int ub) {824 if (auto scalar{GetScalarConstantValue<T>(expr)}) {825 auto lbValue{Scalar<T>::FromInteger(value::Integer<8>{lb}).value};826 auto ubValue{Scalar<T>::FromInteger(value::Integer<8>{ub}).value};827 return Satisfies(RelationalOperator::LE, lbValue.Compare(*scalar)) &&828 Satisfies(RelationalOperator::LE, scalar->Compare(ubValue));829 }830 return true;831}832 833/// Verify that the argument in an intrinsic call belongs to [lb, ub] if is834/// real.835template <int lb, int ub>836static bool VerifyInRangeIfReal(837 const std::vector<Expr<SomeType>> &args, FoldingContext &context) {838 if (const auto *someReal{839 std::get_if<Expr<SomeReal>>(&GetArg(firstArg, args).u)}) {840 bool isInRange{841 std::visit([&](const auto &x) -> bool { return IsInRange(x, lb, ub); },842 someReal->u)};843 if (!isInRange) {844 context.messages().Say(845 "argument is out of range [%d., %d.]"_warn_en_US, lb, ub);846 }847 return isInRange;848 }849 return true;850}851 852template <int argPosition, const char *argName>853static bool VerifyStrictlyPositiveIfReal(854 const std::vector<Expr<SomeType>> &args, FoldingContext &context) {855 if (const auto *someReal =856 std::get_if<Expr<SomeReal>>(&GetArg(argPosition, args).u)) {857 const bool isStrictlyPositive{std::visit(858 [&](const auto &x) -> bool {859 using T = typename std::decay_t<decltype(x)>::Result;860 auto scalar{GetScalarConstantValue<T>(x)};861 return Satisfies(862 RelationalOperator::LT, Scalar<T>{}.Compare(*scalar));863 },864 someReal->u)};865 if (!isStrictlyPositive) {866 context.messages().Say(867 "argument '%s' must be strictly positive"_warn_en_US, argName);868 }869 return isStrictlyPositive;870 }871 return true;872}873 874/// Verify that an intrinsic call argument is not zero if it is real.875template <int argPosition, const char *argName>876static bool VerifyNotZeroIfReal(877 const std::vector<Expr<SomeType>> &args, FoldingContext &context) {878 if (const auto *someReal =879 std::get_if<Expr<SomeReal>>(&GetArg(argPosition, args).u)) {880 const bool isNotZero{std::visit(881 [&](const auto &x) -> bool {882 using T = typename std::decay_t<decltype(x)>::Result;883 auto scalar{GetScalarConstantValue<T>(x)};884 return !scalar || !scalar->IsZero();885 },886 someReal->u)};887 if (!isNotZero) {888 context.messages().Say(889 "argument '%s' must be different from zero"_warn_en_US, argName);890 }891 return isNotZero;892 }893 return true;894}895 896/// Verify that the argument in an intrinsic call is not zero if is complex.897static bool VerifyNotZeroIfComplex(898 const std::vector<Expr<SomeType>> &args, FoldingContext &context) {899 if (const auto *someComplex =900 std::get_if<Expr<SomeComplex>>(&GetArg(firstArg, args).u)) {901 const bool isNotZero{std::visit(902 [&](const auto &z) -> bool {903 using T = typename std::decay_t<decltype(z)>::Result;904 auto scalar{GetScalarConstantValue<T>(z)};905 return !scalar || !scalar->IsZero();906 },907 someComplex->u)};908 if (!isNotZero) {909 context.messages().Say(910 "complex argument must be different from zero"_warn_en_US);911 }912 return isNotZero;913 }914 return true;915}916 917// Verify that the argument in an intrinsic call is not zero and not a negative918// integer.919static bool VerifyGammaLikeArgument(920 const std::vector<Expr<SomeType>> &args, FoldingContext &context) {921 if (const auto *someReal =922 std::get_if<Expr<SomeReal>>(&GetArg(firstArg, args).u)) {923 const bool isValid{std::visit(924 [&](const auto &x) -> bool {925 using T = typename std::decay_t<decltype(x)>::Result;926 auto scalar{GetScalarConstantValue<T>(x)};927 if (scalar) {928 return !scalar->IsZero() &&929 !(scalar->IsNegative() &&930 scalar->ToWholeNumber().value == scalar);931 }932 return true;933 },934 someReal->u)};935 if (!isValid) {936 context.messages().Say(937 "argument must not be a negative integer or zero"_warn_en_US);938 }939 return isValid;940 }941 return true;942}943 944// Verify that two real arguments are not both zero.945static bool VerifyAtan2LikeArguments(946 const std::vector<Expr<SomeType>> &args, FoldingContext &context) {947 if (const auto *someReal =948 std::get_if<Expr<SomeReal>>(&GetArg(firstArg, args).u)) {949 const bool isValid{std::visit(950 [&](const auto &typedExpr) -> bool {951 using T = typename std::decay_t<decltype(typedExpr)>::Result;952 auto x{GetScalarConstantValue<T>(typedExpr)};953 auto y{GetScalarConstantValue<T>(GetArg(lastArg, args))};954 if (x && y) {955 return !(x->IsZero() && y->IsZero());956 }957 return true;958 },959 someReal->u)};960 if (!isValid) {961 context.messages().Say(962 "'x' and 'y' arguments must not be both zero"_warn_en_US);963 }964 return isValid;965 }966 return true;967}968 969template <ArgumentVerifierFunc... F>970static bool CombineVerifiers(971 const std::vector<Expr<SomeType>> &args, FoldingContext &context) {972 return (... && F(args, context));973}974 975/// Define argument names to be used error messages when the intrinsic have976/// several arguments.977static constexpr char xName[]{"x"};978static constexpr char pName[]{"p"};979 980/// Register argument verifiers for all intrinsics folded with runtime.981static constexpr ArgumentVerifier intrinsicArgumentVerifiers[]{982 {"acos", VerifyInRangeIfReal<-1, 1>},983 {"asin", VerifyInRangeIfReal<-1, 1>},984 {"atan2", VerifyAtan2LikeArguments},985 {"bessel_y0", VerifyStrictlyPositiveIfReal<firstArg, xName>},986 {"bessel_y1", VerifyStrictlyPositiveIfReal<firstArg, xName>},987 {"bessel_yn", VerifyStrictlyPositiveIfReal<lastArg, xName>},988 {"gamma", VerifyGammaLikeArgument},989 {"log",990 CombineVerifiers<VerifyStrictlyPositiveIfReal<firstArg, xName>,991 VerifyNotZeroIfComplex>},992 {"log10", VerifyStrictlyPositiveIfReal<firstArg, xName>},993 {"log_gamma", VerifyGammaLikeArgument},994 {"mod", VerifyNotZeroIfReal<lastArg, pName>},995};996 997const ArgumentVerifierFunc *findVerifier(const std::string &intrinsicName) {998 static constexpr Fortran::common::StaticMultimapView<ArgumentVerifier>999 verifiers(intrinsicArgumentVerifiers);1000 static_assert(verifiers.Verify(), "map must be sorted");1001 auto range{verifiers.equal_range(intrinsicName)};1002 if (range.first != range.second) {1003 return &range.first->verifier;1004 }1005 return nullptr;1006}1007 1008/// Ensure argument verifiers, if any, are run before calling the runtime1009/// wrapper to fold an intrinsic.1010static HostRuntimeWrapper AddArgumentVerifierIfAny(1011 const std::string &intrinsicName, const HostRuntimeFunction &hostFunction) {1012 if (const auto *verifier{findVerifier(intrinsicName)}) {1013 const HostRuntimeFunction *hostFunctionPtr = &hostFunction;1014 return [hostFunctionPtr, verifier](1015 FoldingContext &context, std::vector<Expr<SomeType>> &&args) {1016 const bool validArguments{(*verifier)(args, context)};1017 if (!validArguments) {1018 // Silence fp signal warnings since a more detailed warning about1019 // invalid arguments was already emitted.1020 parser::Messages localBuffer;1021 parser::ContextualMessages localMessages{&localBuffer};1022 FoldingContext localContext{context, localMessages};1023 return hostFunctionPtr->folder(localContext, std::move(args));1024 }1025 return hostFunctionPtr->folder(context, std::move(args));1026 };1027 }1028 return hostFunction.folder;1029}1030 1031std::optional<HostRuntimeWrapper> GetHostRuntimeWrapper(const std::string &name,1032 DynamicType resultType, const std::vector<DynamicType> &argTypes) {1033 if (const auto *hostFunction{SearchHostRuntime(name, resultType, argTypes)}) {1034 return AddArgumentVerifierIfAny(name, *hostFunction);1035 }1036 // If no exact match, search with "bigger" types and insert type1037 // conversions around the folder.1038 std::vector<evaluate::DynamicType> biggerArgTypes;1039 evaluate::DynamicType biggerResultType{BiggerType(resultType)};1040 for (auto type : argTypes) {1041 biggerArgTypes.emplace_back(BiggerType(type));1042 }1043 if (const auto *hostFunction{1044 SearchHostRuntime(name, biggerResultType, biggerArgTypes)}) {1045 auto hostFolderWithChecks{AddArgumentVerifierIfAny(name, *hostFunction)};1046 return [hostFunction, resultType, hostFolderWithChecks, name](1047 FoldingContext &context, std::vector<Expr<SomeType>> &&args) {1048 auto nArgs{args.size()};1049 for (size_t i{0}; i < nArgs; ++i) {1050 args[i] = Fold(context,1051 ConvertToType(hostFunction->argumentTypes[i], std::move(args[i]))1052 .value());1053 }1054 auto restorer{context.SetRealFlagWarningContext(1055 "compilation-time evaluation of a call to '"s + name + "'"s)};1056 return Fold(context,1057 ConvertToType(1058 resultType, hostFolderWithChecks(context, std::move(args)))1059 .value());1060 };1061 }1062 return std::nullopt;1063}1064} // namespace Fortran::evaluate1065