[flang] add the possibility to use libpgmath for constant folding

Original-commit: flang-compiler/f18@948a6656277befa60311d38e728c550636cccb5b
Tree-same-pre-rewrite: false

diff --git a/flang/lib/evaluate/CMakeLists.txt b/flang/lib/evaluate/CMakeLists.txt
index 0322046..6aed005 100644 (file)
--- a/flang/lib/evaluate/CMakeLists.txt
+++ b/flang/lib/evaluate/CMakeLists.txt
@@ -38,3 +38,11 @@ target_link_libraries(FortranEvaluate
   FortranParser
   m
 )
+
+# If pgmath library is found, it can be used for constant folding.
+find_library(LIBPGMATH pgmath PATHS ${LIBPGMATH_DIR})
+if(LIBPGMATH)
+  add_compile_definitions(LINK_WITH_LIBPGMATH)
+  target_link_libraries(FortranEvaluate ${LIBPGMATH})
+  message(STATUS "Found libpgmath: ${LIBPGMATH}")
+endif()

diff --git a/flang/lib/evaluate/intrinsics-library.cc b/flang/lib/evaluate/intrinsics-library.cc
index 3356e30..f97a02a 100644 (file)
--- a/flang/lib/evaluate/intrinsics-library.cc
+++ b/flang/lib/evaluate/intrinsics-library.cc
@@ -26,7 +26,7 @@ namespace Fortran::evaluate {
 // Note: argument passing is ignored in equivalence
 bool HostIntrinsicProceduresLibrary::HasEquivalentProcedure(
     const IntrinsicProcedureRuntimeDescription &sym) const {
-  const auto rteProcRange{procedures.equal_range(sym.name)};
+  const auto rteProcRange{procedures_.equal_range(sym.name)};
   const size_t nargs{sym.argumentsType.size()};
   for (auto iter{rteProcRange.first}; iter != rteProcRange.second; ++iter) {
     if (nargs == iter->second.argumentsType.size() &&
@@ -136,7 +136,310 @@ void InitHostIntrinsicLibraryWithLibm(HostIntrinsicProceduresLibrary &lib) {
   AddLibmComplexHostProcedures<long double>(lib);
 }
 
-void HostIntrinsicProceduresLibrary::DefaultInit() {
+#if LINK_WITH_LIBPGMATH
+namespace pgmath {
+// Define mapping between numerical intrinsics and libpgmath symbols
+// namespace is used to have shorter names on repeated patterns.
+// A class would be better to hold all these defs, but GCC does not
+// support specialization of template variables inside class even
+// if it is C++14 standard compliant here because there are only full
+// specializations.
+
+// List of intrinsics that have libpgmath implementations that can be used for
+// constant folding The tag names must match the name used inside libpgmath name
+// so that the macro below work.
+enum class I {
+  acos,
+  acosh,
+  asin,
+  asinh,
+  atan,
+  atan2,
+  atanh,
+  bessel_j0,
+  bessel_j1,
+  bessel_jn,
+  bessel_y0,
+  bessel_y1,
+  bessel_yn,
+  cos,
+  cosh,
+  erf,
+  erfc,
+  erfc_scaled,
+  exp,
+  gamma,
+  hypot,
+  log,
+  log10,
+  log_gamma,
+  mod,
+  sin,
+  sinh,
+  sqrt,
+  tan,
+  tanh
+};
+
+// Library versions: P for Precise, R for Relaxed, F for Fast
+enum class L { F, R, P };
+
+struct NoSuchRuntimeSymbol {};
+template<L, I, typename> constexpr auto Sym{NoSuchRuntimeSymbol{}};
+
+// Macros to declare fast/relaxed/precise libpgmath variants.
+// Note: std::complex and _complex are layout compatible but only std::comlpex
+// should be used here so that templatized functions work as expected (_Complex
+// and std::complex are different from a type point of view).
+#define DECLARE_PGMATH_FAST_REAL(func) \
+  extern "C" float __fs_##func##_1(float); \
+  extern "C" double __fd_##func##_1(double); \
+  template<> constexpr auto Sym<L::F, I::func, float>{__fs_##func##_1}; \
+  template<> constexpr auto Sym<L::F, I::func, double>{__fd_##func##_1};
+
+#define DECLARE_PGMATH_FAST_COMPLEX(func) \
+  extern "C" std::complex<float> __fc_##func##_1(std::complex<float>); \
+  extern "C" std::complex<double> __fz_##func##_1(std::complex<double>); \
+  template<> \
+  constexpr auto Sym<L::F, I::func, std::complex<float>>{__fc_##func##_1}; \
+  template<> \
+  constexpr auto Sym<L::F, I::func, std::complex<double>>{__fz_##func##_1};
+
+#define DECLARE_PGMATH_FAST_ALL_FP(func) \
+  DECLARE_PGMATH_FAST_REAL(func) \
+  DECLARE_PGMATH_FAST_COMPLEX(func)
+
+#define DECLARE_PGMATH_PRECISE_REAL(func) \
+  extern "C" float __ps_##func##_1(float); \
+  extern "C" double __pd_##func##_1(double); \
+  template<> constexpr auto Sym<L::P, I::func, float>{__ps_##func##_1}; \
+  template<> constexpr auto Sym<L::P, I::func, double>{__pd_##func##_1};
+
+#define DECLARE_PGMATH_PRECISE_COMPLEX(func) \
+  extern "C" std::complex<float> __pc_##func##_1(std::complex<float>); \
+  extern "C" std::complex<double> __pz_##func##_1(std::complex<double>); \
+  template<> \
+  constexpr auto Sym<L::P, I::func, std::complex<float>>{__pc_##func##_1}; \
+  template<> \
+  constexpr auto Sym<L::P, I::func, std::complex<double>>{__pz_##func##_1};
+
+#define DECLARE_PGMATH_PRECISE_ALL_FP(func) \
+  DECLARE_PGMATH_PRECISE_REAL(func) \
+  DECLARE_PGMATH_PRECISE_COMPLEX(func)
+
+#define DECLARE_PGMATH_RELAXED_REAL(func) \
+  extern "C" float __rs_##func##_1(float); \
+  extern "C" double __rd_##func##_1(double); \
+  template<> constexpr auto Sym<L::R, I::func, float>{__rs_##func##_1}; \
+  template<> constexpr auto Sym<L::R, I::func, double>{__rd_##func##_1};
+
+#define DECLARE_PGMATH_RELAXED_COMPLEX(func) \
+  extern "C" std::complex<float> __rc_##func##_1(std::complex<float>); \
+  extern "C" std::complex<double> __rz_##func##_1(std::complex<double>); \
+  template<> \
+  constexpr auto Sym<L::R, I::func, std::complex<float>>{__rc_##func##_1}; \
+  template<> \
+  constexpr auto Sym<L::R, I::func, std::complex<double>>{__rz_##func##_1};
+
+#define DECLARE_PGMATH_RELAXED_ALL_FP(func) \
+  DECLARE_PGMATH_RELAXED_REAL(func) \
+  DECLARE_PGMATH_RELAXED_COMPLEX(func)
+
+#define DECLARE_PGMATH_REAL(func) \
+  DECLARE_PGMATH_FAST_REAL(func) \
+  DECLARE_PGMATH_PRECISE_REAL(func) \
+  DECLARE_PGMATH_RELAXED_REAL(func)
+
+#define DECLARE_PGMATH_COMPLEX(func) \
+  DECLARE_PGMATH_FAST_COMPLEX(func) \
+  DECLARE_PGMATH_PRECISE_COMPLEX(func) \
+  DECLARE_PGMATH_RELAXED_COMPLEX(func)
+
+#define DECLARE_PGMATH_ALL(func) \
+  DECLARE_PGMATH_REAL(func) \
+  DECLARE_PGMATH_COMPLEX(func)
+
+// Marcos to declare __mth_i libpgmath variants
+#define DECLARE_PGMATH_MTH_VERSION_REAL(func) \
+  extern "C" float __mth_i_##func(float); \
+  extern "C" double __mth_i_d##func(double); \
+  template<> constexpr auto Sym<L::F, I::func, float>{__mth_i_##func}; \
+  template<> constexpr auto Sym<L::F, I::func, double>{__mth_i_d##func}; \
+  template<> constexpr auto Sym<L::P, I::func, float>{__mth_i_##func}; \
+  template<> constexpr auto Sym<L::P, I::func, double>{__mth_i_d##func}; \
+  template<> constexpr auto Sym<L::R, I::func, float>{__mth_i_##func}; \
+  template<> constexpr auto Sym<L::R, I::func, double>{__mth_i_d##func};
+
+// Actual libpgmath declarations
+DECLARE_PGMATH_ALL(acos)
+DECLARE_PGMATH_MTH_VERSION_REAL(acosh)
+DECLARE_PGMATH_ALL(asin)
+DECLARE_PGMATH_MTH_VERSION_REAL(asinh)
+DECLARE_PGMATH_ALL(atan)
+// atan2 has 2 args
+extern "C" float __fs_atan2_1(float, float);
+extern "C" double __fd_atan2_1(double, double);
+extern "C" float __ps_atan2_1(float, float);
+extern "C" double __pd_atan2_1(double, double);
+extern "C" float __rs_atan2_1(float, float);
+extern "C" double __rd_atan2_1(double, double);
+template<> constexpr auto Sym<L::F, I::atan2, float>{__fs_atan2_1};
+template<> constexpr auto Sym<L::F, I::atan2, double>{__fd_atan2_1};
+template<> constexpr auto Sym<L::P, I::atan2, float>{__ps_atan2_1};
+template<> constexpr auto Sym<L::P, I::atan2, double>{__pd_atan2_1};
+template<> constexpr auto Sym<L::R, I::atan2, float>{__rs_atan2_1};
+template<> constexpr auto Sym<L::R, I::atan2, double>{__rd_atan2_1};
+DECLARE_PGMATH_MTH_VERSION_REAL(atanh)
+DECLARE_PGMATH_MTH_VERSION_REAL(bessel_j0)
+DECLARE_PGMATH_MTH_VERSION_REAL(bessel_j1)
+DECLARE_PGMATH_MTH_VERSION_REAL(bessel_y0)
+DECLARE_PGMATH_MTH_VERSION_REAL(bessel_y1)
+// bessel_jn and bessel_yn takes an int as first arg
+extern "C" float __mth_i_bessel_jn(int, float);
+extern "C" double __mth_i_dbessel_jn(int, double);
+template<> constexpr auto Sym<L::F, I::bessel_jn, float>{__mth_i_bessel_jn};
+template<> constexpr auto Sym<L::F, I::bessel_jn, double>{__mth_i_dbessel_jn};
+template<> constexpr auto Sym<L::P, I::bessel_jn, float>{__mth_i_bessel_jn};
+template<> constexpr auto Sym<L::P, I::bessel_jn, double>{__mth_i_dbessel_jn};
+template<> constexpr auto Sym<L::R, I::bessel_jn, float>{__mth_i_bessel_jn};
+template<> constexpr auto Sym<L::R, I::bessel_jn, double>{__mth_i_dbessel_jn};
+extern "C" float __mth_i_bessel_yn(int, float);
+extern "C" double __mth_i_dbessel_yn(int, double);
+template<> constexpr auto Sym<L::F, I::bessel_yn, float>{__mth_i_bessel_yn};
+template<> constexpr auto Sym<L::F, I::bessel_yn, double>{__mth_i_dbessel_yn};
+template<> constexpr auto Sym<L::P, I::bessel_yn, float>{__mth_i_bessel_yn};
+template<> constexpr auto Sym<L::P, I::bessel_yn, double>{__mth_i_dbessel_yn};
+template<> constexpr auto Sym<L::R, I::bessel_yn, float>{__mth_i_bessel_yn};
+template<> constexpr auto Sym<L::R, I::bessel_yn, double>{__mth_i_dbessel_yn};
+DECLARE_PGMATH_ALL(cos)
+DECLARE_PGMATH_ALL(cosh)
+DECLARE_PGMATH_MTH_VERSION_REAL(erf)
+DECLARE_PGMATH_MTH_VERSION_REAL(erfc)
+DECLARE_PGMATH_MTH_VERSION_REAL(erfc_scaled)
+DECLARE_PGMATH_ALL(exp)
+DECLARE_PGMATH_MTH_VERSION_REAL(gamma)
+extern "C" float __mth_i_hypot(float, float);
+extern "C" double __mth_i_dhypot(double, double);
+template<> constexpr auto Sym<L::F, I::hypot, float>{__mth_i_hypot};
+template<> constexpr auto Sym<L::F, I::hypot, double>{__mth_i_dhypot};
+template<> constexpr auto Sym<L::P, I::hypot, float>{__mth_i_hypot};
+template<> constexpr auto Sym<L::P, I::hypot, double>{__mth_i_dhypot};
+template<> constexpr auto Sym<L::R, I::hypot, float>{__mth_i_hypot};
+template<> constexpr auto Sym<L::R, I::hypot, double>{__mth_i_dhypot};
+DECLARE_PGMATH_ALL(log)
+DECLARE_PGMATH_REAL(log10)
+DECLARE_PGMATH_MTH_VERSION_REAL(log_gamma)
+// no function for modulo in libpgmath
+extern "C" float __fs_mod_1(float, float);
+extern "C" double __fd_mod_1(double, double);
+template<> constexpr auto Sym<L::F, I::mod, float>{__fs_mod_1};
+template<> constexpr auto Sym<L::F, I::mod, double>{__fd_mod_1};
+template<> constexpr auto Sym<L::P, I::mod, float>{__fs_mod_1};
+template<> constexpr auto Sym<L::P, I::mod, double>{__fd_mod_1};
+template<> constexpr auto Sym<L::R, I::mod, float>{__fs_mod_1};
+template<> constexpr auto Sym<L::R, I::mod, double>{__fd_mod_1};
+DECLARE_PGMATH_ALL(sin)
+DECLARE_PGMATH_ALL(sinh)
+DECLARE_PGMATH_MTH_VERSION_REAL(sqrt)
+DECLARE_PGMATH_COMPLEX(sqrt)  // real versions are __mth_i...
+DECLARE_PGMATH_ALL(tan)
+DECLARE_PGMATH_ALL(tanh)
+
+// Fill the function map used for folding with libpgmath symbols
+template<L Lib, typename HostT>
+static void AddLibpgmathRealHostProcedures(
+    HostIntrinsicProceduresLibrary &hostIntrinsicLibrary) {
+  static_assert(std::is_same_v<HostT, float> || std::is_same_v<HostT, double>);
+  HostRuntimeIntrinsicProcedure pgmathSymbols[]{
+      {"acos", Sym<Lib, I::acos, HostT>, true},
+      {"acosh", Sym<Lib, I::acosh, HostT>, true},
+      {"asin", Sym<Lib, I::asin, HostT>, true},
+      {"asinh", Sym<Lib, I::asinh, HostT>, true},
+      {"atan", Sym<Lib, I::atan, HostT>, true},
+      {"atan", Sym<Lib, I::atan2, HostT>,
+          true},  // atan is also the generic name for atan2
+      {"atanh", Sym<Lib, I::atanh, HostT>, true},
+      {"bessel_j0", Sym<Lib, I::bessel_j0, HostT>, true},
+      {"bessel_j1", Sym<Lib, I::bessel_j1, HostT>, true},
+      {"bessel_jn", Sym<Lib, I::bessel_jn, HostT>, true},
+      {"bessel_y0", Sym<Lib, I::bessel_y0, HostT>, true},
+      {"bessel_y1", Sym<Lib, I::bessel_y1, HostT>, true},
+      {"bessel_yn", Sym<Lib, I::bessel_yn, HostT>, true},
+      {"cos", Sym<Lib, I::cos, HostT>, true},
+      {"cosh", Sym<Lib, I::cosh, HostT>, true},
+      {"erf", Sym<Lib, I::erf, HostT>, true},
+      {"erfc", Sym<Lib, I::erfc, HostT>, true},
+      {"erfc_scaled", Sym<Lib, I::erfc_scaled, HostT>, true},
+      {"exp", Sym<Lib, I::exp, HostT>, true},
+      {"gamma", Sym<Lib, I::gamma, HostT>, true},
+      {"hypot", Sym<Lib, I::hypot, HostT>, true},
+      {"log", Sym<Lib, I::log, HostT>, true},
+      {"log10", Sym<Lib, I::log10, HostT>, true},
+      {"log_gamma", Sym<Lib, I::log_gamma, HostT>, true},
+      {"mod", Sym<Lib, I::mod, HostT>, true},
+      {"sin", Sym<Lib, I::sin, HostT>, true},
+      {"sinh", Sym<Lib, I::sinh, HostT>, true},
+      {"sqrt", Sym<Lib, I::sqrt, HostT>, true},
+      {"tan", Sym<Lib, I::tan, HostT>, true},
+      {"tanh", Sym<Lib, I::tanh, HostT>, true}};
+
+  for (auto sym : pgmathSymbols) {
+    hostIntrinsicLibrary.AddProcedure(std::move(sym));
+  }
+}
+
+template<L Lib, typename HostT>
+static void AddLibpgmathComplexHostProcedures(
+    HostIntrinsicProceduresLibrary &hostIntrinsicLibrary) {
+  static_assert(std::is_same_v<HostT, float> || std::is_same_v<HostT, double>);
+  using CHostT = std::complex<HostT>;
+  // cmath is used to complement pgmath when symbols are not available
+  using CmathF = FuncPointer<CHostT, const CHostT &>;
+  HostRuntimeIntrinsicProcedure pgmathSymbols[]{
+      {"abs", FuncPointer<HostT, const CHostT &>{std::abs}, true},
+      {"acos", Sym<Lib, I::acos, CHostT>, true},
+      {"acosh", CmathF{std::acosh}, true},
+      {"asin", Sym<Lib, I::asin, CHostT>, true},
+      {"asinh", CmathF{std::asinh}, true}, {"atan", CmathF{std::atan}, true},
+      {"atanh", CmathF{std::atanh}, true},
+      {"cos", Sym<Lib, I::cos, CHostT>, true},
+      {"cosh", Sym<Lib, I::cosh, CHostT>, true},
+      {"exp", Sym<Lib, I::exp, CHostT>, true},
+      {"log", Sym<Lib, I::log, CHostT>, true},
+      {"sin", Sym<Lib, I::sin, CHostT>, true},
+      {"sinh", Sym<Lib, I::sinh, CHostT>, true},
+      {"sqrt", Sym<Lib, I::sqrt, CHostT>, true},
+      {"tan", Sym<Lib, I::tan, CHostT>, true},
+      {"tanh", Sym<Lib, I::tanh, CHostT>, true}};
+
+  for (auto sym : pgmathSymbols) {
+    hostIntrinsicLibrary.AddProcedure(std::move(sym));
+  }
+}
+
+template<L Lib>
+static void InitHostIntrinsicLibraryWithLibpgmath(
+    HostIntrinsicProceduresLibrary &lib) {
+  AddLibpgmathRealHostProcedures<Lib, float>(lib);
+  AddLibpgmathRealHostProcedures<Lib, double>(lib);
+  AddLibpgmathComplexHostProcedures<Lib, float>(lib);
+  AddLibpgmathComplexHostProcedures<Lib, double>(lib);
+  // No long double functions in libpgmath
+  AddLibmRealHostProcedures<long double>(lib);
+  AddLibmComplexHostProcedures<long double>(lib);
+}
+}
+#endif  // LINK_WITH_LIBPGMATH
+
+// Define which host runtime functions will be used for folding
+HostIntrinsicProceduresLibrary::HostIntrinsicProceduresLibrary() {
+  // TODO: When command line options regarding targeted numerical library is
+  // available, this needs to be revisited to take it into account. So far,
+  // default to libpgmath if F18 is built with it.
+#if LINK_WITH_LIBPGMATH
+  pgmath::InitHostIntrinsicLibraryWithLibpgmath<pgmath::L::P>(*this);
+#else
   InitHostIntrinsicLibraryWithLibm(*this);
+#endif
 }
 }