flang/lib/Evaluate/intrinsics-library.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-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 // This file defines host runtime functions that can be used for folding
  10 // intrinsic functions.
  11 // The default host runtime folders are built with <cmath> and
  12 // <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_QUADMATHLIB
  26 #include "quadmath.h"
  27 #endif
  28 #include "flang/Common/float128.h"
  29 #include "flang/Common/float80.h"
  30 #include <type_traits>
  31
  32 namespace Fortran::evaluate {
  33
  34 // Define a vector like class that can hold an arbitrary number of
  35 // Dynamic type and be built at compile time. This is like a
  36 // std::vector<DynamicType>, but constexpr only.
  37 template <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 };
  42 template <> struct TypeVectorStorage<> {
  43   static constexpr const DynamicType *start{nullptr}, *end{nullptr};
  44 };
  45 struct 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 };
  60 inline 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 fold
  74 // a Fortran scalar intrinsic using host runtime functions (e.g libm).
  75 // The folder take care of all conversions between Fortran types and the related
  76 // 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 all
  78 // constexpr constructible) so that they can be stored in a compile time static
  79 // map.
  80 struct 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 provided
  94   // Expr<SomeType> arguments must wrap scalar constants of the type described
  95   // in argumentTypes, otherwise folder will crash. Any floating point issue
  96   // raised while executing the host runtime will be reported in FoldingContext
  97   // messages.
  98   Folder folder;
  99 };
 100
 101 // Translate a host function type signature (template arguments) into a
 102 // constexpr data representation based on Fortran DynamicType that can be
 103 // stored.
 104 template <typename TR, typename... TA> using FuncPointer = TR (*)(TA...);
 105 template <typename T> struct FuncTypeAnalyzer {};
 106 template <typename HostTR, typename... HostTA>
 107 struct 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.
 114 template <typename TR>
 115 static 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 available
 129 // because it may not result in the same behavior as hardware flushing.
 130 // Some runtime implementations are "working around" subnormal flushing to
 131 // return results that they deem better than returning the result they would
 132 // with a null argument. An example is logf that should return -inf if arguments
 133 // are flushed to zero, but some implementations return -1.03972076416015625e2_4
 134 // for all subnormal values instead. It is impossible to reproduce this with the
 135 // simple software flushing below.
 136 template <typename T>
 137 static 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 the
 146 // Fortran Expr<SomeType> to the host runtime function argument types, calls
 147 // 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.
 149 template <typename FuncType, typename TR, typename... TA, size_t... I>
 150 static 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 }
 174 template <typename HostTR, typename... HostTA>
 175 Expr<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 function
 183 // passed as a template argument.
 184 // Its static member function "fold" is the resulting folder. It captures the
 185 // host runtime function pointer and pass it to the host runtime function folder
 186 // kernel.
 187 template <typename HostFuncType, HostFuncType func> class FolderFactory {
 188 public:
 189   static constexpr HostRuntimeFunction Create(const std::string_view &name) {
 190     return HostRuntimeFunction{name, FuncTypeAnalyzer<HostFuncType>::result,
 191         FuncTypeAnalyzer<HostFuncType>::arguments, &Fold};
 192   }
 193
 194 private:
 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 and
 202 // fill their description if they are available.
 203 enum class LibraryVersion {
 204   Libm,
 205   LibmExtensions,
 206   PgmathFast,
 207   PgmathRelaxed,
 208   PgmathPrecise
 209 };
 210 template <typename HostT, LibraryVersion> struct HostRuntimeLibrary {
 211   // When specialized, this class holds a static constexpr table containing
 212   // all the HostRuntimeLibrary for functions of library LibraryVersion
 213   // that returns a value of type HostT.
 214 };
 215
 216 using HostRuntimeMap = common::StaticMultimapView<HostRuntimeFunction>;
 217
 218 // Map numerical intrinsic to  <cmath>/<complex> functions
 219 // (Note: ABS() is folded in fold-real.cpp.)
 220 template <typename HostT>
 221 struct 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 equivalent
 249
 250   // Note regarding  lack of bessel function support:
 251   // C++17 defined standard Bessel math functions std::cyl_bessel_j
 252   // and std::cyl_neumann that can be used for Fortran j and y
 253   // bessel functions. However, they are not yet implemented in
 254   // clang libc++ (ok in GNU libstdc++). C maths functions j0...
 255   // are not C standard but a GNU extension so they are not used
 256   // 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 _AIX
 273 // Helpers to map complex std::pow whose resolution in F2{std::pow} is
 274 // ambiguous as of clang++ 20.
 275 template <typename HostT>
 276 static std::complex<HostT> StdPowF2(
 277     const std::complex<HostT> &x, const std::complex<HostT> &y) {
 278   return std::pow(x, y);
 279 }
 280
 281 template <typename HostT>
 282 static std::complex<HostT> StdPowF2A(
 283     const HostT &x, const std::complex<HostT> &y) {
 284   return std::pow(x, y);
 285 }
 286
 287 template <typename HostT>
 288 static std::complex<HostT> StdPowF2B(
 289     const std::complex<HostT> &x, const HostT &y) {
 290   return std::pow(x, y);
 291 }
 292
 293 template <typename HostT>
 294 struct 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 #else
 320 // On AIX, call libm routines to preserve consistent value between
 321 // runtime and compile time evaluation.
 322 #ifdef __clang_major__
 323 #pragma clang diagnostic ignored "-Wc99-extensions"
 324 #endif
 325
 326 extern "C" {
 327 float _Complex cacosf(float _Complex);
 328 double _Complex cacos(double _Complex);
 329 float _Complex cacoshf(float _Complex);
 330 double _Complex cacosh(double _Complex);
 331 float _Complex casinf(float _Complex);
 332 double _Complex casin(double _Complex);
 333 float _Complex casinhf(float _Complex);
 334 double _Complex casinh(double _Complex);
 335 float _Complex catanf(float _Complex);
 336 double _Complex catan(double _Complex);
 337 float _Complex catanhf(float _Complex);
 338 double _Complex catanh(double _Complex);
 339 float _Complex ccosf(float _Complex);
 340 double _Complex ccos(double _Complex);
 341 float _Complex ccoshf(float _Complex);
 342 double _Complex ccosh(double _Complex);
 343 float _Complex cexpf(float _Complex);
 344 double _Complex cexp(double _Complex);
 345 float _Complex clogf(float _Complex);
 346 double _Complex __clog(double _Complex);
 347 float _Complex cpowf(float _Complex, float _Complex);
 348 double _Complex cpow(double _Complex, double _Complex);
 349 float _Complex csinf(float _Complex);
 350 double _Complex csin(double _Complex);
 351 float _Complex csinhf(float _Complex);
 352 double _Complex csinh(double _Complex);
 353 float _Complex csqrtf(float _Complex);
 354 double _Complex csqrt(double _Complex);
 355 float _Complex ctanf(float _Complex);
 356 double _Complex ctan(double _Complex);
 357 float _Complex ctanhf(float _Complex);
 358 double _Complex ctanh(double _Complex);
 359 }
 360
 361 template <typename T> struct ToStdComplex {
 362   using Type = T;
 363   using AType = Type;
 364 };
 365 template <> struct ToStdComplex<float _Complex> {
 366   using Type = std::complex<float>;
 367   using AType = const Type &;
 368 };
 369 template <> struct ToStdComplex<double _Complex> {
 370   using Type = std::complex<double>;
 371   using AType = const Type &;
 372 };
 373
 374 template <typename F, F func> struct CComplexFunc {};
 375 template <typename R, typename... A, FuncPointer<R, A...> func>
 376 struct 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>::wrapper
 384
 385 template <>
 386 struct 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 };
 409 template <>
 410 struct 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 // _AIX
 434
 435 // Note regarding cmath:
 436 //  - cmath does not have modulo and erfc_scaled equivalent
 437 //  - C++17 defined standard Bessel math functions std::cyl_bessel_j
 438 //    and std::cyl_neumann that can be used for Fortran j and y
 439 //    bessel functions. However, they are not yet implemented in
 440 //    clang libc++ (ok in GNU libstdc++). Instead, the Posix libm
 441 //    extensions are used when available below.
 442
 443 #if _POSIX_C_SOURCE >= 200112L || _XOPEN_SOURCE >= 600
 444 /// Define libm extensions
 445 /// Bessel functions are defined in POSIX.1-2001.
 446
 447 // Remove float bessel functions for AIX and Darwin as they are not supported
 448 #if !defined(_AIX) && !defined(__APPLE__)
 449 template <> 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 #endif
 464
 465 #if HAS_QUADMATHLIB
 466 template <> 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 };
 502 template <> 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 #endif
 527
 528 template <> 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)
 544 template <>
 545 struct 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_LDBL128
 560 #endif //_POSIX_C_SOURCE >= 200112L || _XOPEN_SOURCE >= 600
 561
 562 /// Define pgmath description
 563 #if LINK_WITH_LIBPGMATH
 564 // Only use libpgmath for folding if it is available.
 565 // First declare all libpgmaths functions
 566 #define PGMATH_LINKING
 567 #define PGMATH_DECLARE
 568 #include "flang/Evaluate/pgmath.h.inc"
 569
 570 #define REAL_FOLDER(name, func) \
 571   FolderFactory<decltype(&func), &func>::Create(#name)
 572 template <> struct HostRuntimeLibrary<float, LibraryVersion::PgmathFast> {
 573   static constexpr HostRuntimeFunction table[]{
 574 #define PGMATH_FAST
 575 #define PGMATH_USE_S(name, func) REAL_FOLDER(name, func),
 576 #include "flang/Evaluate/pgmath.h.inc"
 577   };
 578   static constexpr HostRuntimeMap map{table};
 579   static_assert(map.Verify(), "map must be sorted");
 580 };
 581 template <> struct HostRuntimeLibrary<double, LibraryVersion::PgmathFast> {
 582   static constexpr HostRuntimeFunction table[]{
 583 #define PGMATH_FAST
 584 #define PGMATH_USE_D(name, func) REAL_FOLDER(name, func),
 585 #include "flang/Evaluate/pgmath.h.inc"
 586   };
 587   static constexpr HostRuntimeMap map{table};
 588   static_assert(map.Verify(), "map must be sorted");
 589 };
 590 template <> struct HostRuntimeLibrary<float, LibraryVersion::PgmathRelaxed> {
 591   static constexpr HostRuntimeFunction table[]{
 592 #define PGMATH_RELAXED
 593 #define PGMATH_USE_S(name, func) REAL_FOLDER(name, func),
 594 #include "flang/Evaluate/pgmath.h.inc"
 595   };
 596   static constexpr HostRuntimeMap map{table};
 597   static_assert(map.Verify(), "map must be sorted");
 598 };
 599 template <> struct HostRuntimeLibrary<double, LibraryVersion::PgmathRelaxed> {
 600   static constexpr HostRuntimeFunction table[]{
 601 #define PGMATH_RELAXED
 602 #define PGMATH_USE_D(name, func) REAL_FOLDER(name, func),
 603 #include "flang/Evaluate/pgmath.h.inc"
 604   };
 605   static constexpr HostRuntimeMap map{table};
 606   static_assert(map.Verify(), "map must be sorted");
 607 };
 608 template <> struct HostRuntimeLibrary<float, LibraryVersion::PgmathPrecise> {
 609   static constexpr HostRuntimeFunction table[]{
 610 #define PGMATH_PRECISE
 611 #define PGMATH_USE_S(name, func) REAL_FOLDER(name, func),
 612 #include "flang/Evaluate/pgmath.h.inc"
 613   };
 614   static constexpr HostRuntimeMap map{table};
 615   static_assert(map.Verify(), "map must be sorted");
 616 };
 617 template <> struct HostRuntimeLibrary<double, LibraryVersion::PgmathPrecise> {
 618   static constexpr HostRuntimeFunction table[]{
 619 #define PGMATH_PRECISE
 620 #define PGMATH_USE_D(name, func) REAL_FOLDER(name, func),
 621 #include "flang/Evaluate/pgmath.h.inc"
 622   };
 623   static constexpr HostRuntimeMap map{table};
 624   static_assert(map.Verify(), "map must be sorted");
 625 };
 626
 627 // TODO: double _Complex/float _Complex have been removed from llvm flang
 628 // pgmath.h.inc because they caused warnings, they need to be added back
 629 // so that the complex pgmath versions can be used when requested.
 630
 631 #endif /* LINK_WITH_LIBPGMATH */
 632
 633 // Helper to check if a HostRuntimeLibrary specialization exists
 634 template <typename T, typename = void> struct IsAvailable : std::false_type {};
 635 template <typename T>
 636 struct IsAvailable<T, decltype((void)T::table, void())> : std::true_type {};
 637 // Define helpers to find host runtime library map according to desired version
 638 // and type.
 639 template <typename HostT, LibraryVersion version>
 640 static const HostRuntimeMap *GetHostRuntimeMapHelper(
 641     [[maybe_unused]] DynamicType resultType) {
 642   // A library must only be instantiated if LibraryVersion is
 643   // available on the host and if HostT maps to a Fortran type.
 644   // For instance, whenever long double and double are both 64-bits, double
 645   // is mapped to Fortran 64bits real type, and long double will be left
 646   // unmapped.
 647   if constexpr (host::FortranTypeExists<HostT>()) {
 648     using Lib = HostRuntimeLibrary<HostT, version>;
 649     if constexpr (IsAvailable<Lib>::value) {
 650       if (host::FortranType<HostT>{}.GetType() == resultType) {
 651         return &Lib::map;
 652       }
 653     }
 654   }
 655   return nullptr;
 656 }
 657 template <LibraryVersion version>
 658 static const HostRuntimeMap *GetHostRuntimeMapVersion(DynamicType resultType) {
 659   if (resultType.category() == TypeCategory::Real) {
 660     if (const auto *map{GetHostRuntimeMapHelper<float, version>(resultType)}) {
 661       return map;
 662     }
 663     if (const auto *map{GetHostRuntimeMapHelper<double, version>(resultType)}) {
 664       return map;
 665     }
 666     if (const auto *map{
 667             GetHostRuntimeMapHelper<long double, version>(resultType)}) {
 668       return map;
 669     }
 670 #if HAS_QUADMATHLIB
 671     if (const auto *map{
 672             GetHostRuntimeMapHelper<__float128, version>(resultType)}) {
 673       return map;
 674     }
 675 #endif
 676   }
 677   if (resultType.category() == TypeCategory::Complex) {
 678     if (const auto *map{GetHostRuntimeMapHelper<std::complex<float>, version>(
 679             resultType)}) {
 680       return map;
 681     }
 682     if (const auto *map{GetHostRuntimeMapHelper<std::complex<double>, version>(
 683             resultType)}) {
 684       return map;
 685     }
 686     if (const auto *map{
 687             GetHostRuntimeMapHelper<std::complex<long double>, version>(
 688                 resultType)}) {
 689       return map;
 690     }
 691 #if HAS_QUADMATHLIB
 692     if (const auto *map{
 693             GetHostRuntimeMapHelper<__complex128, version>(resultType)}) {
 694       return map;
 695     }
 696 #endif
 697   }
 698   return nullptr;
 699 }
 700 static const HostRuntimeMap *GetHostRuntimeMap(
 701     LibraryVersion version, DynamicType resultType) {
 702   switch (version) {
 703   case LibraryVersion::Libm:
 704     return GetHostRuntimeMapVersion<LibraryVersion::Libm>(resultType);
 705   case LibraryVersion::LibmExtensions:
 706     return GetHostRuntimeMapVersion<LibraryVersion::LibmExtensions>(resultType);
 707   case LibraryVersion::PgmathPrecise:
 708     return GetHostRuntimeMapVersion<LibraryVersion::PgmathPrecise>(resultType);
 709   case LibraryVersion::PgmathRelaxed:
 710     return GetHostRuntimeMapVersion<LibraryVersion::PgmathRelaxed>(resultType);
 711   case LibraryVersion::PgmathFast:
 712     return GetHostRuntimeMapVersion<LibraryVersion::PgmathFast>(resultType);
 713   }
 714   return nullptr;
 715 }
 716
 717 static const HostRuntimeFunction *SearchInHostRuntimeMap(
 718     const HostRuntimeMap &map, const std::string &name, DynamicType resultType,
 719     const std::vector<DynamicType> &argTypes) {
 720   auto sameNameRange{map.equal_range(name)};
 721   for (const auto *iter{sameNameRange.first}; iter != sameNameRange.second;
 722        ++iter) {
 723     if (iter->resultType == resultType && iter->argumentTypes == argTypes) {
 724       return &*iter;
 725     }
 726   }
 727   return nullptr;
 728 }
 729
 730 // Search host runtime libraries for an exact type match.
 731 static const HostRuntimeFunction *SearchHostRuntime(const std::string &name,
 732     DynamicType resultType, const std::vector<DynamicType> &argTypes) {
 733   // TODO: When command line options regarding targeted numerical library is
 734   // available, this needs to be revisited to take it into account. So far,
 735   // default to libpgmath if F18 is built with it.
 736 #if LINK_WITH_LIBPGMATH
 737   if (const auto *map{
 738           GetHostRuntimeMap(LibraryVersion::PgmathPrecise, resultType)}) {
 739     if (const auto *hostFunction{
 740             SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) {
 741       return hostFunction;
 742     }
 743   }
 744   // Default to libm if functions or types are not available in pgmath.
 745 #endif
 746   if (const auto *map{GetHostRuntimeMap(LibraryVersion::Libm, resultType)}) {
 747     if (const auto *hostFunction{
 748             SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) {
 749       return hostFunction;
 750     }
 751   }
 752   if (const auto *map{
 753           GetHostRuntimeMap(LibraryVersion::LibmExtensions, resultType)}) {
 754     if (const auto *hostFunction{
 755             SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) {
 756       return hostFunction;
 757     }
 758   }
 759   return nullptr;
 760 }
 761
 762 // Return a DynamicType that can hold all values of a given type.
 763 // This is used to allow 16bit float to be folded with 32bits and
 764 // x87 float to be folded with IEEE 128bits.
 765 static DynamicType BiggerType(DynamicType type) {
 766   if (type.category() == TypeCategory::Real ||
 767       type.category() == TypeCategory::Complex) {
 768     // 16 bits floats to IEEE 32 bits float
 769     if (type.kind() == common::RealKindForPrecision(11) ||
 770         type.kind() == common::RealKindForPrecision(8)) {
 771       return {type.category(), common::RealKindForPrecision(24)};
 772     }
 773     // x87 float to IEEE 128 bits float
 774     if (type.kind() == common::RealKindForPrecision(64)) {
 775       return {type.category(), common::RealKindForPrecision(113)};
 776     }
 777   }
 778   return type;
 779 }
 780
 781 /// Structure to register intrinsic argument checks that must be performed.
 782 using ArgumentVerifierFunc = bool (*)(
 783     const std::vector<Expr<SomeType>> &, FoldingContext &);
 784 struct ArgumentVerifier {
 785   using Key = std::string_view;
 786   // Needed for implicit compare with keys.
 787   constexpr operator Key() const { return key; }
 788   Key key;
 789   ArgumentVerifierFunc verifier;
 790 };
 791
 792 static constexpr int lastArg{-1};
 793 static constexpr int firstArg{0};
 794
 795 static const Expr<SomeType> &GetArg(
 796     int position, const std::vector<Expr<SomeType>> &args) {
 797   if (position == lastArg) {
 798     CHECK(!args.empty());
 799     return args.back();
 800   }
 801   CHECK(position >= 0 && static_cast<std::size_t>(position) < args.size());
 802   return args[position];
 803 }
 804
 805 template <typename T>
 806 static bool IsInRange(const Expr<T> &expr, int lb, int ub) {
 807   if (auto scalar{GetScalarConstantValue<T>(expr)}) {
 808     auto lbValue{Scalar<T>::FromInteger(value::Integer<8>{lb}).value};
 809     auto ubValue{Scalar<T>::FromInteger(value::Integer<8>{ub}).value};
 810     return Satisfies(RelationalOperator::LE, lbValue.Compare(*scalar)) &&
 811         Satisfies(RelationalOperator::LE, scalar->Compare(ubValue));
 812   }
 813   return true;
 814 }
 815
 816 /// Verify that the argument in an intrinsic call belongs to [lb, ub] if is
 817 /// real.
 818 template <int lb, int ub>
 819 static bool VerifyInRangeIfReal(
 820     const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
 821   if (const auto *someReal{
 822           std::get_if<Expr<SomeReal>>(&GetArg(firstArg, args).u)}) {
 823     bool isInRange{
 824         std::visit([&](const auto &x) -> bool { return IsInRange(x, lb, ub); },
 825             someReal->u)};
 826     if (!isInRange) {
 827       context.messages().Say(
 828           "argument is out of range [%d., %d.]"_warn_en_US, lb, ub);
 829     }
 830     return isInRange;
 831   }
 832   return true;
 833 }
 834
 835 template <int argPosition, const char *argName>
 836 static bool VerifyStrictlyPositiveIfReal(
 837     const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
 838   if (const auto *someReal =
 839           std::get_if<Expr<SomeReal>>(&GetArg(argPosition, args).u)) {
 840     const bool isStrictlyPositive{std::visit(
 841         [&](const auto &x) -> bool {
 842           using T = typename std::decay_t<decltype(x)>::Result;
 843           auto scalar{GetScalarConstantValue<T>(x)};
 844           return Satisfies(
 845               RelationalOperator::LT, Scalar<T>{}.Compare(*scalar));
 846         },
 847         someReal->u)};
 848     if (!isStrictlyPositive) {
 849       context.messages().Say(
 850           "argument '%s' must be strictly positive"_warn_en_US, argName);
 851     }
 852     return isStrictlyPositive;
 853   }
 854   return true;
 855 }
 856
 857 /// Verify that an intrinsic call argument is not zero if it is real.
 858 template <int argPosition, const char *argName>
 859 static bool VerifyNotZeroIfReal(
 860     const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
 861   if (const auto *someReal =
 862           std::get_if<Expr<SomeReal>>(&GetArg(argPosition, args).u)) {
 863     const bool isNotZero{std::visit(
 864         [&](const auto &x) -> bool {
 865           using T = typename std::decay_t<decltype(x)>::Result;
 866           auto scalar{GetScalarConstantValue<T>(x)};
 867           return !scalar || !scalar->IsZero();
 868         },
 869         someReal->u)};
 870     if (!isNotZero) {
 871       context.messages().Say(
 872           "argument '%s' must be different from zero"_warn_en_US, argName);
 873     }
 874     return isNotZero;
 875   }
 876   return true;
 877 }
 878
 879 /// Verify that the argument in an intrinsic call is not zero if is complex.
 880 static bool VerifyNotZeroIfComplex(
 881     const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
 882   if (const auto *someComplex =
 883           std::get_if<Expr<SomeComplex>>(&GetArg(firstArg, args).u)) {
 884     const bool isNotZero{std::visit(
 885         [&](const auto &z) -> bool {
 886           using T = typename std::decay_t<decltype(z)>::Result;
 887           auto scalar{GetScalarConstantValue<T>(z)};
 888           return !scalar || !scalar->IsZero();
 889         },
 890         someComplex->u)};
 891     if (!isNotZero) {
 892       context.messages().Say(
 893           "complex argument must be different from zero"_warn_en_US);
 894     }
 895     return isNotZero;
 896   }
 897   return true;
 898 }
 899
 900 // Verify that the argument in an intrinsic call is not zero and not a negative
 901 // integer.
 902 static bool VerifyGammaLikeArgument(
 903     const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
 904   if (const auto *someReal =
 905           std::get_if<Expr<SomeReal>>(&GetArg(firstArg, args).u)) {
 906     const bool isValid{std::visit(
 907         [&](const auto &x) -> bool {
 908           using T = typename std::decay_t<decltype(x)>::Result;
 909           auto scalar{GetScalarConstantValue<T>(x)};
 910           if (scalar) {
 911             return !scalar->IsZero() &&
 912                 !(scalar->IsNegative() &&
 913                     scalar->ToWholeNumber().value == scalar);
 914           }
 915           return true;
 916         },
 917         someReal->u)};
 918     if (!isValid) {
 919       context.messages().Say(
 920           "argument must not be a negative integer or zero"_warn_en_US);
 921     }
 922     return isValid;
 923   }
 924   return true;
 925 }
 926
 927 // Verify that two real arguments are not both zero.
 928 static bool VerifyAtan2LikeArguments(
 929     const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
 930   if (const auto *someReal =
 931           std::get_if<Expr<SomeReal>>(&GetArg(firstArg, args).u)) {
 932     const bool isValid{std::visit(
 933         [&](const auto &typedExpr) -> bool {
 934           using T = typename std::decay_t<decltype(typedExpr)>::Result;
 935           auto x{GetScalarConstantValue<T>(typedExpr)};
 936           auto y{GetScalarConstantValue<T>(GetArg(lastArg, args))};
 937           if (x && y) {
 938             return !(x->IsZero() && y->IsZero());
 939           }
 940           return true;
 941         },
 942         someReal->u)};
 943     if (!isValid) {
 944       context.messages().Say(
 945           "'x' and 'y' arguments must not be both zero"_warn_en_US);
 946     }
 947     return isValid;
 948   }
 949   return true;
 950 }
 951
 952 template <ArgumentVerifierFunc... F>
 953 static bool CombineVerifiers(
 954     const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
 955   return (... && F(args, context));
 956 }
 957
 958 /// Define argument names to be used error messages when the intrinsic have
 959 /// several arguments.
 960 static constexpr char xName[]{"x"};
 961 static constexpr char pName[]{"p"};
 962
 963 /// Register argument verifiers for all intrinsics folded with runtime.
 964 static constexpr ArgumentVerifier intrinsicArgumentVerifiers[]{
 965     {"acos", VerifyInRangeIfReal<-1, 1>},
 966     {"asin", VerifyInRangeIfReal<-1, 1>},
 967     {"atan2", VerifyAtan2LikeArguments},
 968     {"bessel_y0", VerifyStrictlyPositiveIfReal<firstArg, xName>},
 969     {"bessel_y1", VerifyStrictlyPositiveIfReal<firstArg, xName>},
 970     {"bessel_yn", VerifyStrictlyPositiveIfReal<lastArg, xName>},
 971     {"gamma", VerifyGammaLikeArgument},
 972     {"log",
 973         CombineVerifiers<VerifyStrictlyPositiveIfReal<firstArg, xName>,
 974             VerifyNotZeroIfComplex>},
 975     {"log10", VerifyStrictlyPositiveIfReal<firstArg, xName>},
 976     {"log_gamma", VerifyGammaLikeArgument},
 977     {"mod", VerifyNotZeroIfReal<lastArg, pName>},
 978 };
 979
 980 const ArgumentVerifierFunc *findVerifier(const std::string &intrinsicName) {
 981   static constexpr Fortran::common::StaticMultimapView<ArgumentVerifier>
 982       verifiers(intrinsicArgumentVerifiers);
 983   static_assert(verifiers.Verify(), "map must be sorted");
 984   auto range{verifiers.equal_range(intrinsicName)};
 985   if (range.first != range.second) {
 986     return &range.first->verifier;
 987   }
 988   return nullptr;
 989 }
 990
 991 /// Ensure argument verifiers, if any, are run before calling the runtime
 992 /// wrapper to fold an intrinsic.
 993 static HostRuntimeWrapper AddArgumentVerifierIfAny(
 994     const std::string &intrinsicName, const HostRuntimeFunction &hostFunction) {
 995   if (const auto *verifier{findVerifier(intrinsicName)}) {
 996     const HostRuntimeFunction *hostFunctionPtr = &hostFunction;
 997     return [hostFunctionPtr, verifier](
 998                FoldingContext &context, std::vector<Expr<SomeType>> &&args) {
 999       const bool validArguments{(*verifier)(args, context)};
1000       if (!validArguments) {
1001         // Silence fp signal warnings since a more detailed warning about
1002         // invalid arguments was already emitted.
1003         parser::Messages localBuffer;
1004         parser::ContextualMessages localMessages{&localBuffer};
1005         FoldingContext localContext{context, localMessages};
1006         return hostFunctionPtr->folder(localContext, std::move(args));
1007       }
1008       return hostFunctionPtr->folder(context, std::move(args));
1009     };
1010   }
1011   return hostFunction.folder;
1012 }
1013
1014 std::optional<HostRuntimeWrapper> GetHostRuntimeWrapper(const std::string &name,
1015     DynamicType resultType, const std::vector<DynamicType> &argTypes) {
1016   if (const auto *hostFunction{SearchHostRuntime(name, resultType, argTypes)}) {
1017     return AddArgumentVerifierIfAny(name, *hostFunction);
1018   }
1019   // If no exact match, search with "bigger" types and insert type
1020   // conversions around the folder.
1021   std::vector<evaluate::DynamicType> biggerArgTypes;
1022   evaluate::DynamicType biggerResultType{BiggerType(resultType)};
1023   for (auto type : argTypes) {
1024     biggerArgTypes.emplace_back(BiggerType(type));
1025   }
1026   if (const auto *hostFunction{
1027           SearchHostRuntime(name, biggerResultType, biggerArgTypes)}) {
1028     auto hostFolderWithChecks{AddArgumentVerifierIfAny(name, *hostFunction)};
1029     return [hostFunction, resultType, hostFolderWithChecks](
1030                FoldingContext &context, std::vector<Expr<SomeType>> &&args) {
1031       auto nArgs{args.size()};
1032       for (size_t i{0}; i < nArgs; ++i) {
1033         args[i] = Fold(context,
1034             ConvertToType(hostFunction->argumentTypes[i], std::move(args[i]))
1035                 .value());
1036       }
1037       return Fold(context,
1038           ConvertToType(
1039               resultType, hostFolderWithChecks(context, std::move(args)))
1040               .value());
1041     };
1042   }
1043   return std::nullopt;
1044 }
1045 } // namespace Fortran::evaluate