[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

flang/include/flang/Evaluate/call.h

@@ -218,6 +218,22 @@ public:
   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;
 

flang/include/flang/Evaluate/integer.h

@@ -358,6 +358,7 @@ public:
 
   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)};

flang/include/flang/Evaluate/shape.h

@@ -48,6 +48,8 @@ Constant<ExtentType> AsConstantShape(const ConstantSubscripts &);
 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 @@ MaybeExtentExpr CountTrips(
 
 // 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 &);

flang/include/flang/Evaluate/tools.h

@@ -644,6 +644,16 @@ std::optional<Expr<SomeType>> Negation(
 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) {

flang/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 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
         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 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
           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)};
 }

flang/lib/Evaluate/fold-implementation.h

@@ -600,6 +600,9 @@ template <typename T> Expr<T> Folder<T>::Reshape(FunctionRef<T> &&funcRef) {
 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 @@ Expr<T> FoldMINorMAX(
       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) {

flang/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 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
           },
           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 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
     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 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
   // 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)};
 }

flang/lib/Evaluate/fold-real.cpp

@@ -7,6 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "fold-implementation.h"
+#include "fold-reduction.h"
 
 namespace Fortran::evaluate {
 
@@ -109,10 +110,16 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
     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 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
     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)

flang/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_

flang/lib/Evaluate/shape.cpp

@@ -132,6 +132,22 @@ std::optional<ConstantSubscripts> AsConstantExtents(
   }
 }
 
+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 @@ MaybeExtentExpr GetSize(Shape &&shape) {
   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>;

flang/lib/Evaluate/tools.cpp

@@ -475,14 +475,6 @@ Expr<SomeLogical> LogicalNegation(Expr<SomeLogical> &&x) {
       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) {

flang/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"

flang/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