[flang] Fold intrinsic functions SPACING() and RRSPACING()

[klausler]

Summary

The related real number system inquiry functions SPACING()
and RRSPACING() can be folded for constant arguments.
See 16.9.164 & 16.9.180 in Fortran 2018.

[PeteSteinfeld]

All builds and test correctly and looks good.

flang/include/flang/Evaluate/real.h

static constexpr Real TINY() {
     return tiny;
   }
 
   static constexpr int DIGITS{binaryPrecision};
   static constexpr int PRECISION{Details::decimalPrecision};
   static constexpr int RANGE{Details::decimalRange};
   static constexpr int MAXEXPONENT{maxExponent - exponentBias};
   static constexpr int MINEXPONENT{2 - exponentBias};
+  Real RRSPACING() const;
+  Real SPACING() const;
 
   // SCALE(); also known as IEEE_SCALB and (in IEEE-754 '08) ScaleB.
   template <typename INT>
   ValueWithRealFlags<Real> SCALE(
       const INT &by, Rounding rounding = defaultRounding) const {
     auto expo{exponentBias + by.ToInt64()};
     if (IsZero()) {
       expo = exponentBias; // ignore by, don't overflow

flang/lib/Evaluate/fold-real.cpp

return FoldMaxvalMinval<T>(
         context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
   } else if (name == "product") {
     auto one{Scalar<T>::FromInteger(value::Integer<8>{1}).value};
     return FoldProduct<T>(context, std::move(funcRef), one);
   } else if (name == "real" || name == "dble") {
     if (auto *expr{args[0].value().UnwrapExpr()}) {
       return ToReal<KIND>(context, std::move(*expr));
     }
+  } else if (name == "rrspacing") {
+    return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
+        ScalarFunc<T, T>(
+            [](const Scalar<T> &x) -> Scalar<T> { return x.RRSPACING(); }));
   } else if (name == "scale") {
     if (const auto *byExpr{UnwrapExpr<Expr<SomeInteger>>(args[1])}) {
       return common::visit(
           [&](const auto &byVal) {
             using TBY = ResultType<decltype(byVal)>;
             return FoldElementalIntrinsic<T, T, TBY>(context,
                 std::move(funcRef),
                 ScalarFunc<T, T, TBY>(
#endif
                       return result.value;
                     }));
           },
           byExpr->u);
     }
   } else if (name == "sign") {
     return FoldElementalIntrinsic<T, T, T>(
         context, std::move(funcRef), &Scalar<T>::SIGN);
+  } else if (name == "spacing") {
+    return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
+        ScalarFunc<T, T>(
+            [](const Scalar<T> &x) -> Scalar<T> { return x.SPACING(); }));
   } else if (name == "sqrt") {
     return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
         ScalarFunc<T, T>(
             [](const Scalar<T> &x) -> Scalar<T> { return x.SQRT().value; }));
   } else if (name == "sum") {
     return FoldSum<T>(context, std::move(funcRef));
   } else if (name == "tiny") {
     return Expr<T>{Scalar<T>::TINY()};
return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
           } else if (result.flags.test(RealFlag::InvalidArgument)) {
             context.messages().Say(
                 "%s intrinsic folding: bad argument"_warn_en_US, iName);
           }
           return result.value;
         }));
   }
   // TODO: dim, dot_product, fraction, matmul,
-  // modulo, norm2, rrspacing,
-  // set_exponent, spacing, transfer,
+  // modulo, norm2, set_exponent, transfer,
   return Expr<T>{std::move(funcRef)};
 }
 
 template <int KIND>
 Expr<Type<TypeCategory::Real, KIND>> FoldOperation(
     FoldingContext &context, ComplexComponent<KIND> &&x) {
   using Operand = Type<TypeCategory::Complex, KIND>;
   using Result = Type<TypeCategory::Real, KIND>;

flang/lib/Evaluate/real.cpp

if (IsNotANumber()) {
     if (expo != 0) {
       o << 'e' << expo;
     }
     o << '_' << kind;
   }
   return o;
 }
 
+// 16.9.180
+template <typename W, int P> Real<W, P> Real<W, P>::RRSPACING() const {
+  if (IsNotANumber()) {
+    return *this;
+  } else if (IsInfinite()) {
+    return NotANumber();
+  } else {
+    Real result;
+    result.Normalize(false, binaryPrecision + exponentBias - 1, GetFraction());
+    return result;
+  }
+}
+
+// 16.9.180
+template <typename W, int P> Real<W, P> Real<W, P>::SPACING() const {
+  if (IsNotANumber()) {
+    return *this;
+  } else if (IsInfinite()) {
+    return NotANumber();
+  } else if (IsZero()) {
+    return TINY();
+  } else {
+    Real result;
+    result.Normalize(
+        false, Exponent() - binaryPrecision + 1, Fraction::MASKL(1));
+    return result;
+  }
+}
+
 template class Real<Integer<16>, 11>;
 template class Real<Integer<16>, 8>;
 template class Real<Integer<32>, 24>;
 template class Real<Integer<64>, 53>;
 template class Real<Integer<80>, 64>;
 template class Real<Integer<128>, 113>;
 } // namespace Fortran::evaluate::value

flang/test/Evaluate/fold-spacing.f90

+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of SPACING() and RRSPACING
+module m
+  logical, parameter :: test_1 = spacing(3.0) == scale(1.0, -22)
+  logical, parameter :: test_2 = spacing(-3.0) == scale(1.0, -22)
+  logical, parameter :: test_3 = spacing(3.0d0) == scale(1.0, -51)
+  logical, parameter :: test_4 = spacing(0.) == tiny(0.)
+  logical, parameter :: test_11 = rrspacing(3.0) == scale(0.75, 24)
+  logical, parameter :: test_12 = rrspacing(-3.0) == scale(0.75, 24)
+  logical, parameter :: test_13 = rrspacing(3.0d0) == scale(0.75, 53)
+  logical, parameter :: test_14 = rrspacing(0.) == 0.
+end module