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/static-multimap-view.h"
18 #include "flang/Evaluate/expression.h"
19 #include <cfloat>
20 #include <cmath>
21 #include <complex>
22 #include <functional>
23 #include <type_traits>
24 
25 namespace Fortran::evaluate {
26 
27 // Define a vector like class that can hold an arbitrary number of
28 // Dynamic type and be built at compile time. This is like a
29 // std::vector<DynamicType>, but constexpr only.
30 template <typename... FortranType> struct TypeVectorStorage {
31   static constexpr DynamicType values[]{FortranType{}.GetType()...};
32   static constexpr const DynamicType *start{&values[0]};
33   static constexpr const DynamicType *end{start + sizeof...(FortranType)};
34 };
35 template <> struct TypeVectorStorage<> {
36   static constexpr const DynamicType *start{nullptr}, *end{nullptr};
37 };
38 struct TypeVector {
CreateFortran::evaluate::TypeVector39   template <typename... FortranType> static constexpr TypeVector Create() {
40     using storage = TypeVectorStorage<FortranType...>;
41     return TypeVector{storage::start, storage::end, sizeof...(FortranType)};
42   }
sizeFortran::evaluate::TypeVector43   constexpr size_t size() const { return size_; };
44   using const_iterator = const DynamicType *;
beginFortran::evaluate::TypeVector45   constexpr const_iterator begin() const { return startPtr; }
endFortran::evaluate::TypeVector46   constexpr const_iterator end() const { return endPtr; }
operator []Fortran::evaluate::TypeVector47   const DynamicType &operator[](size_t i) const { return *(startPtr + i); }
48 
49   const DynamicType *startPtr{nullptr};
50   const DynamicType *endPtr{nullptr};
51   const size_t size_;
52 };
operator ==(const TypeVector & lhs,const std::vector<DynamicType> & rhs)53 inline bool operator==(
54     const TypeVector &lhs, const std::vector<DynamicType> &rhs) {
55   if (lhs.size() != rhs.size()) {
56     return false;
57   }
58   for (size_t i{0}; i < lhs.size(); ++i) {
59     if (lhs[i] != rhs[i]) {
60       return false;
61     }
62   }
63   return true;
64 }
65 
66 // HostRuntimeFunction holds a pointer to a Folder function that can fold
67 // a Fortran scalar intrinsic using host runtime functions (e.g libm).
68 // The folder take care of all conversions between Fortran types and the related
69 // host types as well as setting and cleaning-up the floating point environment.
70 // HostRuntimeFunction are intended to be built at compile time (members are all
71 // constexpr constructible) so that they can be stored in a compile time static
72 // map.
73 struct HostRuntimeFunction {
74   using Folder = Expr<SomeType> (*)(
75       FoldingContext &, std::vector<Expr<SomeType>> &&);
76   using Key = std::string_view;
77   // Needed for implicit compare with keys.
operator KeyFortran::evaluate::HostRuntimeFunction78   constexpr operator Key() const { return key; }
79   // Name of the related Fortran intrinsic.
80   Key key;
81   // DynamicType of the Expr<SomeType> returns by folder.
82   DynamicType resultType;
83   // DynamicTypes expected for the Expr<SomeType> arguments of the folder.
84   // The folder will crash if provided arguments of different types.
85   TypeVector argumentTypes;
86   // Folder to be called to fold the intrinsic with host runtime. The provided
87   // Expr<SomeType> arguments must wrap scalar constants of the type described
88   // in argumentTypes, otherwise folder will crash. Any floating point issue
89   // raised while executing the host runtime will be reported in FoldingContext
90   // messages.
91   Folder folder;
92 };
93 
94 // Translate a host function type signature (template arguments) into a
95 // constexpr data representation based on Fortran DynamicType that can be
96 // stored.
97 template <typename TR, typename... TA> using FuncPointer = TR (*)(TA...);
98 template <typename T> struct FuncTypeAnalyzer {};
99 template <typename HostTR, typename... HostTA>
100 struct FuncTypeAnalyzer<FuncPointer<HostTR, HostTA...>> {
101   static constexpr DynamicType result{host::FortranType<HostTR>{}.GetType()};
102   static constexpr TypeVector arguments{
103       TypeVector::Create<host::FortranType<HostTA>...>()};
104 };
105 
106 // Define helpers to deal with host floating environment.
107 template <typename TR>
CheckFloatingPointIssues(host::HostFloatingPointEnvironment & hostFPE,const Scalar<TR> & x)108 static void CheckFloatingPointIssues(
109     host::HostFloatingPointEnvironment &hostFPE, const Scalar<TR> &x) {
110   if constexpr (TR::category == TypeCategory::Complex ||
111       TR::category == TypeCategory::Real) {
112     if (x.IsNotANumber()) {
113       hostFPE.SetFlag(RealFlag::InvalidArgument);
114     } else if (x.IsInfinite()) {
115       hostFPE.SetFlag(RealFlag::Overflow);
116     }
117   }
118 }
119 // Software Subnormal Flushing helper.
120 // Only flush floating-points. Forward other scalars untouched.
121 // Software flushing is only performed if hardware flushing is not available
122 // because it may not result in the same behavior as hardware flushing.
123 // Some runtime implementations are "working around" subnormal flushing to
124 // return results that they deem better than returning the result they would
125 // with a null argument. An example is logf that should return -inf if arguments
126 // are flushed to zero, but some implementations return -1.03972076416015625e2_4
127 // for all subnormal values instead. It is impossible to reproduce this with the
128 // simple software flushing below.
129 template <typename T>
FlushSubnormals(Scalar<T> && x)130 static constexpr inline const Scalar<T> FlushSubnormals(Scalar<T> &&x) {
131   if constexpr (T::category == TypeCategory::Real ||
132       T::category == TypeCategory::Complex) {
133     return x.FlushSubnormalToZero();
134   }
135   return x;
136 }
137 
138 // This is the kernel called by all HostRuntimeFunction folders, it convert the
139 // Fortran Expr<SomeType> to the host runtime function argument types, calls
140 // the runtime function, and wrap back the result into an Expr<SomeType>.
141 // It deals with host floating point environment set-up and clean-up.
142 template <typename FuncType, typename TR, typename... TA, size_t... I>
ApplyHostFunctionHelper(FuncType func,FoldingContext & context,std::vector<Expr<SomeType>> && args,std::index_sequence<I...>)143 static Expr<SomeType> ApplyHostFunctionHelper(FuncType func,
144     FoldingContext &context, std::vector<Expr<SomeType>> &&args,
145     std::index_sequence<I...>) {
146   host::HostFloatingPointEnvironment hostFPE;
147   hostFPE.SetUpHostFloatingPointEnvironment(context);
148   host::HostType<TR> hostResult{};
149   Scalar<TR> result{};
150   std::tuple<Scalar<TA>...> scalarArgs{
151       GetScalarConstantValue<TA>(args[I]).value()...};
152   if (context.targetCharacteristics().areSubnormalsFlushedToZero() &&
153       !hostFPE.hasSubnormalFlushingHardwareControl()) {
154     hostResult = func(host::CastFortranToHost<TA>(
155         FlushSubnormals<TA>(std::move(std::get<I>(scalarArgs))))...);
156     result = FlushSubnormals<TR>(host::CastHostToFortran<TR>(hostResult));
157   } else {
158     hostResult = func(host::CastFortranToHost<TA>(std::get<I>(scalarArgs))...);
159     result = host::CastHostToFortran<TR>(hostResult);
160   }
161   if (!hostFPE.hardwareFlagsAreReliable()) {
162     CheckFloatingPointIssues<TR>(hostFPE, result);
163   }
164   hostFPE.CheckAndRestoreFloatingPointEnvironment(context);
165   return AsGenericExpr(Constant<TR>(std::move(result)));
166 }
167 template <typename HostTR, typename... HostTA>
ApplyHostFunction(FuncPointer<HostTR,HostTA...> func,FoldingContext & context,std::vector<Expr<SomeType>> && args)168 Expr<SomeType> ApplyHostFunction(FuncPointer<HostTR, HostTA...> func,
169     FoldingContext &context, std::vector<Expr<SomeType>> &&args) {
170   return ApplyHostFunctionHelper<decltype(func), host::FortranType<HostTR>,
171       host::FortranType<HostTA>...>(
172       func, context, std::move(args), std::index_sequence_for<HostTA...>{});
173 }
174 
175 // FolderFactory builds a HostRuntimeFunction for the host runtime function
176 // passed as a template argument.
177 // Its static member function "fold" is the resulting folder. It captures the
178 // host runtime function pointer and pass it to the host runtime function folder
179 // kernel.
180 template <typename HostFuncType, HostFuncType func> class FolderFactory {
181 public:
Create(const std::string_view & name)182   static constexpr HostRuntimeFunction Create(const std::string_view &name) {
183     return HostRuntimeFunction{name, FuncTypeAnalyzer<HostFuncType>::result,
184         FuncTypeAnalyzer<HostFuncType>::arguments, &Fold};
185   }
186 
187 private:
Fold(FoldingContext & context,std::vector<Expr<SomeType>> && args)188   static Expr<SomeType> Fold(
189       FoldingContext &context, std::vector<Expr<SomeType>> &&args) {
190     return ApplyHostFunction(func, context, std::move(args));
191   }
192 };
193 
194 // Define host runtime libraries that can be used for folding and
195 // fill their description if they are available.
196 enum class LibraryVersion {
197   Libm,
198   LibmExtensions,
199   PgmathFast,
200   PgmathRelaxed,
201   PgmathPrecise
202 };
203 template <typename HostT, LibraryVersion> struct HostRuntimeLibrary {
204   // When specialized, this class holds a static constexpr table containing
205   // all the HostRuntimeLibrary for functions of library LibraryVersion
206   // that returns a value of type HostT.
207 };
208 
209 using HostRuntimeMap = common::StaticMultimapView<HostRuntimeFunction>;
210 
211 // Map numerical intrinsic to  <cmath>/<complex> functions
212 // (Note: ABS() is folded in fold-real.cpp.)
213 template <typename HostT>
214 struct HostRuntimeLibrary<HostT, LibraryVersion::Libm> {
215   using F = FuncPointer<HostT, HostT>;
216   using F2 = FuncPointer<HostT, HostT, HostT>;
217   static constexpr HostRuntimeFunction table[]{
218       FolderFactory<F, F{std::acos}>::Create("acos"),
219       FolderFactory<F, F{std::acosh}>::Create("acosh"),
220       FolderFactory<F, F{std::asin}>::Create("asin"),
221       FolderFactory<F, F{std::asinh}>::Create("asinh"),
222       FolderFactory<F, F{std::atan}>::Create("atan"),
223       FolderFactory<F2, F2{std::atan2}>::Create("atan2"),
224       FolderFactory<F, F{std::atanh}>::Create("atanh"),
225       FolderFactory<F, F{std::cos}>::Create("cos"),
226       FolderFactory<F, F{std::cosh}>::Create("cosh"),
227       FolderFactory<F, F{std::erf}>::Create("erf"),
228       FolderFactory<F, F{std::erfc}>::Create("erfc"),
229       FolderFactory<F, F{std::exp}>::Create("exp"),
230       FolderFactory<F, F{std::tgamma}>::Create("gamma"),
231       FolderFactory<F, F{std::log}>::Create("log"),
232       FolderFactory<F, F{std::log10}>::Create("log10"),
233       FolderFactory<F, F{std::lgamma}>::Create("log_gamma"),
234       FolderFactory<F2, F2{std::pow}>::Create("pow"),
235       FolderFactory<F, F{std::sin}>::Create("sin"),
236       FolderFactory<F, F{std::sinh}>::Create("sinh"),
237       FolderFactory<F, F{std::tan}>::Create("tan"),
238       FolderFactory<F, F{std::tanh}>::Create("tanh"),
239   };
240   // Note: cmath does not have modulo and erfc_scaled equivalent
241 
242   // Note regarding  lack of bessel function support:
243   // C++17 defined standard Bessel math functions std::cyl_bessel_j
244   // and std::cyl_neumann that can be used for Fortran j and y
245   // bessel functions. However, they are not yet implemented in
246   // clang libc++ (ok in GNU libstdc++). C maths functions j0...
247   // are not C standard but a GNU extension so they are not used
248   // to avoid introducing incompatibilities.
249   // Use libpgmath to get bessel function folding support.
250   // TODO:  Add Bessel functions when possible.
251   static constexpr HostRuntimeMap map{table};
252   static_assert(map.Verify(), "map must be sorted");
253 };
254 template <typename HostT>
255 struct HostRuntimeLibrary<std::complex<HostT>, LibraryVersion::Libm> {
256   using F = FuncPointer<std::complex<HostT>, const std::complex<HostT> &>;
257   using F2 = FuncPointer<std::complex<HostT>, const std::complex<HostT> &,
258       const std::complex<HostT> &>;
259   using F2A = FuncPointer<std::complex<HostT>, const HostT &,
260       const std::complex<HostT> &>;
261   using F2B = FuncPointer<std::complex<HostT>, const std::complex<HostT> &,
262       const HostT &>;
263   static constexpr HostRuntimeFunction table[]{
264       FolderFactory<F, F{std::acos}>::Create("acos"),
265       FolderFactory<F, F{std::acosh}>::Create("acosh"),
266       FolderFactory<F, F{std::asin}>::Create("asin"),
267       FolderFactory<F, F{std::asinh}>::Create("asinh"),
268       FolderFactory<F, F{std::atan}>::Create("atan"),
269       FolderFactory<F, F{std::atanh}>::Create("atanh"),
270       FolderFactory<F, F{std::cos}>::Create("cos"),
271       FolderFactory<F, F{std::cosh}>::Create("cosh"),
272       FolderFactory<F, F{std::exp}>::Create("exp"),
273       FolderFactory<F, F{std::log}>::Create("log"),
274       FolderFactory<F2, F2{std::pow}>::Create("pow"),
275       FolderFactory<F2A, F2A{std::pow}>::Create("pow"),
276       FolderFactory<F2B, F2B{std::pow}>::Create("pow"),
277       FolderFactory<F, F{std::sin}>::Create("sin"),
278       FolderFactory<F, F{std::sinh}>::Create("sinh"),
279       FolderFactory<F, F{std::sqrt}>::Create("sqrt"),
280       FolderFactory<F, F{std::tan}>::Create("tan"),
281       FolderFactory<F, F{std::tanh}>::Create("tanh"),
282   };
283   static constexpr HostRuntimeMap map{table};
284   static_assert(map.Verify(), "map must be sorted");
285 };
286 // Note regarding cmath:
287 //  - cmath does not have modulo and erfc_scaled equivalent
288 //  - C++17 defined standard Bessel math functions std::cyl_bessel_j
289 //    and std::cyl_neumann that can be used for Fortran j and y
290 //    bessel functions. However, they are not yet implemented in
291 //    clang libc++ (ok in GNU libstdc++). Instead, the Posix libm
292 //    extensions are used when available below.
293 
294 #if _POSIX_C_SOURCE >= 200112L || _XOPEN_SOURCE >= 600
295 /// Define libm extensions
296 /// Bessel functions are defined in POSIX.1-2001.
297 
298 template <> struct HostRuntimeLibrary<float, LibraryVersion::LibmExtensions> {
299   using F = FuncPointer<float, float>;
300   using FN = FuncPointer<float, int, float>;
301   static constexpr HostRuntimeFunction table[]{
302       FolderFactory<F, F{::j0f}>::Create("bessel_j0"),
303       FolderFactory<F, F{::j1f}>::Create("bessel_j1"),
304       FolderFactory<FN, FN{::jnf}>::Create("bessel_jn"),
305       FolderFactory<F, F{::y0f}>::Create("bessel_y0"),
306       FolderFactory<F, F{::y1f}>::Create("bessel_y1"),
307       FolderFactory<FN, FN{::ynf}>::Create("bessel_yn"),
308   };
309   static constexpr HostRuntimeMap map{table};
310   static_assert(map.Verify(), "map must be sorted");
311 };
312 
313 template <> struct HostRuntimeLibrary<double, LibraryVersion::LibmExtensions> {
314   using F = FuncPointer<double, double>;
315   using FN = FuncPointer<double, int, double>;
316   static constexpr HostRuntimeFunction table[]{
317       FolderFactory<F, F{::j0}>::Create("bessel_j0"),
318       FolderFactory<F, F{::j1}>::Create("bessel_j1"),
319       FolderFactory<FN, FN{::jn}>::Create("bessel_jn"),
320       FolderFactory<F, F{::y0}>::Create("bessel_y0"),
321       FolderFactory<F, F{::y1}>::Create("bessel_y1"),
322       FolderFactory<FN, FN{::yn}>::Create("bessel_yn"),
323   };
324   static constexpr HostRuntimeMap map{table};
325   static_assert(map.Verify(), "map must be sorted");
326 };
327 
328 #if LDBL_MANT_DIG == 80 || LDBL_MANT_DIG == 113
329 template <>
330 struct HostRuntimeLibrary<long double, LibraryVersion::LibmExtensions> {
331   using F = FuncPointer<long double, long double>;
332   using FN = FuncPointer<long double, int, long double>;
333   static constexpr HostRuntimeFunction table[]{
334       FolderFactory<F, F{::j0l}>::Create("bessel_j0"),
335       FolderFactory<F, F{::j1l}>::Create("bessel_j1"),
336       FolderFactory<FN, FN{::jnl}>::Create("bessel_jn"),
337       FolderFactory<F, F{::y0l}>::Create("bessel_y0"),
338       FolderFactory<F, F{::y1l}>::Create("bessel_y1"),
339       FolderFactory<FN, FN{::ynl}>::Create("bessel_yn"),
340   };
341   static constexpr HostRuntimeMap map{table};
342   static_assert(map.Verify(), "map must be sorted");
343 };
344 #endif // LDBL_MANT_DIG == 80 || LDBL_MANT_DIG == 113
345 #endif
346 
347 /// Define pgmath description
348 #if LINK_WITH_LIBPGMATH
349 // Only use libpgmath for folding if it is available.
350 // First declare all libpgmaths functions
351 #define PGMATH_LINKING
352 #define PGMATH_DECLARE
353 #include "flang/Evaluate/pgmath.h.inc"
354 
355 #define REAL_FOLDER(name, func) \
356   FolderFactory<decltype(&func), &func>::Create(#name)
357 template <> struct HostRuntimeLibrary<float, LibraryVersion::PgmathFast> {
358   static constexpr HostRuntimeFunction table[]{
359 #define PGMATH_FAST
360 #define PGMATH_USE_S(name, func) REAL_FOLDER(name, func),
361 #include "flang/Evaluate/pgmath.h.inc"
362   };
363   static constexpr HostRuntimeMap map{table};
364   static_assert(map.Verify(), "map must be sorted");
365 };
366 template <> struct HostRuntimeLibrary<double, LibraryVersion::PgmathFast> {
367   static constexpr HostRuntimeFunction table[]{
368 #define PGMATH_FAST
369 #define PGMATH_USE_D(name, func) REAL_FOLDER(name, func),
370 #include "flang/Evaluate/pgmath.h.inc"
371   };
372   static constexpr HostRuntimeMap map{table};
373   static_assert(map.Verify(), "map must be sorted");
374 };
375 template <> struct HostRuntimeLibrary<float, LibraryVersion::PgmathRelaxed> {
376   static constexpr HostRuntimeFunction table[]{
377 #define PGMATH_RELAXED
378 #define PGMATH_USE_S(name, func) REAL_FOLDER(name, func),
379 #include "flang/Evaluate/pgmath.h.inc"
380   };
381   static constexpr HostRuntimeMap map{table};
382   static_assert(map.Verify(), "map must be sorted");
383 };
384 template <> struct HostRuntimeLibrary<double, LibraryVersion::PgmathRelaxed> {
385   static constexpr HostRuntimeFunction table[]{
386 #define PGMATH_RELAXED
387 #define PGMATH_USE_D(name, func) REAL_FOLDER(name, func),
388 #include "flang/Evaluate/pgmath.h.inc"
389   };
390   static constexpr HostRuntimeMap map{table};
391   static_assert(map.Verify(), "map must be sorted");
392 };
393 template <> struct HostRuntimeLibrary<float, LibraryVersion::PgmathPrecise> {
394   static constexpr HostRuntimeFunction table[]{
395 #define PGMATH_PRECISE
396 #define PGMATH_USE_S(name, func) REAL_FOLDER(name, func),
397 #include "flang/Evaluate/pgmath.h.inc"
398   };
399   static constexpr HostRuntimeMap map{table};
400   static_assert(map.Verify(), "map must be sorted");
401 };
402 template <> struct HostRuntimeLibrary<double, LibraryVersion::PgmathPrecise> {
403   static constexpr HostRuntimeFunction table[]{
404 #define PGMATH_PRECISE
405 #define PGMATH_USE_D(name, func) REAL_FOLDER(name, func),
406 #include "flang/Evaluate/pgmath.h.inc"
407   };
408   static constexpr HostRuntimeMap map{table};
409   static_assert(map.Verify(), "map must be sorted");
410 };
411 
412 // TODO: double _Complex/float _Complex have been removed from llvm flang
413 // pgmath.h.inc because they caused warnings, they need to be added back
414 // so that the complex pgmath versions can be used when requested.
415 
416 #endif /* LINK_WITH_LIBPGMATH */
417 
418 // Helper to check if a HostRuntimeLibrary specialization exists
419 template <typename T, typename = void> struct IsAvailable : std::false_type {};
420 template <typename T>
421 struct IsAvailable<T, decltype((void)T::table, void())> : std::true_type {};
422 // Define helpers to find host runtime library map according to desired version
423 // and type.
424 template <typename HostT, LibraryVersion version>
GetHostRuntimeMapHelper(DynamicType resultType)425 static const HostRuntimeMap *GetHostRuntimeMapHelper(
426     [[maybe_unused]] DynamicType resultType) {
427   // A library must only be instantiated if LibraryVersion is
428   // available on the host and if HostT maps to a Fortran type.
429   // For instance, whenever long double and double are both 64-bits, double
430   // is mapped to Fortran 64bits real type, and long double will be left
431   // unmapped.
432   if constexpr (host::FortranTypeExists<HostT>()) {
433     using Lib = HostRuntimeLibrary<HostT, version>;
434     if constexpr (IsAvailable<Lib>::value) {
435       if (host::FortranType<HostT>{}.GetType() == resultType) {
436         return &Lib::map;
437       }
438     }
439   }
440   return nullptr;
441 }
442 template <LibraryVersion version>
GetHostRuntimeMapVersion(DynamicType resultType)443 static const HostRuntimeMap *GetHostRuntimeMapVersion(DynamicType resultType) {
444   if (resultType.category() == TypeCategory::Real) {
445     if (const auto *map{GetHostRuntimeMapHelper<float, version>(resultType)}) {
446       return map;
447     }
448     if (const auto *map{GetHostRuntimeMapHelper<double, version>(resultType)}) {
449       return map;
450     }
451     if (const auto *map{
452             GetHostRuntimeMapHelper<long double, version>(resultType)}) {
453       return map;
454     }
455   }
456   if (resultType.category() == TypeCategory::Complex) {
457     if (const auto *map{GetHostRuntimeMapHelper<std::complex<float>, version>(
458             resultType)}) {
459       return map;
460     }
461     if (const auto *map{GetHostRuntimeMapHelper<std::complex<double>, version>(
462             resultType)}) {
463       return map;
464     }
465     if (const auto *map{
466             GetHostRuntimeMapHelper<std::complex<long double>, version>(
467                 resultType)}) {
468       return map;
469     }
470   }
471   return nullptr;
472 }
GetHostRuntimeMap(LibraryVersion version,DynamicType resultType)473 static const HostRuntimeMap *GetHostRuntimeMap(
474     LibraryVersion version, DynamicType resultType) {
475   switch (version) {
476   case LibraryVersion::Libm:
477     return GetHostRuntimeMapVersion<LibraryVersion::Libm>(resultType);
478   case LibraryVersion::LibmExtensions:
479     return GetHostRuntimeMapVersion<LibraryVersion::LibmExtensions>(resultType);
480   case LibraryVersion::PgmathPrecise:
481     return GetHostRuntimeMapVersion<LibraryVersion::PgmathPrecise>(resultType);
482   case LibraryVersion::PgmathRelaxed:
483     return GetHostRuntimeMapVersion<LibraryVersion::PgmathRelaxed>(resultType);
484   case LibraryVersion::PgmathFast:
485     return GetHostRuntimeMapVersion<LibraryVersion::PgmathFast>(resultType);
486   }
487   return nullptr;
488 }
489 
SearchInHostRuntimeMap(const HostRuntimeMap & map,const std::string & name,DynamicType resultType,const std::vector<DynamicType> & argTypes)490 static const HostRuntimeFunction *SearchInHostRuntimeMap(
491     const HostRuntimeMap &map, const std::string &name, DynamicType resultType,
492     const std::vector<DynamicType> &argTypes) {
493   auto sameNameRange{map.equal_range(name)};
494   for (const auto *iter{sameNameRange.first}; iter != sameNameRange.second;
495        ++iter) {
496     if (iter->resultType == resultType && iter->argumentTypes == argTypes) {
497       return &*iter;
498     }
499   }
500   return nullptr;
501 }
502 
503 // Search host runtime libraries for an exact type match.
SearchHostRuntime(const std::string & name,DynamicType resultType,const std::vector<DynamicType> & argTypes)504 static const HostRuntimeFunction *SearchHostRuntime(const std::string &name,
505     DynamicType resultType, const std::vector<DynamicType> &argTypes) {
506   // TODO: When command line options regarding targeted numerical library is
507   // available, this needs to be revisited to take it into account. So far,
508   // default to libpgmath if F18 is built with it.
509 #if LINK_WITH_LIBPGMATH
510   if (const auto *map{
511           GetHostRuntimeMap(LibraryVersion::PgmathPrecise, resultType)}) {
512     if (const auto *hostFunction{
513             SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) {
514       return hostFunction;
515     }
516   }
517   // Default to libm if functions or types are not available in pgmath.
518 #endif
519   if (const auto *map{GetHostRuntimeMap(LibraryVersion::Libm, resultType)}) {
520     if (const auto *hostFunction{
521             SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) {
522       return hostFunction;
523     }
524   }
525   if (const auto *map{
526           GetHostRuntimeMap(LibraryVersion::LibmExtensions, resultType)}) {
527     if (const auto *hostFunction{
528             SearchInHostRuntimeMap(*map, name, resultType, argTypes)}) {
529       return hostFunction;
530     }
531   }
532   return nullptr;
533 }
534 
535 // Return a DynamicType that can hold all values of a given type.
536 // This is used to allow 16bit float to be folded with 32bits and
537 // x87 float to be folded with IEEE 128bits.
BiggerType(DynamicType type)538 static DynamicType BiggerType(DynamicType type) {
539   if (type.category() == TypeCategory::Real ||
540       type.category() == TypeCategory::Complex) {
541     // 16 bits floats to IEEE 32 bits float
542     if (type.kind() == common::RealKindForPrecision(11) ||
543         type.kind() == common::RealKindForPrecision(8)) {
544       return {type.category(), common::RealKindForPrecision(24)};
545     }
546     // x87 float to IEEE 128 bits float
547     if (type.kind() == common::RealKindForPrecision(64)) {
548       return {type.category(), common::RealKindForPrecision(113)};
549     }
550   }
551   return type;
552 }
553 
GetHostRuntimeWrapper(const std::string & name,DynamicType resultType,const std::vector<DynamicType> & argTypes)554 std::optional<HostRuntimeWrapper> GetHostRuntimeWrapper(const std::string &name,
555     DynamicType resultType, const std::vector<DynamicType> &argTypes) {
556   if (const auto *hostFunction{SearchHostRuntime(name, resultType, argTypes)}) {
557     return hostFunction->folder;
558   }
559   // If no exact match, search with "bigger" types and insert type
560   // conversions around the folder.
561   std::vector<evaluate::DynamicType> biggerArgTypes;
562   evaluate::DynamicType biggerResultType{BiggerType(resultType)};
563   for (auto type : argTypes) {
564     biggerArgTypes.emplace_back(BiggerType(type));
565   }
566   if (const auto *hostFunction{
567           SearchHostRuntime(name, biggerResultType, biggerArgTypes)}) {
568     return [hostFunction, resultType](
569                FoldingContext &context, std::vector<Expr<SomeType>> &&args) {
570       auto nArgs{args.size()};
571       for (size_t i{0}; i < nArgs; ++i) {
572         args[i] = Fold(context,
573             ConvertToType(hostFunction->argumentTypes[i], std::move(args[i]))
574                 .value());
575       }
576       return Fold(context,
577           ConvertToType(
578               resultType, hostFunction->folder(context, std::move(args)))
579               .value());
580     };
581   }
582   return std::nullopt;
583 }
584 } // namespace Fortran::evaluate
585