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

source code of flang/lib/Evaluate/intrinsics-library.cpp