[flang-commits] [flang] 1cff71b - [flang] Fold intrinsic functions SPACING() and RRSPACING()

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-05-09T14:09:29-07:00
New Revision: 1cff71b975bf4138604775dd32126bb564704ec7

URL: https://github.com/llvm/llvm-project/commit/1cff71b975bf4138604775dd32126bb564704ec7
DIFF: https://github.com/llvm/llvm-project/commit/1cff71b975bf4138604775dd32126bb564704ec7.diff

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

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.

Differential Revision: https://reviews.llvm.org/D125100

Added: 
    flang/test/Evaluate/fold-spacing.f90

Modified: 
    flang/include/flang/Evaluate/real.h
    flang/lib/Evaluate/fold-real.cpp
    flang/lib/Evaluate/real.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h
index 2f4f7b2c47757..a590186fad138 100644
--- a/flang/include/flang/Evaluate/real.h
+++ b/flang/include/flang/Evaluate/real.h
@@ -160,6 +160,8 @@ class Real : public common::RealDetails<PREC> {
   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>

diff  --git a/flang/lib/Evaluate/fold-real.cpp b/flang/lib/Evaluate/fold-real.cpp
index e915c55760183..1175cc58b21d7 100644
--- a/flang/lib/Evaluate/fold-real.cpp
+++ b/flang/lib/Evaluate/fold-real.cpp
@@ -190,6 +190,10 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
     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(
@@ -218,6 +222,10 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
   } 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>(
@@ -277,8 +285,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
         }));
   }
   // TODO: dim, dot_product, fraction, matmul,
-  // modulo, norm2, rrspacing,
-  // set_exponent, spacing, transfer,
+  // modulo, norm2, set_exponent, transfer,
   return Expr<T>{std::move(funcRef)};
 }
 

diff  --git a/flang/lib/Evaluate/real.cpp b/flang/lib/Evaluate/real.cpp
index b8ce0ff8eae66..2b5e32a2542f1 100644
--- a/flang/lib/Evaluate/real.cpp
+++ b/flang/lib/Evaluate/real.cpp
@@ -686,6 +686,35 @@ llvm::raw_ostream &Real<W, P>::AsFortran(
   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>;

diff  --git a/flang/test/Evaluate/fold-spacing.f90 b/flang/test/Evaluate/fold-spacing.f90
new file mode 100644
index 0000000000000..d802f1770666e
--- /dev/null
+++ b/flang/test/Evaluate/fold-spacing.f90
@@ -0,0 +1,12 @@
+! 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