[flang] Fold MAXVAL & MINVAL
Implement constant folding for the reduction transformational
intrinsic functions MAXVAL and MINVAL.
In anticipation of more folding work to follow, with (I hope)
some common infrastructure, these two have been implemented in a
new header file.
Differential Revision: https://reviews.llvm.org/D104337
GitOrigin-RevId: 47f18af55fd59e813144cc76711806d57a160e50
diff --git a/include/flang/Evaluate/call.h b/include/flang/Evaluate/call.h
index e74e82d..7cf509c 100644
--- a/include/flang/Evaluate/call.h
+++ b/include/flang/Evaluate/call.h
@@ -218,6 +218,22 @@
int Rank() const;
bool IsElemental() const { return proc_.IsElemental(); }
bool hasAlternateReturns() const { return hasAlternateReturns_; }
+
+ Expr<SomeType> *UnwrapArgExpr(int n) {
+ if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) {
+ return arguments_[n]->UnwrapExpr();
+ } else {
+ return nullptr;
+ }
+ }
+ const Expr<SomeType> *UnwrapArgExpr(int n) const {
+ if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) {
+ return arguments_[n]->UnwrapExpr();
+ } else {
+ return nullptr;
+ }
+ }
+
bool operator==(const ProcedureRef &) const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
diff --git a/include/flang/Evaluate/integer.h b/include/flang/Evaluate/integer.h
index 35b4223..6a129bf 100644
--- a/include/flang/Evaluate/integer.h
+++ b/include/flang/Evaluate/integer.h
@@ -358,6 +358,7 @@
static constexpr int DIGITS{bits - 1}; // don't count the sign bit
static constexpr Integer HUGE() { return MASKR(bits - 1); }
+ static constexpr Integer Least() { return MASKL(1); }
static constexpr int RANGE{// in the sense of SELECTED_INT_KIND
// This magic value is LOG10(2.)*1E12.
static_cast<int>(((bits - 1) * 301029995664) / 1000000000000)};
diff --git a/include/flang/Evaluate/shape.h b/include/flang/Evaluate/shape.h
index 5df3eef..4f5a06c 100644
--- a/include/flang/Evaluate/shape.h
+++ b/include/flang/Evaluate/shape.h
@@ -48,6 +48,8 @@
ConstantSubscripts AsConstantExtents(const Constant<ExtentType> &);
std::optional<ConstantSubscripts> AsConstantExtents(
FoldingContext &, const Shape &);
+Shape AsShape(const ConstantSubscripts &);
+std::optional<Shape> AsShape(const std::optional<ConstantSubscripts> &);
inline int GetRank(const Shape &s) { return static_cast<int>(s.size()); }
@@ -89,6 +91,7 @@
// Computes SIZE() == PRODUCT(shape)
MaybeExtentExpr GetSize(Shape &&);
+ConstantSubscript GetSize(const ConstantSubscripts &);
// Utility predicate: does an expression reference any implied DO index?
bool ContainsAnyImpliedDoIndex(const ExtentExpr &);
diff --git a/include/flang/Evaluate/tools.h b/include/flang/Evaluate/tools.h
index 6adfe04..257fb05 100644
--- a/include/flang/Evaluate/tools.h
+++ b/include/flang/Evaluate/tools.h
@@ -644,6 +644,16 @@
std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &,
RelationalOperator, Expr<SomeType> &&, Expr<SomeType> &&);
+// Create a relational operation between two identically-typed operands
+// and wrap it up in an Expr<LogicalResult>.
+template <typename T>
+Expr<LogicalResult> PackageRelation(
+ RelationalOperator opr, Expr<T> &&x, Expr<T> &&y) {
+ static_assert(IsSpecificIntrinsicType<T>);
+ return Expr<LogicalResult>{
+ Relational<SomeType>{Relational<T>{opr, std::move(x), std::move(y)}}};
+}
+
template <int K>
Expr<Type<TypeCategory::Logical, K>> LogicalNegation(
Expr<Type<TypeCategory::Logical, K>> &&x) {
diff --git a/lib/Evaluate/fold-character.cpp b/lib/Evaluate/fold-character.cpp
index 1eac582..a73ed52 100644
--- a/lib/Evaluate/fold-character.cpp
+++ b/lib/Evaluate/fold-character.cpp
@@ -7,14 +7,49 @@
//===----------------------------------------------------------------------===//
#include "fold-implementation.h"
+#include "fold-reduction.h"
namespace Fortran::evaluate {
+static std::optional<ConstantSubscript> GetConstantLength(
+ FoldingContext &context, Expr<SomeType> &&expr) {
+ expr = Fold(context, std::move(expr));
+ if (auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(expr)}) {
+ if (auto len{chExpr->LEN()}) {
+ return ToInt64(*len);
+ }
+ }
+ return std::nullopt;
+}
+
+template <typename T>
+static std::optional<ConstantSubscript> GetConstantLength(
+ FoldingContext &context, FunctionRef<T> &funcRef, int zeroBasedArg) {
+ if (auto *expr{funcRef.UnwrapArgExpr(zeroBasedArg)}) {
+ return GetConstantLength(context, std::move(*expr));
+ } else {
+ return std::nullopt;
+ }
+}
+
+template <typename T>
+static std::optional<Scalar<T>> Identity(
+ Scalar<T> str, std::optional<ConstantSubscript> len) {
+ if (len) {
+ return CharacterUtils<T::kind>::REPEAT(
+ str, std::max<ConstantSubscript>(*len, 0));
+ } else {
+ return std::nullopt;
+ }
+}
+
template <int KIND>
Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
FoldingContext &context,
FunctionRef<Type<TypeCategory::Character, KIND>> &&funcRef) {
using T = Type<TypeCategory::Character, KIND>;
+ using StringType = Scalar<T>; // std::string or larger
+ using SingleCharType = typename StringType::value_type; // char &c.
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
CHECK(intrinsic);
std::string name{intrinsic->name};
@@ -32,10 +67,24 @@
context, std::move(funcRef), CharacterUtils<KIND>::ADJUSTR);
} else if (name == "max") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
+ } else if (name == "maxval") {
+ SingleCharType least{0};
+ if (auto identity{Identity<T>(
+ StringType{least}, GetConstantLength(context, funcRef, 0))}) {
+ return FoldMaxvalMinval<T>(
+ context, std::move(funcRef), RelationalOperator::GT, *identity);
+ }
} else if (name == "merge") {
return FoldMerge<T>(context, std::move(funcRef));
} else if (name == "min") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
+ } else if (name == "minval") {
+ auto most{std::numeric_limits<SingleCharType>::max()};
+ if (auto identity{Identity<T>(
+ StringType{most}, GetConstantLength(context, funcRef, 0))}) {
+ return FoldMaxvalMinval<T>(
+ context, std::move(funcRef), RelationalOperator::LT, *identity);
+ }
} else if (name == "new_line") {
return Expr<T>{Constant<T>{CharacterUtils<KIND>::NEW_LINE()}};
} else if (name == "repeat") { // not elemental
@@ -52,7 +101,7 @@
CharacterUtils<KIND>::TRIM(std::get<Scalar<T>>(*scalar))}};
}
}
- // TODO: cshift, eoshift, maxval, minval, pack, reduce,
+ // TODO: cshift, eoshift, maxloc, minloc, pack, reduce,
// spread, transfer, transpose, unpack
return Expr<T>{std::move(funcRef)};
}
diff --git a/lib/Evaluate/fold-implementation.h b/lib/Evaluate/fold-implementation.h
index 4dadebd..aeb9553 100644
--- a/lib/Evaluate/fold-implementation.h
+++ b/lib/Evaluate/fold-implementation.h
@@ -600,6 +600,9 @@
template <typename T>
Expr<T> FoldMINorMAX(
FoldingContext &context, FunctionRef<T> &&funcRef, Ordering order) {
+ static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Real ||
+ T::category == TypeCategory::Character);
std::vector<Constant<T> *> constantArgs;
// Call Folding on all arguments, even if some are not constant,
// to make operand promotion explicit.
@@ -608,8 +611,9 @@
constantArgs.push_back(cst);
}
}
- if (constantArgs.size() != funcRef.arguments().size())
+ if (constantArgs.size() != funcRef.arguments().size()) {
return Expr<T>(std::move(funcRef));
+ }
CHECK(constantArgs.size() > 0);
Expr<T> result{std::move(*constantArgs[0])};
for (std::size_t i{1}; i < constantArgs.size(); ++i) {
diff --git a/lib/Evaluate/fold-integer.cpp b/lib/Evaluate/fold-integer.cpp
index fbbbbf4..19b9f92 100644
--- a/lib/Evaluate/fold-integer.cpp
+++ b/lib/Evaluate/fold-integer.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "fold-implementation.h"
+#include "fold-reduction.h"
#include "flang/Evaluate/check-expression.h"
namespace Fortran::evaluate {
@@ -474,6 +475,9 @@
},
sx->u);
}
+ } else if (name == "maxval") {
+ return FoldMaxvalMinval<T>(context, std::move(funcRef),
+ RelationalOperator::GT, T::Scalar::Least());
} else if (name == "merge") {
return FoldMerge<T>(context, std::move(funcRef));
} else if (name == "merge_bits") {
@@ -492,6 +496,9 @@
return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
} else if (name == "min0" || name == "min1") {
return RewriteSpecificMINorMAX(context, std::move(funcRef));
+ } else if (name == "minval") {
+ return FoldMaxvalMinval<T>(
+ context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
} else if (name == "mod") {
return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
ScalarFuncWithContext<T, T, T>(
@@ -650,8 +657,7 @@
// TODO:
// cshift, dot_product, eoshift,
// findloc, iall, iany, iparity, ibits, image_status, ishftc,
- // matmul, maxloc, maxval,
- // minloc, minval, not, pack, product, reduce,
+ // matmul, maxloc, minloc, not, pack, product, reduce,
// sign, spread, sum, transfer, transpose, unpack
return Expr<T>{std::move(funcRef)};
}
diff --git a/lib/Evaluate/fold-real.cpp b/lib/Evaluate/fold-real.cpp
index d1c75e4..8822268 100644
--- a/lib/Evaluate/fold-real.cpp
+++ b/lib/Evaluate/fold-real.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "fold-implementation.h"
+#include "fold-reduction.h"
namespace Fortran::evaluate {
@@ -109,10 +110,16 @@
return Expr<T>{Scalar<T>::HUGE()};
} else if (name == "max") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
+ } else if (name == "maxval") {
+ return FoldMaxvalMinval<T>(context, std::move(funcRef),
+ RelationalOperator::GT, T::Scalar::HUGE().Negate());
} else if (name == "merge") {
return FoldMerge<T>(context, std::move(funcRef));
} else if (name == "min") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
+ } else if (name == "minval") {
+ return FoldMaxvalMinval<T>(
+ context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
} else if (name == "real") {
if (auto *expr{args[0].value().UnwrapExpr()}) {
return ToReal<KIND>(context, std::move(*expr));
@@ -124,7 +131,7 @@
return Expr<T>{Scalar<T>::TINY()};
}
// TODO: cshift, dim, dot_product, eoshift, fraction, matmul,
- // maxval, minval, modulo, nearest, norm2, pack, product,
+ // maxloc, minloc, modulo, nearest, norm2, pack, product,
// reduce, rrspacing, scale, set_exponent, spacing, spread,
// sum, transfer, transpose, unpack, bessel_jn (transformational) and
// bessel_yn (transformational)
diff --git a/lib/Evaluate/fold-reduction.h b/lib/Evaluate/fold-reduction.h
new file mode 100644
index 0000000..1c7473a
--- /dev/null
+++ b/lib/Evaluate/fold-reduction.h
@@ -0,0 +1,138 @@
+//===-- lib/Evaluate/fold-reduction.h -------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// TODO: ALL, ANY, COUNT, DOT_PRODUCT, FINDLOC, IALL, IANY, IPARITY,
+// NORM2, MAXLOC, MINLOC, PARITY, PRODUCT, SUM
+
+#ifndef FORTRAN_EVALUATE_FOLD_REDUCTION_H_
+#define FORTRAN_EVALUATE_FOLD_REDUCTION_H_
+
+#include "fold-implementation.h"
+
+namespace Fortran::evaluate {
+
+// MAXVAL & MINVAL
+template <typename T>
+Expr<T> FoldMaxvalMinval(FoldingContext &context, FunctionRef<T> &&ref,
+ RelationalOperator opr, Scalar<T> identity) {
+ static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Real ||
+ T::category == TypeCategory::Character);
+ using Element = typename Constant<T>::Element;
+ auto &arg{ref.arguments()};
+ CHECK(arg.size() <= 3);
+ if (arg.empty()) {
+ return Expr<T>{std::move(ref)};
+ }
+ Constant<T> *array{Folder<T>{context}.Folding(arg[0])};
+ if (!array || array->Rank() < 1) {
+ return Expr<T>{std::move(ref)};
+ }
+ std::optional<ConstantSubscript> dim;
+ if (arg.size() >= 2 && arg[1]) {
+ if (auto *dimConst{Folder<SubscriptInteger>{context}.Folding(arg[1])}) {
+ if (auto dimScalar{dimConst->GetScalarValue()}) {
+ dim.emplace(dimScalar->ToInt64());
+ if (*dim < 1 || *dim > array->Rank()) {
+ context.messages().Say(
+ "DIM=%jd is not valid for an array of rank %d"_err_en_US,
+ static_cast<std::intmax_t>(*dim), array->Rank());
+ dim.reset();
+ }
+ }
+ }
+ if (!dim) {
+ return Expr<T>{std::move(ref)};
+ }
+ }
+ Constant<LogicalResult> *mask{};
+ if (arg.size() >= 3 && arg[2]) {
+ mask = Folder<LogicalResult>{context}.Folding(arg[2]);
+ if (!mask) {
+ return Expr<T>{std::move(ref)};
+ }
+ if (!CheckConformance(context.messages(), AsShape(array->shape()),
+ AsShape(mask->shape()),
+ CheckConformanceFlags::RightScalarExpandable, "ARRAY=", "MASK=")
+ .value_or(false)) {
+ return Expr<T>{std::move(ref)};
+ }
+ }
+ // Do it
+ ConstantSubscripts at{array->lbounds()}, maskAt;
+ bool maskAllFalse{false};
+ if (mask) {
+ if (auto scalar{mask->GetScalarValue()}) {
+ if (scalar->IsTrue()) {
+ mask = nullptr; // all .TRUE.
+ } else {
+ maskAllFalse = true;
+ }
+ } else {
+ maskAt = mask->lbounds();
+ }
+ }
+ std::vector<Element> result;
+ ConstantSubscripts resultShape; // empty -> scalar
+ // Internal function to accumulate into result.back().
+ auto Accumulate{[&]() {
+ if (!maskAllFalse && (maskAt.empty() || mask->At(maskAt).IsTrue())) {
+ Expr<LogicalResult> test{
+ PackageRelation(opr, Expr<T>{Constant<T>{array->At(at)}},
+ Expr<T>{Constant<T>{result.back()}})};
+ auto folded{GetScalarConstantValue<LogicalResult>(
+ test.Rewrite(context, std::move(test)))};
+ CHECK(folded.has_value());
+ if (folded->IsTrue()) {
+ result.back() = array->At(at);
+ }
+ }
+ }};
+ if (dim) { // DIM= is present, so result is an array
+ resultShape = array->shape();
+ resultShape.erase(resultShape.begin() + (*dim - 1));
+ ConstantSubscript dimExtent{array->shape().at(*dim - 1)};
+ ConstantSubscript &dimAt{at[*dim - 1]};
+ ConstantSubscript dimLbound{dimAt};
+ ConstantSubscript *maskDimAt{maskAt.empty() ? nullptr : &maskAt[*dim - 1]};
+ ConstantSubscript maskLbound{maskDimAt ? *maskDimAt : 0};
+ for (auto n{GetSize(resultShape)}; n-- > 0;
+ IncrementSubscripts(at, array->shape())) {
+ dimAt = dimLbound;
+ if (maskDimAt) {
+ *maskDimAt = maskLbound;
+ }
+ result.push_back(identity);
+ for (ConstantSubscript j{0}; j < dimExtent;
+ ++j, ++dimAt, maskDimAt && ++*maskDimAt) {
+ Accumulate();
+ }
+ if (maskDimAt) {
+ IncrementSubscripts(maskAt, mask->shape());
+ }
+ }
+ } else { // no DIM=, result is scalar
+ result.push_back(identity);
+ for (auto n{array->size()}; n-- > 0;
+ IncrementSubscripts(at, array->shape())) {
+ Accumulate();
+ if (!maskAt.empty()) {
+ IncrementSubscripts(maskAt, mask->shape());
+ }
+ }
+ }
+ if constexpr (T::category == TypeCategory::Character) {
+ return Expr<T>{Constant<T>{static_cast<ConstantSubscript>(identity.size()),
+ std::move(result), std::move(resultShape)}};
+ } else {
+ return Expr<T>{Constant<T>{std::move(result), std::move(resultShape)}};
+ }
+}
+
+} // namespace Fortran::evaluate
+#endif // FORTRAN_EVALUATE_FOLD_REDUCTION_H_
diff --git a/lib/Evaluate/shape.cpp b/lib/Evaluate/shape.cpp
index fc7dd6d..a1b4813 100644
--- a/lib/Evaluate/shape.cpp
+++ b/lib/Evaluate/shape.cpp
@@ -132,6 +132,22 @@
}
}
+Shape AsShape(const ConstantSubscripts &shape) {
+ Shape result;
+ for (const auto &extent : shape) {
+ result.emplace_back(ExtentExpr{extent});
+ }
+ return result;
+}
+
+std::optional<Shape> AsShape(const std::optional<ConstantSubscripts> &shape) {
+ if (shape) {
+ return AsShape(*shape);
+ } else {
+ return std::nullopt;
+ }
+}
+
Shape Fold(FoldingContext &context, Shape &&shape) {
for (auto &dim : shape) {
dim = Fold(context, std::move(dim));
@@ -190,6 +206,14 @@
return extent;
}
+ConstantSubscript GetSize(const ConstantSubscripts &shape) {
+ ConstantSubscript size{1};
+ for (auto dim : std::move(shape)) {
+ size *= dim;
+ }
+ return size;
+}
+
bool ContainsAnyImpliedDoIndex(const ExtentExpr &expr) {
struct MyVisitor : public AnyTraverse<MyVisitor> {
using Base = AnyTraverse<MyVisitor>;
diff --git a/lib/Evaluate/tools.cpp b/lib/Evaluate/tools.cpp
index f233ade..7b21893 100644
--- a/lib/Evaluate/tools.cpp
+++ b/lib/Evaluate/tools.cpp
@@ -475,14 +475,6 @@
std::move(x.u));
}
-template <typename T>
-Expr<LogicalResult> PackageRelation(
- RelationalOperator opr, Expr<T> &&x, Expr<T> &&y) {
- static_assert(IsSpecificIntrinsicType<T>);
- return Expr<LogicalResult>{
- Relational<SomeType>{Relational<T>{opr, std::move(x), std::move(y)}}};
-}
-
template <TypeCategory CAT>
Expr<LogicalResult> PromoteAndRelate(
RelationalOperator opr, Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
diff --git a/runtime/reduction.cpp b/runtime/reduction.cpp
index cf9515b..73fcfa8 100644
--- a/runtime/reduction.cpp
+++ b/runtime/reduction.cpp
@@ -9,8 +9,11 @@
// Implements ALL, ANY, COUNT, IPARITY, & PARITY for all required operand
// types and shapes.
//
-// DOT_PRODUCT, FINDLOC, SUM, and PRODUCT are in their own eponymous source
-// files; NORM2, MAXLOC, MINLOC, MAXVAL, and MINVAL are in extrema.cpp.
+// DOT_PRODUCT, FINDLOC, MATMUL, SUM, and PRODUCT are in their own eponymous
+// source files.
+// NORM2, MAXLOC, MINLOC, MAXVAL, and MINVAL are in extrema.cpp.
+//
+// TODO: IALL, IANY
#include "reduction.h"
#include "reduction-templates.h"
diff --git a/test/Evaluate/folding20.f90 b/test/Evaluate/folding20.f90
new file mode 100644
index 0000000..f84e033
--- /dev/null
+++ b/test/Evaluate/folding20.f90
@@ -0,0 +1,26 @@
+! RUN: %S/test_folding.sh %s %t %flang_fc1
+! Tests intrinsic MAXVAL/MINVAL function folding
+module m
+ logical, parameter :: test_imaxidentity = maxval([integer::]) == -huge(0) - 1
+ logical, parameter :: test_iminidentity = minval([integer::]) == huge(0)
+ integer, parameter :: intmatrix(*,*) = reshape([1, 2, 3, 4, 5, 6], [2, 3])
+ logical, parameter :: test_imaxval = maxval(intmatrix) == 6
+ logical, parameter :: test_iminval = minval(intmatrix) == 1
+ logical, parameter :: odds(2,3) = mod(intmatrix, 2) == 1
+ logical, parameter :: test_imaxval_masked = maxval(intmatrix,odds) == 5
+ logical, parameter :: test_iminval_masked = minval(intmatrix,.not.odds) == 2
+ logical, parameter :: test_rmaxidentity = maxval([real::]) == -huge(0.0)
+ logical, parameter :: test_rminidentity = minval([real::]) == huge(0.0)
+ logical, parameter :: test_rmaxval = maxval(real(intmatrix)) == 6.0
+ logical, parameter :: test_rminval = minval(real(intmatrix)) == 1.0
+ logical, parameter :: test_rmaxval_scalar_mask = maxval(real(intmatrix), .true.) == 6.0
+ logical, parameter :: test_rminval_scalar_mask = minval(real(intmatrix), .false.) == huge(0.0)
+ character(*), parameter :: chmatrix(*,*) = reshape(['abc', 'def', 'ghi', 'jkl', 'mno', 'pqr'], [2, 3])
+ logical, parameter :: test_cmaxlen = len(maxval([character*4::])) == 4
+ logical, parameter :: test_cmaxidentity = maxval([character*4::]) == repeat(char(0), 4)
+ logical, parameter :: test_cminidentity = minval([character*4::]) == repeat(char(127), 4)
+ logical, parameter :: test_cmaxval = maxval(chmatrix) == 'pqr'
+ logical, parameter :: test_cminval = minval(chmatrix) == 'abc'
+ logical, parameter :: test_dim1 = all(maxval(intmatrix,dim=1) == [2, 4, 6])
+ logical, parameter :: test_dim2 = all(minval(intmatrix,dim=2,mask=odds) == [1, huge(0)])
+end
