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