xref: /llvm-project/flang/lib/Evaluate/fold-real.cpp (revision 3f594741cf8e1537fb25f84ef3cf2245b08d8089)
164ab3302SCarolineConcatto //===-- lib/Evaluate/fold-real.cpp ----------------------------------------===//
264ab3302SCarolineConcatto //
364ab3302SCarolineConcatto // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
464ab3302SCarolineConcatto // See https://llvm.org/LICENSE.txt for license information.
564ab3302SCarolineConcatto // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
664ab3302SCarolineConcatto //
764ab3302SCarolineConcatto //===----------------------------------------------------------------------===//
864ab3302SCarolineConcatto 
964ab3302SCarolineConcatto #include "fold-implementation.h"
100fdf9123SPeter Klausler #include "fold-matmul.h"
1147f18af5Speter klausler #include "fold-reduction.h"
1264ab3302SCarolineConcatto 
1364ab3302SCarolineConcatto namespace Fortran::evaluate {
1464ab3302SCarolineConcatto 
156c81b4a0SJean Perier template <typename T>
166c81b4a0SJean Perier static Expr<T> FoldTransformationalBessel(
176c81b4a0SJean Perier     FunctionRef<T> &&funcRef, FoldingContext &context) {
186c81b4a0SJean Perier   CHECK(funcRef.arguments().size() == 3);
196c81b4a0SJean Perier   /// Bessel runtime functions use `int` integer arguments. Convert integer
206c81b4a0SJean Perier   /// arguments to Int4, any overflow error will be reported during the
216c81b4a0SJean Perier   /// conversion folding.
226c81b4a0SJean Perier   using Int4 = Type<TypeCategory::Integer, 4>;
236f7e715eSPeter Klausler   if (auto args{GetConstantArguments<Int4, Int4, T>(
246f7e715eSPeter Klausler           context, funcRef.arguments(), /*hasOptionalArgument=*/false)}) {
256c81b4a0SJean Perier     const std::string &name{std::get<SpecificIntrinsic>(funcRef.proc().u).name};
266c81b4a0SJean Perier     if (auto elementalBessel{GetHostRuntimeWrapper<T, Int4, T>(name)}) {
276c81b4a0SJean Perier       std::vector<Scalar<T>> results;
286c81b4a0SJean Perier       int n1{static_cast<int>(
296c81b4a0SJean Perier           std::get<0>(*args)->GetScalarValue().value().ToInt64())};
306c81b4a0SJean Perier       int n2{static_cast<int>(
316c81b4a0SJean Perier           std::get<1>(*args)->GetScalarValue().value().ToInt64())};
326c81b4a0SJean Perier       Scalar<T> x{std::get<2>(*args)->GetScalarValue().value()};
336c81b4a0SJean Perier       for (int i{n1}; i <= n2; ++i) {
346c81b4a0SJean Perier         results.emplace_back((*elementalBessel)(context, Scalar<Int4>{i}, x));
356c81b4a0SJean Perier       }
366c81b4a0SJean Perier       return Expr<T>{Constant<T>{
376c81b4a0SJean Perier           std::move(results), ConstantSubscripts{std::max(n2 - n1 + 1, 0)}}};
38505f6da1SPeter Klausler     } else if (context.languageFeatures().ShouldWarn(
39505f6da1SPeter Klausler                    common::UsageWarning::FoldingFailure)) {
400f973ac7SPeter Klausler       context.messages().Say(common::UsageWarning::FoldingFailure,
416c81b4a0SJean Perier           "%s(integer(kind=4), real(kind=%d)) cannot be folded on host"_warn_en_US,
426c81b4a0SJean Perier           name, T::kind);
436c81b4a0SJean Perier     }
446c81b4a0SJean Perier   }
456c81b4a0SJean Perier   return Expr<T>{std::move(funcRef)};
466c81b4a0SJean Perier }
476c81b4a0SJean Perier 
4839f1860dSPeter Klausler // NORM2
4939f1860dSPeter Klausler template <int KIND> class Norm2Accumulator {
5039f1860dSPeter Klausler   using T = Type<TypeCategory::Real, KIND>;
5139f1860dSPeter Klausler 
5239f1860dSPeter Klausler public:
5339f1860dSPeter Klausler   Norm2Accumulator(
5439f1860dSPeter Klausler       const Constant<T> &array, const Constant<T> &maxAbs, Rounding rounding)
5539f1860dSPeter Klausler       : array_{array}, maxAbs_{maxAbs}, rounding_{rounding} {};
5682e1e412SPeter Klausler   void operator()(
5782e1e412SPeter Klausler       Scalar<T> &element, const ConstantSubscripts &at, bool /*first*/) {
583502d340SPeter Klausler     // Summation of scaled elements:
59b225934aSPeter Klausler     // Naively,
60b225934aSPeter Klausler     //   NORM2(A(:)) = SQRT(SUM(A(:)**2))
61b225934aSPeter Klausler     // For any T > 0, we have mathematically
62b225934aSPeter Klausler     //   SQRT(SUM(A(:)**2))
63b225934aSPeter Klausler     //     = SQRT(T**2 * (SUM(A(:)**2) / T**2))
64b225934aSPeter Klausler     //     = SQRT(T**2 * SUM(A(:)**2 / T**2))
65b225934aSPeter Klausler     //     = SQRT(T**2 * SUM((A(:)/T)**2))
66b225934aSPeter Klausler     //     = SQRT(T**2) * SQRT(SUM((A(:)/T)**2))
67b225934aSPeter Klausler     //     = T * SQRT(SUM((A(:)/T)**2))
68b225934aSPeter Klausler     // By letting T = MAXVAL(ABS(A)), we ensure that
69b225934aSPeter Klausler     // ALL(ABS(A(:)/T) <= 1), so ALL((A(:)/T)**2 <= 1), and the SUM will
70b225934aSPeter Klausler     // not overflow unless absolutely necessary.
7139f1860dSPeter Klausler     auto scale{maxAbs_.At(maxAbsAt_)};
7239f1860dSPeter Klausler     if (scale.IsZero()) {
73b225934aSPeter Klausler       // Maximum value is zero, and so will the result be.
74b225934aSPeter Klausler       // Avoid division by zero below.
7539f1860dSPeter Klausler       element = scale;
7639f1860dSPeter Klausler     } else {
7739f1860dSPeter Klausler       auto item{array_.At(at)};
7839f1860dSPeter Klausler       auto scaled{item.Divide(scale).value};
79b225934aSPeter Klausler       auto square{scaled.Multiply(scaled).value};
803502d340SPeter Klausler       if constexpr (useKahanSummation) {
81*3f594741SPeter Klausler         auto next{square.Subtract(correction_, rounding_)};
8239f1860dSPeter Klausler         overflow_ |= next.flags.test(RealFlag::Overflow);
8339f1860dSPeter Klausler         auto sum{element.Add(next.value, rounding_)};
8439f1860dSPeter Klausler         overflow_ |= sum.flags.test(RealFlag::Overflow);
8539f1860dSPeter Klausler         correction_ = sum.value.Subtract(element, rounding_)
8639f1860dSPeter Klausler                           .value.Subtract(next.value, rounding_)
8739f1860dSPeter Klausler                           .value;
8839f1860dSPeter Klausler         element = sum.value;
893502d340SPeter Klausler       } else {
903502d340SPeter Klausler         auto sum{element.Add(square, rounding_)};
913502d340SPeter Klausler         overflow_ |= sum.flags.test(RealFlag::Overflow);
923502d340SPeter Klausler         element = sum.value;
933502d340SPeter Klausler       }
9439f1860dSPeter Klausler     }
9539f1860dSPeter Klausler   }
9639f1860dSPeter Klausler   bool overflow() const { return overflow_; }
9739f1860dSPeter Klausler   void Done(Scalar<T> &result) {
983502d340SPeter Klausler     // incoming result = SUM((data(:)/maxAbs)**2)
993502d340SPeter Klausler     // outgoing result = maxAbs * SQRT(result)
1003502d340SPeter Klausler     auto root{result.SQRT().value};
101b225934aSPeter Klausler     auto product{root.Multiply(maxAbs_.At(maxAbsAt_))};
10239f1860dSPeter Klausler     maxAbs_.IncrementSubscripts(maxAbsAt_);
103b225934aSPeter Klausler     overflow_ |= product.flags.test(RealFlag::Overflow);
104b225934aSPeter Klausler     result = product.value;
10539f1860dSPeter Klausler   }
10639f1860dSPeter Klausler 
10739f1860dSPeter Klausler private:
10839f1860dSPeter Klausler   const Constant<T> &array_;
10939f1860dSPeter Klausler   const Constant<T> &maxAbs_;
11039f1860dSPeter Klausler   const Rounding rounding_;
11139f1860dSPeter Klausler   bool overflow_{false};
11239f1860dSPeter Klausler   Scalar<T> correction_{};
11339f1860dSPeter Klausler   ConstantSubscripts maxAbsAt_{maxAbs_.lbounds()};
11439f1860dSPeter Klausler };
11539f1860dSPeter Klausler 
11639f1860dSPeter Klausler template <int KIND>
11739f1860dSPeter Klausler static Expr<Type<TypeCategory::Real, KIND>> FoldNorm2(FoldingContext &context,
11839f1860dSPeter Klausler     FunctionRef<Type<TypeCategory::Real, KIND>> &&funcRef) {
11939f1860dSPeter Klausler   using T = Type<TypeCategory::Real, KIND>;
12039f1860dSPeter Klausler   using Element = typename Constant<T>::Element;
12139f1860dSPeter Klausler   std::optional<int> dim;
12282e1e412SPeter Klausler   if (std::optional<ArrayAndMask<T>> arrayAndMask{
12382e1e412SPeter Klausler           ProcessReductionArgs<T>(context, funcRef.arguments(), dim,
12439f1860dSPeter Klausler               /*X=*/0, /*DIM=*/1)}) {
12539f1860dSPeter Klausler     MaxvalMinvalAccumulator<T, /*ABS=*/true> maxAbsAccumulator{
12682e1e412SPeter Klausler         RelationalOperator::GT, context, arrayAndMask->array};
12782e1e412SPeter Klausler     const Element identity{};
12882e1e412SPeter Klausler     Constant<T> maxAbs{DoReduction<T>(arrayAndMask->array, arrayAndMask->mask,
12982e1e412SPeter Klausler         dim, identity, maxAbsAccumulator)};
13082e1e412SPeter Klausler     Norm2Accumulator norm2Accumulator{arrayAndMask->array, maxAbs,
13182e1e412SPeter Klausler         context.targetCharacteristics().roundingMode()};
13282e1e412SPeter Klausler     Constant<T> result{DoReduction<T>(arrayAndMask->array, arrayAndMask->mask,
13382e1e412SPeter Klausler         dim, identity, norm2Accumulator)};
134505f6da1SPeter Klausler     if (norm2Accumulator.overflow() &&
135505f6da1SPeter Klausler         context.languageFeatures().ShouldWarn(
136505f6da1SPeter Klausler             common::UsageWarning::FoldingException)) {
1370f973ac7SPeter Klausler       context.messages().Say(common::UsageWarning::FoldingException,
13839f1860dSPeter Klausler           "NORM2() of REAL(%d) data overflowed"_warn_en_US, KIND);
13939f1860dSPeter Klausler     }
14039f1860dSPeter Klausler     return Expr<T>{std::move(result)};
14139f1860dSPeter Klausler   }
14239f1860dSPeter Klausler   return Expr<T>{std::move(funcRef)};
14339f1860dSPeter Klausler }
14439f1860dSPeter Klausler 
14564ab3302SCarolineConcatto template <int KIND>
14664ab3302SCarolineConcatto Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
14764ab3302SCarolineConcatto     FoldingContext &context,
14864ab3302SCarolineConcatto     FunctionRef<Type<TypeCategory::Real, KIND>> &&funcRef) {
14964ab3302SCarolineConcatto   using T = Type<TypeCategory::Real, KIND>;
15064ab3302SCarolineConcatto   using ComplexT = Type<TypeCategory::Complex, KIND>;
1510b837753SPeter Klausler   using Int4 = Type<TypeCategory::Integer, 4>;
15264ab3302SCarolineConcatto   ActualArguments &args{funcRef.arguments()};
15364ab3302SCarolineConcatto   auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
15464ab3302SCarolineConcatto   CHECK(intrinsic);
15564ab3302SCarolineConcatto   std::string name{intrinsic->name};
15664ab3302SCarolineConcatto   if (name == "acos" || name == "acosh" || name == "asin" || name == "asinh" ||
15764ab3302SCarolineConcatto       (name == "atan" && args.size() == 1) || name == "atanh" ||
15864ab3302SCarolineConcatto       name == "bessel_j0" || name == "bessel_j1" || name == "bessel_y0" ||
15964ab3302SCarolineConcatto       name == "bessel_y1" || name == "cos" || name == "cosh" || name == "erf" ||
16064ab3302SCarolineConcatto       name == "erfc" || name == "erfc_scaled" || name == "exp" ||
16164ab3302SCarolineConcatto       name == "gamma" || name == "log" || name == "log10" ||
162c9e9635fSpeter klausler       name == "log_gamma" || name == "sin" || name == "sinh" || name == "tan" ||
163c9e9635fSpeter klausler       name == "tanh") {
16464ab3302SCarolineConcatto     CHECK(args.size() == 1);
16594d9a4fdSJean Perier     if (auto callable{GetHostRuntimeWrapper<T, T>(name)}) {
16664ab3302SCarolineConcatto       return FoldElementalIntrinsic<T, T>(
16764ab3302SCarolineConcatto           context, std::move(funcRef), *callable);
168505f6da1SPeter Klausler     } else if (context.languageFeatures().ShouldWarn(
169505f6da1SPeter Klausler                    common::UsageWarning::FoldingFailure)) {
1700f973ac7SPeter Klausler       context.messages().Say(common::UsageWarning::FoldingFailure,
171a53967cdSPeter Klausler           "%s(real(kind=%d)) cannot be folded on host"_warn_en_US, name, KIND);
17264ab3302SCarolineConcatto     }
173f1fa3b7fSJean Perier   } else if (name == "amax0" || name == "amin0" || name == "amin1" ||
174f1fa3b7fSJean Perier       name == "amax1" || name == "dmin1" || name == "dmax1") {
175f1fa3b7fSJean Perier     return RewriteSpecificMINorMAX(context, std::move(funcRef));
17671728360SPeter Klausler   } else if (name == "atan" || name == "atan2") {
177eb305631SJean Perier     std::string localName{name == "atan" ? "atan2" : name};
17864ab3302SCarolineConcatto     CHECK(args.size() == 2);
17994d9a4fdSJean Perier     if (auto callable{GetHostRuntimeWrapper<T, T, T>(localName)}) {
18064ab3302SCarolineConcatto       return FoldElementalIntrinsic<T, T, T>(
18164ab3302SCarolineConcatto           context, std::move(funcRef), *callable);
182505f6da1SPeter Klausler     } else if (context.languageFeatures().ShouldWarn(
183505f6da1SPeter Klausler                    common::UsageWarning::FoldingFailure)) {
1840f973ac7SPeter Klausler       context.messages().Say(common::UsageWarning::FoldingFailure,
185a53967cdSPeter Klausler           "%s(real(kind=%d), real(kind%d)) cannot be folded on host"_warn_en_US,
18664ab3302SCarolineConcatto           name, KIND, KIND);
18764ab3302SCarolineConcatto     }
18864ab3302SCarolineConcatto   } else if (name == "bessel_jn" || name == "bessel_yn") {
18964ab3302SCarolineConcatto     if (args.size() == 2) { // elemental
19064ab3302SCarolineConcatto       // runtime functions use int arg
19194d9a4fdSJean Perier       if (auto callable{GetHostRuntimeWrapper<T, Int4, T>(name)}) {
19264ab3302SCarolineConcatto         return FoldElementalIntrinsic<T, Int4, T>(
19364ab3302SCarolineConcatto             context, std::move(funcRef), *callable);
194505f6da1SPeter Klausler       } else if (context.languageFeatures().ShouldWarn(
195505f6da1SPeter Klausler                      common::UsageWarning::FoldingFailure)) {
1960f973ac7SPeter Klausler         context.messages().Say(common::UsageWarning::FoldingFailure,
197a53967cdSPeter Klausler             "%s(integer(kind=4), real(kind=%d)) cannot be folded on host"_warn_en_US,
19864ab3302SCarolineConcatto             name, KIND);
19964ab3302SCarolineConcatto       }
2006c81b4a0SJean Perier     } else {
2016c81b4a0SJean Perier       return FoldTransformationalBessel<T>(std::move(funcRef), context);
20264ab3302SCarolineConcatto     }
203d393ce3bSPeter Klausler   } else if (name == "abs") { // incl. zabs & cdabs
20464ab3302SCarolineConcatto     // Argument can be complex or real
205666679a5SFangrui Song     if (UnwrapExpr<Expr<SomeReal>>(args[0])) {
20664ab3302SCarolineConcatto       return FoldElementalIntrinsic<T, T>(
20764ab3302SCarolineConcatto           context, std::move(funcRef), &Scalar<T>::ABS);
208666679a5SFangrui Song     } else if (UnwrapExpr<Expr<SomeComplex>>(args[0])) {
209c9e9635fSpeter klausler       return FoldElementalIntrinsic<T, ComplexT>(context, std::move(funcRef),
21078d59a65SPeter Klausler           ScalarFunc<T, ComplexT>([&name, &context](
21178d59a65SPeter Klausler                                       const Scalar<ComplexT> &z) -> Scalar<T> {
21278d59a65SPeter Klausler             ValueWithRealFlags<Scalar<T>> y{z.ABS()};
213505f6da1SPeter Klausler             if (y.flags.test(RealFlag::Overflow) &&
214505f6da1SPeter Klausler                 context.languageFeatures().ShouldWarn(
215505f6da1SPeter Klausler                     common::UsageWarning::FoldingException)) {
2160f973ac7SPeter Klausler               context.messages().Say(common::UsageWarning::FoldingException,
21778d59a65SPeter Klausler                   "complex ABS intrinsic folding overflow"_warn_en_US, name);
21878d59a65SPeter Klausler             }
21978d59a65SPeter Klausler             return y.value;
220c9e9635fSpeter klausler           }));
22164ab3302SCarolineConcatto     } else {
22264ab3302SCarolineConcatto       common::die(" unexpected argument type inside abs");
22364ab3302SCarolineConcatto     }
22464ab3302SCarolineConcatto   } else if (name == "aimag") {
2253a26596aSPeter Klausler     if (auto *zExpr{UnwrapExpr<Expr<ComplexT>>(args[0])}) {
2263a26596aSPeter Klausler       return Fold(context, Expr<T>{ComplexComponent{true, std::move(*zExpr)}});
2273a26596aSPeter Klausler     }
22864ab3302SCarolineConcatto   } else if (name == "aint" || name == "anint") {
22964ab3302SCarolineConcatto     // ANINT rounds ties away from zero, not to even
23064ab3302SCarolineConcatto     common::RoundingMode mode{name == "aint"
23164ab3302SCarolineConcatto             ? common::RoundingMode::ToZero
23264ab3302SCarolineConcatto             : common::RoundingMode::TiesAwayFromZero};
23364ab3302SCarolineConcatto     return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
23474d5c3c0SPeter Steinfeld         ScalarFunc<T, T>(
23574d5c3c0SPeter Steinfeld             [&name, &context, mode](const Scalar<T> &x) -> Scalar<T> {
23664ab3302SCarolineConcatto               ValueWithRealFlags<Scalar<T>> y{x.ToWholeNumber(mode)};
237505f6da1SPeter Klausler               if (y.flags.test(RealFlag::Overflow) &&
238505f6da1SPeter Klausler                   context.languageFeatures().ShouldWarn(
239505f6da1SPeter Klausler                       common::UsageWarning::FoldingException)) {
2400f973ac7SPeter Klausler                 context.messages().Say(common::UsageWarning::FoldingException,
241a53967cdSPeter Klausler                     "%s intrinsic folding overflow"_warn_en_US, name);
24264ab3302SCarolineConcatto               }
24364ab3302SCarolineConcatto               return y.value;
24464ab3302SCarolineConcatto             }));
2459e50168bSPeter Klausler   } else if (name == "dim") {
2469e50168bSPeter Klausler     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
2479f8ee610SPeter Klausler         ScalarFunc<T, T, T>([&context](const Scalar<T> &x,
2489f8ee610SPeter Klausler                                 const Scalar<T> &y) -> Scalar<T> {
2499f8ee610SPeter Klausler           ValueWithRealFlags<Scalar<T>> result{x.DIM(y)};
250505f6da1SPeter Klausler           if (result.flags.test(RealFlag::Overflow) &&
251505f6da1SPeter Klausler               context.languageFeatures().ShouldWarn(
252505f6da1SPeter Klausler                   common::UsageWarning::FoldingException)) {
2530f973ac7SPeter Klausler             context.messages().Say(common::UsageWarning::FoldingException,
2540f973ac7SPeter Klausler                 "DIM intrinsic folding overflow"_warn_en_US);
2559f8ee610SPeter Klausler           }
2569f8ee610SPeter Klausler           return result.value;
2579e50168bSPeter Klausler         }));
258e723c69bSPeter Klausler   } else if (name == "dot_product") {
259e723c69bSPeter Klausler     return FoldDotProduct<T>(context, std::move(funcRef));
26064ab3302SCarolineConcatto   } else if (name == "dprod") {
2614f1eec1fSPeter Klausler     // Rewrite DPROD(x,y) -> DBLE(x)*DBLE(y)
2624f1eec1fSPeter Klausler     if (args.at(0) && args.at(1)) {
2634f1eec1fSPeter Klausler       const auto *xExpr{args[0]->UnwrapExpr()};
2644f1eec1fSPeter Klausler       const auto *yExpr{args[1]->UnwrapExpr()};
2654f1eec1fSPeter Klausler       if (xExpr && yExpr) {
26664ab3302SCarolineConcatto         return Fold(context,
2674f1eec1fSPeter Klausler             ToReal<T::kind>(context, common::Clone(*xExpr)) *
2684f1eec1fSPeter Klausler                 ToReal<T::kind>(context, common::Clone(*yExpr)));
2694f1eec1fSPeter Klausler       }
27064ab3302SCarolineConcatto     }
27164ab3302SCarolineConcatto   } else if (name == "epsilon") {
27264ab3302SCarolineConcatto     return Expr<T>{Scalar<T>::EPSILON()};
2730b837753SPeter Klausler   } else if (name == "fraction") {
2740b837753SPeter Klausler     return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
2750b837753SPeter Klausler         ScalarFunc<T, T>(
2760b837753SPeter Klausler             [](const Scalar<T> &x) -> Scalar<T> { return x.FRACTION(); }));
27764ab3302SCarolineConcatto   } else if (name == "huge") {
27864ab3302SCarolineConcatto     return Expr<T>{Scalar<T>::HUGE()};
279c9e9635fSpeter klausler   } else if (name == "hypot") {
280c9e9635fSpeter klausler     CHECK(args.size() == 2);
281c9e9635fSpeter klausler     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
282c9e9635fSpeter klausler         ScalarFunc<T, T, T>(
283b2b43794SPeter Klausler             [&](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
284b2b43794SPeter Klausler               ValueWithRealFlags<Scalar<T>> result{x.HYPOT(y)};
285505f6da1SPeter Klausler               if (result.flags.test(RealFlag::Overflow) &&
286505f6da1SPeter Klausler                   context.languageFeatures().ShouldWarn(
287505f6da1SPeter Klausler                       common::UsageWarning::FoldingException)) {
2880f973ac7SPeter Klausler                 context.messages().Say(common::UsageWarning::FoldingException,
289b2b43794SPeter Klausler                     "HYPOT intrinsic folding overflow"_warn_en_US);
290b2b43794SPeter Klausler               }
291b2b43794SPeter Klausler               return result.value;
292c9e9635fSpeter klausler             }));
2930fdf9123SPeter Klausler   } else if (name == "matmul") {
2940fdf9123SPeter Klausler     return FoldMatmul(context, std::move(funcRef));
29564ab3302SCarolineConcatto   } else if (name == "max") {
29664ab3302SCarolineConcatto     return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
29747f18af5Speter klausler   } else if (name == "maxval") {
29847f18af5Speter klausler     return FoldMaxvalMinval<T>(context, std::move(funcRef),
29947f18af5Speter klausler         RelationalOperator::GT, T::Scalar::HUGE().Negate());
30071728360SPeter Klausler   } else if (name == "min") {
30171728360SPeter Klausler     return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
30271728360SPeter Klausler   } else if (name == "minval") {
30371728360SPeter Klausler     return FoldMaxvalMinval<T>(
30471728360SPeter Klausler         context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
30571728360SPeter Klausler   } else if (name == "mod") {
30671728360SPeter Klausler     CHECK(args.size() == 2);
307317277e4SPeter Klausler     bool badPConst{false};
308317277e4SPeter Klausler     if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
309317277e4SPeter Klausler       *pExpr = Fold(context, std::move(*pExpr));
310317277e4SPeter Klausler       if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
311317277e4SPeter Klausler           pConst->IsZero() &&
312317277e4SPeter Klausler           context.languageFeatures().ShouldWarn(
313317277e4SPeter Klausler               common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
3140f973ac7SPeter Klausler         context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
3150f973ac7SPeter Klausler             "MOD: P argument is zero"_warn_en_US);
316317277e4SPeter Klausler         badPConst = true;
317317277e4SPeter Klausler       }
318317277e4SPeter Klausler     }
31971728360SPeter Klausler     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
320317277e4SPeter Klausler         ScalarFunc<T, T, T>([&context, badPConst](const Scalar<T> &x,
321317277e4SPeter Klausler                                 const Scalar<T> &y) -> Scalar<T> {
32271728360SPeter Klausler           auto result{x.MOD(y)};
323317277e4SPeter Klausler           if (!badPConst && result.flags.test(RealFlag::DivideByZero) &&
324505f6da1SPeter Klausler               context.languageFeatures().ShouldWarn(
325505f6da1SPeter Klausler                   common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
32671728360SPeter Klausler             context.messages().Say(
3270f973ac7SPeter Klausler                 common::UsageWarning::FoldingAvoidsRuntimeCrash,
32871728360SPeter Klausler                 "second argument to MOD must not be zero"_warn_en_US);
32971728360SPeter Klausler           }
33071728360SPeter Klausler           return result.value;
33171728360SPeter Klausler         }));
33271728360SPeter Klausler   } else if (name == "modulo") {
33371728360SPeter Klausler     CHECK(args.size() == 2);
334317277e4SPeter Klausler     bool badPConst{false};
335317277e4SPeter Klausler     if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
336317277e4SPeter Klausler       *pExpr = Fold(context, std::move(*pExpr));
337317277e4SPeter Klausler       if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
338317277e4SPeter Klausler           pConst->IsZero() &&
339317277e4SPeter Klausler           context.languageFeatures().ShouldWarn(
340317277e4SPeter Klausler               common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
3410f973ac7SPeter Klausler         context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
3420f973ac7SPeter Klausler             "MODULO: P argument is zero"_warn_en_US);
343317277e4SPeter Klausler         badPConst = true;
344317277e4SPeter Klausler       }
345317277e4SPeter Klausler     }
34671728360SPeter Klausler     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
347317277e4SPeter Klausler         ScalarFunc<T, T, T>([&context, badPConst](const Scalar<T> &x,
348317277e4SPeter Klausler                                 const Scalar<T> &y) -> Scalar<T> {
34971728360SPeter Klausler           auto result{x.MODULO(y)};
350317277e4SPeter Klausler           if (!badPConst && result.flags.test(RealFlag::DivideByZero) &&
351505f6da1SPeter Klausler               context.languageFeatures().ShouldWarn(
352505f6da1SPeter Klausler                   common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
35371728360SPeter Klausler             context.messages().Say(
3540f973ac7SPeter Klausler                 common::UsageWarning::FoldingAvoidsRuntimeCrash,
35571728360SPeter Klausler                 "second argument to MODULO must not be zero"_warn_en_US);
35671728360SPeter Klausler           }
35771728360SPeter Klausler           return result.value;
35871728360SPeter Klausler         }));
359e619c07dSPeter Klausler   } else if (name == "nearest") {
360317277e4SPeter Klausler     if (auto *sExpr{UnwrapExpr<Expr<SomeReal>>(args[1])}) {
361317277e4SPeter Klausler       *sExpr = Fold(context, std::move(*sExpr));
362cd03e96fSPeter Klausler       return common::visit(
363e619c07dSPeter Klausler           [&](const auto &sVal) {
364e619c07dSPeter Klausler             using TS = ResultType<decltype(sVal)>;
365317277e4SPeter Klausler             bool badSConst{false};
366317277e4SPeter Klausler             if (auto sConst{GetScalarConstantValue<TS>(sVal)}; sConst &&
36790617e99SPeter Klausler                 (sConst->IsZero() || sConst->IsNotANumber()) &&
368317277e4SPeter Klausler                 context.languageFeatures().ShouldWarn(
369317277e4SPeter Klausler                     common::UsageWarning::FoldingValueChecks)) {
3700f973ac7SPeter Klausler               context.messages().Say(common::UsageWarning::FoldingValueChecks,
3710f973ac7SPeter Klausler                   "NEAREST: S argument is %s"_warn_en_US,
37290617e99SPeter Klausler                   sConst->IsZero() ? "zero" : "NaN");
373317277e4SPeter Klausler               badSConst = true;
374317277e4SPeter Klausler             }
375e619c07dSPeter Klausler             return FoldElementalIntrinsic<T, T, TS>(context, std::move(funcRef),
376e619c07dSPeter Klausler                 ScalarFunc<T, T, TS>([&](const Scalar<T> &x,
377e619c07dSPeter Klausler                                          const Scalar<TS> &s) -> Scalar<T> {
37890617e99SPeter Klausler                   if (!badSConst && (s.IsZero() || s.IsNotANumber()) &&
379505f6da1SPeter Klausler                       context.languageFeatures().ShouldWarn(
380505f6da1SPeter Klausler                           common::UsageWarning::FoldingValueChecks)) {
381e619c07dSPeter Klausler                     context.messages().Say(
3820f973ac7SPeter Klausler                         common::UsageWarning::FoldingValueChecks,
38390617e99SPeter Klausler                         "NEAREST: S argument is %s"_warn_en_US,
38490617e99SPeter Klausler                         s.IsZero() ? "zero" : "NaN");
385e619c07dSPeter Klausler                   }
386e619c07dSPeter Klausler                   auto result{x.NEAREST(!s.IsNegative())};
387505f6da1SPeter Klausler                   if (context.languageFeatures().ShouldWarn(
388505f6da1SPeter Klausler                           common::UsageWarning::FoldingException)) {
38990617e99SPeter Klausler                     if (result.flags.test(RealFlag::InvalidArgument)) {
390e619c07dSPeter Klausler                       context.messages().Say(
3910f973ac7SPeter Klausler                           common::UsageWarning::FoldingException,
392e619c07dSPeter Klausler                           "NEAREST intrinsic folding: bad argument"_warn_en_US);
393e619c07dSPeter Klausler                     }
394505f6da1SPeter Klausler                   }
395e619c07dSPeter Klausler                   return result.value;
396e619c07dSPeter Klausler                 }));
397e619c07dSPeter Klausler           },
398e619c07dSPeter Klausler           sExpr->u);
399e619c07dSPeter Klausler     }
40039f1860dSPeter Klausler   } else if (name == "norm2") {
40139f1860dSPeter Klausler     return FoldNorm2<T::kind>(context, std::move(funcRef));
402503c085eSpeter klausler   } else if (name == "product") {
403503c085eSpeter klausler     auto one{Scalar<T>::FromInteger(value::Integer<8>{1}).value};
404503c085eSpeter klausler     return FoldProduct<T>(context, std::move(funcRef), one);
405d2663fccSRoger Ferrer Ibanez   } else if (name == "real" || name == "dble") {
40664ab3302SCarolineConcatto     if (auto *expr{args[0].value().UnwrapExpr()}) {
40764ab3302SCarolineConcatto       return ToReal<KIND>(context, std::move(*expr));
40864ab3302SCarolineConcatto     }
4091cff71b9SPeter Klausler   } else if (name == "rrspacing") {
4101cff71b9SPeter Klausler     return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
4111cff71b9SPeter Klausler         ScalarFunc<T, T>(
4121cff71b9SPeter Klausler             [](const Scalar<T> &x) -> Scalar<T> { return x.RRSPACING(); }));
4135c5bde1bSPeter Klausler   } else if (name == "scale") {
4145c5bde1bSPeter Klausler     if (const auto *byExpr{UnwrapExpr<Expr<SomeInteger>>(args[1])}) {
415cd03e96fSPeter Klausler       return common::visit(
4165c5bde1bSPeter Klausler           [&](const auto &byVal) {
4175c5bde1bSPeter Klausler             using TBY = ResultType<decltype(byVal)>;
4185c5bde1bSPeter Klausler             return FoldElementalIntrinsic<T, T, TBY>(context,
4195c5bde1bSPeter Klausler                 std::move(funcRef),
4205c5bde1bSPeter Klausler                 ScalarFunc<T, T, TBY>(
4215c5bde1bSPeter Klausler                     [&](const Scalar<T> &x, const Scalar<TBY> &y) -> Scalar<T> {
4227bc76729SDavid Spickett                       ValueWithRealFlags<Scalar<T>> result{
4237bc76729SDavid Spickett                           x.
4245c5bde1bSPeter Klausler // MSVC chokes on the keyword "template" here in a call to a
4255c5bde1bSPeter Klausler // member function template.
4265c5bde1bSPeter Klausler #ifndef _MSC_VER
4275c5bde1bSPeter Klausler                           template
4285c5bde1bSPeter Klausler #endif
4297bc76729SDavid Spickett                           SCALE<Scalar<TBY>>(y)};
430505f6da1SPeter Klausler                       if (result.flags.test(RealFlag::Overflow) &&
431505f6da1SPeter Klausler                           context.languageFeatures().ShouldWarn(
432505f6da1SPeter Klausler                               common::UsageWarning::FoldingException)) {
4335c5bde1bSPeter Klausler                         context.messages().Say(
4340f973ac7SPeter Klausler                             common::UsageWarning::FoldingException,
435592c0fe5Svdonaldson                             "SCALE/IEEE_SCALB intrinsic folding overflow"_warn_en_US);
4365c5bde1bSPeter Klausler                       }
4375c5bde1bSPeter Klausler                       return result.value;
4385c5bde1bSPeter Klausler                     }));
4395c5bde1bSPeter Klausler           },
4405c5bde1bSPeter Klausler           byExpr->u);
4415c5bde1bSPeter Klausler     }
4420b837753SPeter Klausler   } else if (name == "set_exponent") {
44381003744SPeter Klausler     if (const auto *iExpr{UnwrapExpr<Expr<SomeInteger>>(args[1])}) {
44481003744SPeter Klausler       return common::visit(
44581003744SPeter Klausler           [&](const auto &iVal) {
44681003744SPeter Klausler             using TY = ResultType<decltype(iVal)>;
44781003744SPeter Klausler             return FoldElementalIntrinsic<T, T, TY>(context, std::move(funcRef),
44881003744SPeter Klausler                 ScalarFunc<T, T, TY>(
44981003744SPeter Klausler                     [&](const Scalar<T> &x, const Scalar<TY> &i) -> Scalar<T> {
4500b837753SPeter Klausler                       return x.SET_EXPONENT(i.ToInt64());
4510b837753SPeter Klausler                     }));
45281003744SPeter Klausler           },
45381003744SPeter Klausler           iExpr->u);
45481003744SPeter Klausler     }
45564ab3302SCarolineConcatto   } else if (name == "sign") {
45664ab3302SCarolineConcatto     return FoldElementalIntrinsic<T, T, T>(
45764ab3302SCarolineConcatto         context, std::move(funcRef), &Scalar<T>::SIGN);
4581cff71b9SPeter Klausler   } else if (name == "spacing") {
4591cff71b9SPeter Klausler     return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
4601cff71b9SPeter Klausler         ScalarFunc<T, T>(
4611cff71b9SPeter Klausler             [](const Scalar<T> &x) -> Scalar<T> { return x.SPACING(); }));
462c9e9635fSpeter klausler   } else if (name == "sqrt") {
463c9e9635fSpeter klausler     return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
464c9e9635fSpeter klausler         ScalarFunc<T, T>(
465c9e9635fSpeter klausler             [](const Scalar<T> &x) -> Scalar<T> { return x.SQRT().value; }));
466503c085eSpeter klausler   } else if (name == "sum") {
467503c085eSpeter klausler     return FoldSum<T>(context, std::move(funcRef));
46864ab3302SCarolineConcatto   } else if (name == "tiny") {
46964ab3302SCarolineConcatto     return Expr<T>{Scalar<T>::TINY()};
47068f55d78SShao-Ce SUN   } else if (name == "__builtin_fma") {
47168f55d78SShao-Ce SUN     CHECK(args.size() == 3);
472e619c07dSPeter Klausler   } else if (name == "__builtin_ieee_next_after") {
473e619c07dSPeter Klausler     if (const auto *yExpr{UnwrapExpr<Expr<SomeReal>>(args[1])}) {
474cd03e96fSPeter Klausler       return common::visit(
475e619c07dSPeter Klausler           [&](const auto &yVal) {
476e619c07dSPeter Klausler             using TY = ResultType<decltype(yVal)>;
477e619c07dSPeter Klausler             return FoldElementalIntrinsic<T, T, TY>(context, std::move(funcRef),
478e619c07dSPeter Klausler                 ScalarFunc<T, T, TY>([&](const Scalar<T> &x,
479e619c07dSPeter Klausler                                          const Scalar<TY> &y) -> Scalar<T> {
4801e1cf258SPeter Klausler                   auto xBig{Scalar<LargestReal>::Convert(x).value};
4811e1cf258SPeter Klausler                   auto yBig{Scalar<LargestReal>::Convert(y).value};
4821e1cf258SPeter Klausler                   switch (xBig.Compare(yBig)) {
483e619c07dSPeter Klausler                   case Relation::Unordered:
484505f6da1SPeter Klausler                     if (context.languageFeatures().ShouldWarn(
485505f6da1SPeter Klausler                             common::UsageWarning::FoldingValueChecks)) {
486e619c07dSPeter Klausler                       context.messages().Say(
4870f973ac7SPeter Klausler                           common::UsageWarning::FoldingValueChecks,
48890617e99SPeter Klausler                           "IEEE_NEXT_AFTER intrinsic folding: arguments are unordered"_warn_en_US);
489505f6da1SPeter Klausler                     }
49090617e99SPeter Klausler                     return x.NotANumber();
491e619c07dSPeter Klausler                   case Relation::Equal:
49290617e99SPeter Klausler                     break;
493e619c07dSPeter Klausler                   case Relation::Less:
4941e1cf258SPeter Klausler                     return x.NEAREST(true).value;
495e619c07dSPeter Klausler                   case Relation::Greater:
4961e1cf258SPeter Klausler                     return x.NEAREST(false).value;
497e619c07dSPeter Klausler                   }
49890617e99SPeter Klausler                   return x; // dodge bogus "missing return" GCC warning
499e619c07dSPeter Klausler                 }));
500e619c07dSPeter Klausler           },
501e619c07dSPeter Klausler           yExpr->u);
502e619c07dSPeter Klausler     }
503e619c07dSPeter Klausler   } else if (name == "__builtin_ieee_next_up" ||
504e619c07dSPeter Klausler       name == "__builtin_ieee_next_down") {
505e619c07dSPeter Klausler     bool upward{name == "__builtin_ieee_next_up"};
506e619c07dSPeter Klausler     const char *iName{upward ? "IEEE_NEXT_UP" : "IEEE_NEXT_DOWN"};
507e619c07dSPeter Klausler     return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
508e619c07dSPeter Klausler         ScalarFunc<T, T>([&](const Scalar<T> &x) -> Scalar<T> {
509e619c07dSPeter Klausler           auto result{x.NEAREST(upward)};
510505f6da1SPeter Klausler           if (context.languageFeatures().ShouldWarn(
511505f6da1SPeter Klausler                   common::UsageWarning::FoldingException)) {
51290617e99SPeter Klausler             if (result.flags.test(RealFlag::InvalidArgument)) {
5130f973ac7SPeter Klausler               context.messages().Say(common::UsageWarning::FoldingException,
51490617e99SPeter Klausler                   "%s intrinsic folding: argument is NaN"_warn_en_US, iName);
515e619c07dSPeter Klausler             }
516505f6da1SPeter Klausler           }
517e619c07dSPeter Klausler           return result.value;
518e619c07dSPeter Klausler         }));
51964ab3302SCarolineConcatto   }
52064ab3302SCarolineConcatto   return Expr<T>{std::move(funcRef)};
52164ab3302SCarolineConcatto }
52264ab3302SCarolineConcatto 
5235c5bde1bSPeter Klausler #ifdef _MSC_VER // disable bogus warning about missing definitions
5245c5bde1bSPeter Klausler #pragma warning(disable : 4661)
5255c5bde1bSPeter Klausler #endif
52664ab3302SCarolineConcatto FOR_EACH_REAL_KIND(template class ExpressionBase, )
52764ab3302SCarolineConcatto template class ExpressionBase<SomeReal>;
5281f879005STim Keith } // namespace Fortran::evaluate
529