[flang-commits] [flang] [flang] Lower REDUCE intrinsic with no DIM argument and rank 1 (PR #94652)

Valentin Clement バレンタイン クレメン via flang-commits flang-commits at lists.llvm.org
Mon Jun 10 11:01:23 PDT 2024


https://github.com/clementval updated https://github.com/llvm/llvm-project/pull/94652

>From 5718e0483b5fe5204905cdbfff8a0175d85fc869 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Tue, 4 Jun 2024 07:55:25 -0700
Subject: [PATCH 1/8] [flang] Lower REDUCE intrinsic for scalar result

---
 .../Optimizer/Builder/Runtime/RTBuilder.h     | 182 ++++++++-
 .../Optimizer/Builder/Runtime/Reduction.h     |   8 +
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp |  63 ++-
 .../Optimizer/Builder/Runtime/Reduction.cpp   | 178 ++++++++
 flang/test/Lower/Intrinsics/Todo/reduce.f90   |  13 -
 flang/test/Lower/Intrinsics/reduce.f90        | 379 ++++++++++++++++++
 6 files changed, 803 insertions(+), 20 deletions(-)
 delete mode 100644 flang/test/Lower/Intrinsics/Todo/reduce.f90
 create mode 100644 flang/test/Lower/Intrinsics/reduce.f90

diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index 575746374fcc4..1367e6147f9f9 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -22,6 +22,7 @@
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
+#include "flang/Runtime/reduce.h"
 #include "mlir/IR/BuiltinTypes.h"
 #include "mlir/IR/MLIRContext.h"
 #include "llvm/ADT/SmallVector.h"
@@ -52,6 +53,34 @@ namespace fir::runtime {
 using TypeBuilderFunc = mlir::Type (*)(mlir::MLIRContext *);
 using FuncTypeBuilderFunc = mlir::FunctionType (*)(mlir::MLIRContext *);
 
+#define REDUCTION_OPERATION_MODEL(T)                                           \
+  template <>                                                                  \
+  constexpr TypeBuilderFunc                                                    \
+  getModel<Fortran::runtime::ReductionOperation<T>>() {                        \
+    return [](mlir::MLIRContext *context) -> mlir::Type {                      \
+      TypeBuilderFunc f{getModel<T>()};                                        \
+      auto refTy = fir::ReferenceType::get(f(context));                        \
+      return mlir::FunctionType::get(context, {refTy, refTy}, refTy);          \
+    };                                                                         \
+  }
+
+#define REDUCTION_CHAR_OPERATION_MODEL(T)                                      \
+  template <>                                                                  \
+  constexpr TypeBuilderFunc                                                    \
+  getModel<Fortran::runtime::ReductionCharOperation<T>>() {                    \
+    return [](mlir::MLIRContext *context) -> mlir::Type {                      \
+      TypeBuilderFunc f{getModel<T>()};                                        \
+      auto voidTy = fir::LLVMPointerType::get(                                 \
+          context, mlir::IntegerType::get(context, 8));                        \
+      auto size_tTy =                                                          \
+          mlir::IntegerType::get(context, 8 * sizeof(std::size_t));            \
+      auto refTy = fir::ReferenceType::get(f(context));                        \
+      return mlir::FunctionType::get(                                          \
+          context, {refTy, size_tTy, refTy, refTy, size_tTy, size_tTy},        \
+          voidTy);                                                             \
+    };                                                                         \
+  }
+
 //===----------------------------------------------------------------------===//
 // Type builder models
 //===----------------------------------------------------------------------===//
@@ -75,7 +104,6 @@ constexpr TypeBuilderFunc getModel<unsigned int>() {
     return mlir::IntegerType::get(context, 8 * sizeof(unsigned int));
   };
 }
-
 template <>
 constexpr TypeBuilderFunc getModel<short int>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
@@ -83,6 +111,17 @@ constexpr TypeBuilderFunc getModel<short int>() {
   };
 }
 template <>
+constexpr TypeBuilderFunc getModel<short int *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<short int>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const short int *>() {
+  return getModel<short int *>();
+}
+template <>
 constexpr TypeBuilderFunc getModel<int>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return mlir::IntegerType::get(context, 8 * sizeof(int));
@@ -96,6 +135,17 @@ constexpr TypeBuilderFunc getModel<int &>() {
   };
 }
 template <>
+constexpr TypeBuilderFunc getModel<int *>() {
+  return getModel<int &>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const int *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<int>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
 constexpr TypeBuilderFunc getModel<char *>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return fir::ReferenceType::get(mlir::IntegerType::get(context, 8));
@@ -130,6 +180,43 @@ constexpr TypeBuilderFunc getModel<signed char>() {
   };
 }
 template <>
+constexpr TypeBuilderFunc getModel<signed char *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<signed char>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const signed char *>() {
+  return getModel<signed char *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<char16_t>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(char16_t));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<char16_t *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<char16_t>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<char32_t>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(char32_t));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<char32_t *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<char32_t>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
 constexpr TypeBuilderFunc getModel<unsigned char>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return mlir::IntegerType::get(context, 8 * sizeof(unsigned char));
@@ -175,6 +262,10 @@ constexpr TypeBuilderFunc getModel<long *>() {
   return getModel<long &>();
 }
 template <>
+constexpr TypeBuilderFunc getModel<const long *>() {
+  return getModel<long *>();
+}
+template <>
 constexpr TypeBuilderFunc getModel<long long>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return mlir::IntegerType::get(context, 8 * sizeof(long long));
@@ -198,6 +289,7 @@ template <>
 constexpr TypeBuilderFunc getModel<long long *>() {
   return getModel<long long &>();
 }
+
 template <>
 constexpr TypeBuilderFunc getModel<unsigned long>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
@@ -228,6 +320,27 @@ constexpr TypeBuilderFunc getModel<double *>() {
   return getModel<double &>();
 }
 template <>
+constexpr TypeBuilderFunc getModel<const double *>() {
+  return getModel<double *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<long double>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::FloatType::getF80(context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<long double *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<long double>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const long double *>() {
+  return getModel<long double *>();
+}
+template <>
 constexpr TypeBuilderFunc getModel<float>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return mlir::FloatType::getF32(context);
@@ -245,6 +358,10 @@ constexpr TypeBuilderFunc getModel<float *>() {
   return getModel<float &>();
 }
 template <>
+constexpr TypeBuilderFunc getModel<const float *>() {
+  return getModel<float *>();
+}
+template <>
 constexpr TypeBuilderFunc getModel<bool>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return mlir::IntegerType::get(context, 1);
@@ -258,20 +375,48 @@ constexpr TypeBuilderFunc getModel<bool &>() {
   };
 }
 template <>
+constexpr TypeBuilderFunc getModel<std::complex<float>>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::ComplexType::get(mlir::FloatType::getF32(context));
+  };
+}
+template <>
 constexpr TypeBuilderFunc getModel<std::complex<float> &>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
-    auto ty = mlir::ComplexType::get(mlir::FloatType::getF32(context));
-    return fir::ReferenceType::get(ty);
+    TypeBuilderFunc f{getModel<std::complex<float>>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<std::complex<float> *>() {
+  return getModel<std::complex<float> &>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const std::complex<float> *>() {
+  return getModel<std::complex<float> *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<std::complex<double>>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::ComplexType::get(mlir::FloatType::getF64(context));
   };
 }
 template <>
 constexpr TypeBuilderFunc getModel<std::complex<double> &>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
-    auto ty = mlir::ComplexType::get(mlir::FloatType::getF64(context));
-    return fir::ReferenceType::get(ty);
+    TypeBuilderFunc f{getModel<std::complex<double>>()};
+    return fir::ReferenceType::get(f(context));
   };
 }
 template <>
+constexpr TypeBuilderFunc getModel<std::complex<double> *>() {
+  return getModel<std::complex<double> &>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const std::complex<double> *>() {
+  return getModel<std::complex<double> *>();
+}
+template <>
 constexpr TypeBuilderFunc getModel<c_float_complex_t>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return fir::ComplexType::get(context, sizeof(float));
@@ -332,6 +477,33 @@ constexpr TypeBuilderFunc getModel<void>() {
   };
 }
 
+REDUCTION_OPERATION_MODEL(std::int8_t)
+REDUCTION_OPERATION_MODEL(std::int16_t)
+REDUCTION_OPERATION_MODEL(std::int32_t)
+REDUCTION_OPERATION_MODEL(std::int64_t)
+REDUCTION_OPERATION_MODEL(Fortran::common::int128_t)
+
+REDUCTION_OPERATION_MODEL(float)
+REDUCTION_OPERATION_MODEL(double)
+REDUCTION_OPERATION_MODEL(long double)
+
+REDUCTION_OPERATION_MODEL(std::complex<float>)
+REDUCTION_OPERATION_MODEL(std::complex<double>)
+
+REDUCTION_CHAR_OPERATION_MODEL(char)
+REDUCTION_CHAR_OPERATION_MODEL(char16_t)
+REDUCTION_CHAR_OPERATION_MODEL(char32_t)
+
+template <>
+constexpr TypeBuilderFunc
+getModel<Fortran::runtime::ReductionDerivedTypeOperation>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    auto voidTy =
+        fir::LLVMPointerType::get(context, mlir::IntegerType::get(context, 8));
+    return mlir::FunctionType::get(context, {voidTy, voidTy, voidTy}, voidTy);
+  };
+}
+
 template <typename...>
 struct RuntimeTableKey;
 template <typename RT, typename... ATs>
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h b/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
index 667ea9081a893..a4adaa72fa41a 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
@@ -224,6 +224,14 @@ void genIParityDim(fir::FirOpBuilder &builder, mlir::Location loc,
                    mlir::Value resultBox, mlir::Value arrayBox, mlir::Value dim,
                    mlir::Value maskBox);
 
+/// Generate call to `Reduce` intrinsic runtime routine. This is the version
+/// that does not take a dim argument.
+mlir::Value genReduce(fir::FirOpBuilder &builder, mlir::Location loc,
+                      mlir::Value arrayBox, mlir::Value operation,
+                      mlir::Value dim, mlir::Value maskBox,
+                      mlir::Value identity, mlir::Value ordered,
+                      mlir::Value resultBox);
+
 } // namespace fir::runtime
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_REDUCTION_H
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 1cd3976d0afbe..b1d0be6a3ec4c 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -522,7 +522,7 @@ static constexpr IntrinsicHandler handlers[]{
        {"operation", asAddr},
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional},
-       {"identity", asValue},
+       {"identity", asAddr},
        {"ordered", asValue}}},
      /*isElemental=*/false},
     {"repeat",
@@ -5705,7 +5705,66 @@ void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
 fir::ExtendedValue
 IntrinsicLibrary::genReduce(mlir::Type resultType,
                             llvm::ArrayRef<fir::ExtendedValue> args) {
-  TODO(loc, "intrinsic: reduce");
+  assert(args.size() == 6);
+
+  fir::BoxValue arrayTmp = builder.createBox(loc, args[0]);
+  mlir::Value array = fir::getBase(arrayTmp);
+  mlir::Value operation = fir::getBase(args[1]);
+  int rank = arrayTmp.rank();
+  assert(rank >= 1);
+
+  mlir::Type ty = array.getType();
+  mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
+  mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrTy).getEleTy();
+
+  // Handle optional mask argument
+  auto dim = isStaticallyAbsent(args[3])
+                 ? builder.createIntegerConstant(loc, builder.getI32Type(), 1)
+                 : fir::getBase(args[2]);
+
+  auto mask = isStaticallyAbsent(args[3])
+                  ? builder.create<fir::AbsentOp>(
+                        loc, fir::BoxType::get(builder.getI1Type()))
+                  : builder.createBox(loc, args[3]);
+
+  mlir::Value identity =
+      isStaticallyAbsent(args[4])
+          ? builder.create<fir::AbsentOp>(loc, fir::ReferenceType::get(eleTy))
+          : fir::getBase(args[4]);
+
+  mlir::Value ordered = isStaticallyAbsent(args[5])
+                            ? builder.createBool(loc, true)
+                            : fir::getBase(args[5]);
+
+  // We call the type specific versions because the result is scalar
+  // in the case below.
+  if (rank == 1) {
+    if (fir::isa_complex(eleTy) || fir::isa_derived(eleTy)) {
+      mlir::Value result = builder.createTemporary(loc, eleTy);
+      fir::runtime::genReduce(builder, loc, array, operation, dim, mask,
+                              identity, ordered, result);
+      if (fir::isa_derived(eleTy))
+        return result;
+      return builder.create<fir::LoadOp>(loc, result);
+    }
+    if (fir::isa_char(eleTy)) {
+      // Create mutable fir.box to be passed to the runtime for the result.
+      fir::MutableBoxValue resultMutableBox =
+          fir::factory::createTempMutableBox(builder, loc, eleTy);
+      mlir::Value resultIrBox =
+          fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
+      fir::runtime::genReduce(builder, loc, array, operation, dim, mask,
+                              identity, ordered, resultIrBox);
+      // Handle cleanup of allocatable result descriptor and return
+      return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE");
+    }
+    auto resultBox = builder.create<fir::AbsentOp>(
+        loc, fir::BoxType::get(builder.getI1Type()));
+    return fir::runtime::genReduce(builder, loc, array, operation, dim, mask,
+                                   identity, ordered, resultBox);
+  }
+
+  TODO(loc, "intrinsic: reduce with non scalar result");
 }
 
 // REPEAT
diff --git a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
index d4076067bf103..0c1af6159c939 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
@@ -12,6 +12,7 @@
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Optimizer/Support/Utils.h"
+#include "flang/Runtime/reduce.h"
 #include "flang/Runtime/reduction.h"
 #include "mlir/Dialect/Func/IR/FuncOps.h"
 
@@ -466,6 +467,85 @@ struct ForcedIParity16 {
   }
 };
 
+/// Placeholder for real*16 version of Reduce Intrinsic
+struct ForcedReduceReal16 {
+  static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ReduceReal16));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto ty = mlir::FloatType::getF128(ctx);
+      auto boxTy =
+          fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+      auto opTy = mlir::FunctionType::get(ctx, {ty, ty}, ty);
+      auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+      auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+      auto refTy = fir::ReferenceType::get(ty);
+      auto i1Ty = mlir::IntegerType::get(ctx, 1);
+      return mlir::FunctionType::get(
+          ctx, {boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {ty});
+    };
+  }
+};
+
+/// Placeholder for integer*16 version of Reduce Intrinsic
+struct ForcedReduceInteger16 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(ReduceInteger16));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto ty = mlir::IntegerType::get(ctx, 128);
+      auto boxTy =
+          fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+      auto opTy = mlir::FunctionType::get(ctx, {ty, ty}, ty);
+      auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+      auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+      auto refTy = fir::ReferenceType::get(ty);
+      auto i1Ty = mlir::IntegerType::get(ctx, 1);
+      return mlir::FunctionType::get(
+          ctx, {boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {ty});
+    };
+  }
+};
+
+/// Placeholder for complex(10) version of Reduce Intrinsic
+struct ForcedReduceComplex10 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(CppReduceComplex10));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto ty = mlir::ComplexType::get(mlir::FloatType::getF80(ctx));
+      auto boxTy =
+          fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+      auto opTy = mlir::FunctionType::get(ctx, {ty, ty}, ty);
+      auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+      auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+      auto refTy = fir::ReferenceType::get(ty);
+      auto i1Ty = mlir::IntegerType::get(ctx, 1);
+      return mlir::FunctionType::get(
+          ctx, {ty, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {});
+    };
+  }
+};
+
+/// Placeholder for complex(16) version of Reduce Intrinsic
+struct ForcedReduceComplex16 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(CppReduceComplex16));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto ty = mlir::ComplexType::get(mlir::FloatType::getF128(ctx));
+      auto boxTy =
+          fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+      auto opTy = mlir::FunctionType::get(ctx, {ty, ty}, ty);
+      auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+      auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+      auto refTy = fir::ReferenceType::get(ty);
+      auto i1Ty = mlir::IntegerType::get(ctx, 1);
+      return mlir::FunctionType::get(
+          ctx, {ty, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {});
+    };
+  }
+};
+
 /// Generate call to specialized runtime function that takes a mask and
 /// dim argument. The All, Any, and Count intrinsics use this pattern.
 template <typename FN>
@@ -1237,3 +1317,101 @@ void fir::runtime::genIParityDim(fir::FirOpBuilder &builder, mlir::Location loc,
 /// Generate call to `IParity` intrinsic runtime routine. This is the version
 /// that does not take a dim argument.
 GEN_IALL_IANY_IPARITY(IParity)
+
+/// Generate call to `Reduce` intrinsic runtime routine. This is the version
+/// that does have a scalar result.
+mlir::Value fir::runtime::genReduce(fir::FirOpBuilder &builder,
+                                    mlir::Location loc, mlir::Value arrayBox,
+                                    mlir::Value operation, mlir::Value dim,
+                                    mlir::Value maskBox, mlir::Value identity,
+                                    mlir::Value ordered,
+                                    mlir::Value resultBox) {
+  mlir::func::FuncOp func;
+  auto ty = arrayBox.getType();
+  auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
+  auto eleTy = mlir::cast<fir::SequenceType>(arrTy).getEleTy();
+
+  mlir::MLIRContext *ctx = builder.getContext();
+  fir::factory::CharacterExprHelper charHelper{builder, loc};
+
+  if (eleTy.isF16())
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceReal2)>(loc, builder);
+  else if (eleTy.isBF16())
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceReal3)>(loc, builder);
+  else if (eleTy.isF32())
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceReal4)>(loc, builder);
+  else if (eleTy.isF64())
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceReal8)>(loc, builder);
+  else if (eleTy.isF80())
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceReal10)>(loc, builder);
+  else if (eleTy.isF128())
+    func = fir::runtime::getRuntimeFunc<ForcedReduceReal16>(loc, builder);
+  else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceInteger1)>(loc, builder);
+  else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceInteger2)>(loc, builder);
+  else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceInteger4)>(loc, builder);
+  else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceInteger8)>(loc, builder);
+  else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
+    func = fir::runtime::getRuntimeFunc<ForcedReduceInteger16>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 2))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex2)>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 3))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex3)>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 4))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex4)>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 8))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex8)>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 10))
+    func = fir::runtime::getRuntimeFunc<ForcedReduceComplex10>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 16))
+    func = fir::runtime::getRuntimeFunc<ForcedSumComplex16>(loc, builder);
+  else if (eleTy == fir::LogicalType::get(ctx, 1))
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceLogical1)>(loc, builder);
+  else if (eleTy == fir::LogicalType::get(ctx, 2))
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceLogical2)>(loc, builder);
+  else if (eleTy == fir::LogicalType::get(ctx, 4))
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceLogical4)>(loc, builder);
+  else if (eleTy == fir::LogicalType::get(ctx, 8))
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceLogical8)>(loc, builder);
+  else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 1)
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceChar1)>(loc, builder);
+  else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 2)
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceChar2)>(loc, builder);
+  else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 4)
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceChar4)>(loc, builder);
+  else if (fir::isa_derived(eleTy))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(ReduceDerivedType)>(loc, builder);
+  else
+    fir::intrinsicTypeTODO(builder, eleTy, loc, "REDUCE");
+
+  auto fTy = func.getFunctionType();
+  auto sourceFile = fir::factory::locationToFilename(builder, loc);
+  if (fir::isa_complex(eleTy) || fir::isa_char(eleTy) ||
+      fir::isa_derived(eleTy)) {
+    auto sourceLine =
+        fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
+    auto opAddr =
+        builder.create<fir::BoxAddrOp>(loc, fTy.getInput(2), operation);
+    auto args = fir::runtime::createArguments(
+        builder, loc, fTy, resultBox, arrayBox, opAddr, sourceFile, sourceLine,
+        dim, maskBox, identity, ordered);
+    builder.create<fir::CallOp>(loc, func, args);
+    return resultBox;
+  }
+
+  auto sourceLine =
+      fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
+  auto opAddr = builder.create<fir::BoxAddrOp>(loc, fTy.getInput(1), operation);
+  auto args = fir::runtime::createArguments(builder, loc, fTy, arrayBox, opAddr,
+                                            sourceFile, sourceLine, dim,
+                                            maskBox, identity, ordered);
+  return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
diff --git a/flang/test/Lower/Intrinsics/Todo/reduce.f90 b/flang/test/Lower/Intrinsics/Todo/reduce.f90
deleted file mode 100644
index 7aa6f4a9f3ad3..0000000000000
--- a/flang/test/Lower/Intrinsics/Todo/reduce.f90
+++ /dev/null
@@ -1,13 +0,0 @@
-! RUN: %not_todo_cmd bbc -emit-fir %s -o -  2>&1 | FileCheck %s
-
-interface
-  pure function chfunc(a,b)
-    character(*),intent(in) :: a,b
-    character(3) :: chfunc
-  end function
-  end interface
-  character(3) x(5)
-  print*, reduce(x,chfunc)
-end program
-
-! CHECK: not yet implemented: intrinsic: reduce
diff --git a/flang/test/Lower/Intrinsics/reduce.f90 b/flang/test/Lower/Intrinsics/reduce.f90
new file mode 100644
index 0000000000000..3c548816b77c9
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/reduce.f90
@@ -0,0 +1,379 @@
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+module reduce_mod
+
+type :: t1
+  integer :: a
+end type
+
+contains
+
+pure function red_int1(a,b)
+  integer(1), intent(in) :: a, b
+  integer(1) :: red_int1
+  red_int1 = a + b
+end function
+
+subroutine integer1(a, id)
+  integer(1), intent(in) :: a(:)
+  integer(1) :: res, id
+
+  res = reduce(a, red_int1)
+
+  res = reduce(a, red_int1, 1, identity=id)
+  
+  res = reduce(a, red_int1, 1, identity=id, ordered = .false.)
+
+  res = reduce(a, red_int1, 1, [.true., .true., .false.])
+end subroutine
+
+! CHECK-LABEL: func.func @_QMreduce_modPinteger1(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?xi8>> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.ref<i8> {fir.bindc_name = "id"})
+! CHECK: %[[A:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QMreduce_modFinteger1Ea"} : (!fir.box<!fir.array<?xi8>>, !fir.dscope) -> (!fir.box<!fir.array<?xi8>>, !fir.box<!fir.array<?xi8>>)
+! CHECK: %[[ID:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %{{.*}} {uniq_name = "_QMreduce_modFinteger1Eid"} : (!fir.ref<i8>, !fir.dscope) -> (!fir.ref<i8>, !fir.ref<i8>)
+! CHECK: %[[ALLOC_RES:.*]] = fir.alloca i8 {bindc_name = "res", uniq_name = "_QMreduce_modFinteger1Eres"}
+! CHECK: %[[RES:.*]]:2 = hlfir.declare %[[ALLOC_RES]] {uniq_name = "_QMreduce_modFinteger1Eres"} : (!fir.ref<i8>) -> (!fir.ref<i8>, !fir.ref<i8>)
+! CHECK: %[[ADDR_OP:.*]] = fir.address_of(@_QMreduce_modPred_int1) : (!fir.ref<i8>, !fir.ref<i8>) -> i8
+! CHECK: %[[BOX_PROC:.*]] = fir.emboxproc %[[ADDR_OP]] : ((!fir.ref<i8>, !fir.ref<i8>) -> i8) -> !fir.boxproc<() -> ()>
+! CHECK: %[[MASK:.*]] = fir.absent !fir.box<i1>
+! CHECK: %[[IDENTITY:.*]] = fir.absent !fir.ref<i8>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX_PROC]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>)
+! CHECK: %[[A_NONE:.*]] = fir.convert %[[A]]#1 : (!fir.box<!fir.array<?xi8>>) -> !fir.box<none>
+! CHECK: %[[MASK_NONE:.*]] = fir.convert %[[MASK]] : (!fir.box<i1>) -> !fir.box<none>
+! CHECK: %[[REDUCE_RES:.*]] = fir.call @_FortranAReduceInteger1(%[[A_NONE]], %[[BOX_ADDR]], %{{.*}}, %{{.*}}, %c1{{.*}}, %[[MASK_NONE]], %[[IDENTITY]], %true) fastmath<contract> : (!fir.box<none>, (!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>, !fir.ref<i8>, i32, i32, !fir.box<none>, !fir.ref<i8>, i1) -> i8
+! CHECK: hlfir.assign %[[REDUCE_RES]] to %[[RES]]#0 : i8, !fir.ref<i8>
+! CHECK: %[[ADDR_OP:.*]] = fir.address_of(@_QMreduce_modPred_int1) : (!fir.ref<i8>, !fir.ref<i8>) -> i8
+! CHECK: %[[BOX_PROC:.*]] = fir.emboxproc %[[ADDR_OP]] : ((!fir.ref<i8>, !fir.ref<i8>) -> i8) -> !fir.boxproc<() -> ()>
+! CHECK: %[[MASK:.*]] = fir.absent !fir.box<i1>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX_PROC]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>)
+! CHECK: %[[A_NONE:.*]] = fir.convert %[[A]]#1 : (!fir.box<!fir.array<?xi8>>) -> !fir.box<none>
+! CHECK: %[[MASK_NONE:.*]] = fir.convert %[[MASK]] : (!fir.box<i1>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAReduceInteger1(%[[A_NONE]], %[[BOX_ADDR]], %{{.*}}, %{{.*}}, %c1{{.*}}, %[[MASK_NONE]], %[[ID]]#1, %true{{.*}}) fastmath<contract> : (!fir.box<none>, (!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>, !fir.ref<i8>, i32, i32, !fir.box<none>, !fir.ref<i8>, i1) -> i8
+! CHECK: fir.call @_FortranAReduceInteger1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}#1, %false)
+! CHECK: %[[MASK:.*]]:2 = hlfir.declare %{{.*}}(%{{.*}}) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.0"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.ref<!fir.array<3x!fir.logical<4>>>)
+! CHECK: %[[SHAPE_C3:.*]] = fir.shape %c3{{.*}} : (index) -> !fir.shape<1>
+! CHECK: %[[BOXED_MASK:.*]] = fir.embox %[[MASK]]#1(%[[SHAPE_C3]]) : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.box<!fir.array<3x!fir.logical<4>>>
+! CHECK: %[[CONV_MASK:.*]] = fir.convert %[[BOXED_MASK]] : (!fir.box<!fir.array<3x!fir.logical<4>>>) -> !fir.box<none>
+! CHECK: fir.call @_FortranAReduceInteger1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %[[CONV_MASK]], %{{.*}}, %true{{.*}})
+
+pure function red_int2(a,b)
+  integer(2), intent(in) :: a, b
+  integer(2) :: red_int2
+  red_int2 = a + b
+end function
+
+subroutine integer2(a)
+  integer(2), intent(in) :: a(:)
+  integer(2) :: res
+  res = reduce(a, red_int2, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceInteger2
+
+pure function red_int4(a,b)
+  integer(4), intent(in) :: a, b
+  integer(4) :: red_int4
+  red_int4 = a + b
+end function
+
+subroutine integer4(a)
+  integer(4), intent(in) :: a(:)
+  integer(4) :: res
+  res = reduce(a, red_int4, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceInteger4
+
+pure function red_int8(a,b)
+  integer(8), intent(in) :: a, b
+  integer(8) :: red_int8
+  red_int8 = a + b
+end function
+
+subroutine integer8(a)
+  integer(8), intent(in) :: a(:)
+  integer(8) :: res
+  res = reduce(a, red_int8, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceInteger8
+
+pure function red_int16(a,b)
+  integer(16), intent(in) :: a, b
+  integer(16) :: red_int16
+  red_int16 = a + b
+end function
+
+subroutine integer16(a)
+  integer(16), intent(in) :: a(:)
+  integer(16) :: res
+  res = reduce(a, red_int16, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceInteger16
+
+pure function red_real2(a,b)
+  real(2), intent(in) :: a, b
+  real(2) :: red_real2
+  red_real2 = a + b
+end function
+
+subroutine real2(a)
+  real(2), intent(in) :: a(:)
+  real(2) :: res
+  res = reduce(a, red_real2, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceReal2
+
+pure function red_real3(a,b)
+  real(3), intent(in) :: a, b
+  real(3) :: red_real3
+  red_real3 = a + b
+end function
+
+subroutine real3(a)
+  real(3), intent(in) :: a(:)
+  real(3) :: res
+  res = reduce(a, red_real3, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceReal3
+
+pure function red_real4(a,b)
+  real(4), intent(in) :: a, b
+  real(4) :: red_real4
+  red_real4 = a + b
+end function
+
+subroutine real4(a)
+  real(4), intent(in) :: a(:)
+  real(4) :: res
+  res = reduce(a, red_real4, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceReal4
+
+pure function red_real8(a,b)
+  real(8), intent(in) :: a, b
+  real(8) :: red_real8
+  red_real8 = a + b
+end function
+
+subroutine real8(a)
+  real(8), intent(in) :: a(:)
+  real(8) :: res
+  res = reduce(a, red_real8, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceReal8
+
+pure function red_real10(a,b)
+  real(10), intent(in) :: a, b
+  real(10) :: red_real10
+  red_real10 = a + b
+end function
+
+subroutine real10(a)
+  real(10), intent(in) :: a(:)
+  real(10) :: res
+  res = reduce(a, red_real10, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceReal10
+
+pure function red_real16(a,b)
+  real(16), intent(in) :: a, b
+  real(16) :: red_real16
+  red_real16 = a + b
+end function
+
+subroutine real16(a)
+  real(16), intent(in) :: a(:)
+  real(16) :: res
+  res = reduce(a, red_real16, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceReal16
+
+pure function red_complex2(a,b)
+  complex(2), intent(in) :: a, b
+  complex(2) :: red_complex2
+  red_complex2 = a + b
+end function
+
+subroutine complex2(a)
+  complex(2), intent(in) :: a(:)
+  complex(2) :: res
+  res = reduce(a, red_complex2, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranACppReduceComplex2
+
+pure function red_complex3(a,b)
+  complex(3), intent(in) :: a, b
+  complex(3) :: red_complex3
+  red_complex3 = a + b
+end function
+
+subroutine complex3(a)
+  complex(3), intent(in) :: a(:)
+  complex(3) :: res
+  res = reduce(a, red_complex3, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranACppReduceComplex3
+
+pure function red_complex4(a,b)
+  complex(4), intent(in) :: a, b
+  complex(4) :: red_complex4
+  red_complex4 = a + b
+end function
+
+subroutine complex4(a)
+  complex(4), intent(in) :: a(:)
+  complex(4) :: res
+  res = reduce(a, red_complex4, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranACppReduceComplex4
+
+pure function red_complex8(a,b)
+  complex(8), intent(in) :: a, b
+  complex(8) :: red_complex8
+  red_complex8 = a + b
+end function
+
+subroutine complex8(a)
+  complex(8), intent(in) :: a(:)
+  complex(8) :: res
+  res = reduce(a, red_complex8, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranACppReduceComplex8
+
+pure function red_complex10(a,b)
+  complex(10), intent(in) :: a, b
+  complex(10) :: red_complex10
+  red_complex10 = a + b
+end function
+
+subroutine complex10(a)
+  complex(10), intent(in) :: a(:)
+  complex(10) :: res
+!  res = reduce(a, red_complex10, 1)
+end subroutine
+
+pure function red_log1(a,b)
+  logical(1), intent(in) :: a, b
+  logical(1) :: red_log1
+  red_log1 = a .and. b
+end function
+
+subroutine log1(a)
+  logical(1), intent(in) :: a(:)
+  logical(1) :: res
+  res = reduce(a, red_log1, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceLogical1
+
+pure function red_log2(a,b)
+  logical(2), intent(in) :: a, b
+  logical(2) :: red_log2
+  red_log2 = a .and. b
+end function
+
+subroutine log2(a)
+  logical(2), intent(in) :: a(:)
+  logical(2) :: res
+  res = reduce(a, red_log2, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceLogical2
+
+pure function red_log4(a,b)
+  logical(4), intent(in) :: a, b
+  logical(4) :: red_log4
+  red_log4 = a .and. b
+end function
+
+subroutine log4(a)
+  logical(4), intent(in) :: a(:)
+  logical(4) :: res
+  res = reduce(a, red_log4, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceLogical4
+
+pure function red_log8(a,b)
+  logical(8), intent(in) :: a, b
+  logical(8) :: red_log8
+  red_log8 = a .and. b
+end function
+
+subroutine log8(a)
+  logical(8), intent(in) :: a(:)
+  logical(8) :: res
+  res = reduce(a, red_log8, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceLogical8
+
+pure function red_char1(a,b)
+  character(1), intent(in) :: a, b
+  character(1) :: red_char1
+  red_char1 = a // b
+end function
+
+subroutine char1(a)
+  character(1), intent(in) :: a(:)
+  character(1) :: res
+  res = reduce(a, red_char1, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceChar1
+
+pure function red_char2(a,b)
+  character(kind=2), intent(in) :: a, b
+  character(kind=2) :: red_char2
+  red_char2 = a // b
+end function
+
+subroutine char2(a)
+  character(kind=2), intent(in) :: a(:)
+  character(kind=2) :: res
+  res = reduce(a, red_char2, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceChar2
+
+pure function red_char4(a,b)
+  character(kind=4), intent(in) :: a, b
+  character(kind=4) :: red_char4
+  red_char4 = a // b
+end function
+
+subroutine char4(a)
+  character(kind=4), intent(in) :: a(:)
+  character(kind=4) :: res
+  res = reduce(a, red_char4, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceChar4
+
+pure function red_type(a,b)
+  type(t1), intent(in) :: a, b
+  type(t1) :: red_type
+  red_type%a = a%a + b%a
+end function
+
+subroutine testtype(a)
+  type(t1), intent(in) :: a(:)
+  type(t1) :: res
+  res = reduce(a, red_type, 1)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceDerivedType
+
+end module

>From c6d422e0aff1085a48b7ec67474504336179041f Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Thu, 6 Jun 2024 13:50:36 -0700
Subject: [PATCH 2/8] Update for asbent dim

---
 .../flang/Optimizer/Builder/IntrinsicCall.h   |  2 +
 .../Optimizer/Builder/Runtime/Reduction.h     |  5 +-
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 19 +++----
 .../Optimizer/Builder/Runtime/Reduction.cpp   |  6 +--
 flang/test/Lower/Intrinsics/reduce.f90        | 52 +++++++++----------
 5 files changed, 41 insertions(+), 43 deletions(-)

diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index c47e41eab18b2..a8e1e131e8e4b 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -326,6 +326,8 @@ struct IntrinsicLibrary {
   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genReduce(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genReduceDim(mlir::Type,
+                                  llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genRRSpacing(mlir::Type resultType,
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h b/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
index a4adaa72fa41a..b586fc3f3e608 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
@@ -228,9 +228,8 @@ void genIParityDim(fir::FirOpBuilder &builder, mlir::Location loc,
 /// that does not take a dim argument.
 mlir::Value genReduce(fir::FirOpBuilder &builder, mlir::Location loc,
                       mlir::Value arrayBox, mlir::Value operation,
-                      mlir::Value dim, mlir::Value maskBox,
-                      mlir::Value identity, mlir::Value ordered,
-                      mlir::Value resultBox);
+                      mlir::Value maskBox, mlir::Value identity,
+                      mlir::Value ordered, mlir::Value resultBox);
 
 } // namespace fir::runtime
 
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index b1d0be6a3ec4c..93bbc2465ed07 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -5718,9 +5718,7 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
   mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrTy).getEleTy();
 
   // Handle optional mask argument
-  auto dim = isStaticallyAbsent(args[3])
-                 ? builder.createIntegerConstant(loc, builder.getI32Type(), 1)
-                 : fir::getBase(args[2]);
+  bool absentDim = isStaticallyAbsent(args[1]);
 
   auto mask = isStaticallyAbsent(args[3])
                   ? builder.create<fir::AbsentOp>(
@@ -5738,11 +5736,11 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
 
   // We call the type specific versions because the result is scalar
   // in the case below.
-  if (rank == 1) {
+  if (absentDim || rank == 1) {
     if (fir::isa_complex(eleTy) || fir::isa_derived(eleTy)) {
       mlir::Value result = builder.createTemporary(loc, eleTy);
-      fir::runtime::genReduce(builder, loc, array, operation, dim, mask,
-                              identity, ordered, result);
+      fir::runtime::genReduce(builder, loc, array, operation, mask, identity,
+                              ordered, result);
       if (fir::isa_derived(eleTy))
         return result;
       return builder.create<fir::LoadOp>(loc, result);
@@ -5753,18 +5751,17 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
           fir::factory::createTempMutableBox(builder, loc, eleTy);
       mlir::Value resultIrBox =
           fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
-      fir::runtime::genReduce(builder, loc, array, operation, dim, mask,
-                              identity, ordered, resultIrBox);
+      fir::runtime::genReduce(builder, loc, array, operation, mask, identity,
+                              ordered, resultIrBox);
       // Handle cleanup of allocatable result descriptor and return
       return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE");
     }
     auto resultBox = builder.create<fir::AbsentOp>(
         loc, fir::BoxType::get(builder.getI1Type()));
-    return fir::runtime::genReduce(builder, loc, array, operation, dim, mask,
+    return fir::runtime::genReduce(builder, loc, array, operation, mask,
                                    identity, ordered, resultBox);
   }
-
-  TODO(loc, "intrinsic: reduce with non scalar result");
+  TODO(loc, "reduce with array result");
 }
 
 // REPEAT
diff --git a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
index 0c1af6159c939..85cbaef453b4c 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
@@ -1322,14 +1322,14 @@ GEN_IALL_IANY_IPARITY(IParity)
 /// that does have a scalar result.
 mlir::Value fir::runtime::genReduce(fir::FirOpBuilder &builder,
                                     mlir::Location loc, mlir::Value arrayBox,
-                                    mlir::Value operation, mlir::Value dim,
-                                    mlir::Value maskBox, mlir::Value identity,
-                                    mlir::Value ordered,
+                                    mlir::Value operation, mlir::Value maskBox,
+                                    mlir::Value identity, mlir::Value ordered,
                                     mlir::Value resultBox) {
   mlir::func::FuncOp func;
   auto ty = arrayBox.getType();
   auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
   auto eleTy = mlir::cast<fir::SequenceType>(arrTy).getEleTy();
+  auto dim = builder.createIntegerConstant(loc, builder.getI32Type(), 1);
 
   mlir::MLIRContext *ctx = builder.getContext();
   fir::factory::CharacterExprHelper charHelper{builder, loc};
diff --git a/flang/test/Lower/Intrinsics/reduce.f90 b/flang/test/Lower/Intrinsics/reduce.f90
index 3c548816b77c9..b2db3088e6de9 100644
--- a/flang/test/Lower/Intrinsics/reduce.f90
+++ b/flang/test/Lower/Intrinsics/reduce.f90
@@ -20,11 +20,11 @@ subroutine integer1(a, id)
 
   res = reduce(a, red_int1)
 
-  res = reduce(a, red_int1, 1, identity=id)
+  res = reduce(a, red_int1, identity=id)
   
-  res = reduce(a, red_int1, 1, identity=id, ordered = .false.)
+  res = reduce(a, red_int1, identity=id, ordered = .false.)
 
-  res = reduce(a, red_int1, 1, [.true., .true., .false.])
+  res = reduce(a, red_int1, [.true., .true., .false.])
 end subroutine
 
 ! CHECK-LABEL: func.func @_QMreduce_modPinteger1(
@@ -65,7 +65,7 @@ pure function red_int2(a,b)
 subroutine integer2(a)
   integer(2), intent(in) :: a(:)
   integer(2) :: res
-  res = reduce(a, red_int2, 1)
+  res = reduce(a, red_int2)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceInteger2
@@ -79,7 +79,7 @@ pure function red_int4(a,b)
 subroutine integer4(a)
   integer(4), intent(in) :: a(:)
   integer(4) :: res
-  res = reduce(a, red_int4, 1)
+  res = reduce(a, red_int4)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceInteger4
@@ -93,7 +93,7 @@ pure function red_int8(a,b)
 subroutine integer8(a)
   integer(8), intent(in) :: a(:)
   integer(8) :: res
-  res = reduce(a, red_int8, 1)
+  res = reduce(a, red_int8)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceInteger8
@@ -107,7 +107,7 @@ pure function red_int16(a,b)
 subroutine integer16(a)
   integer(16), intent(in) :: a(:)
   integer(16) :: res
-  res = reduce(a, red_int16, 1)
+  res = reduce(a, red_int16)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceInteger16
@@ -121,7 +121,7 @@ pure function red_real2(a,b)
 subroutine real2(a)
   real(2), intent(in) :: a(:)
   real(2) :: res
-  res = reduce(a, red_real2, 1)
+  res = reduce(a, red_real2)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceReal2
@@ -135,7 +135,7 @@ pure function red_real3(a,b)
 subroutine real3(a)
   real(3), intent(in) :: a(:)
   real(3) :: res
-  res = reduce(a, red_real3, 1)
+  res = reduce(a, red_real3)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceReal3
@@ -149,7 +149,7 @@ pure function red_real4(a,b)
 subroutine real4(a)
   real(4), intent(in) :: a(:)
   real(4) :: res
-  res = reduce(a, red_real4, 1)
+  res = reduce(a, red_real4)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceReal4
@@ -163,7 +163,7 @@ pure function red_real8(a,b)
 subroutine real8(a)
   real(8), intent(in) :: a(:)
   real(8) :: res
-  res = reduce(a, red_real8, 1)
+  res = reduce(a, red_real8)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceReal8
@@ -177,7 +177,7 @@ pure function red_real10(a,b)
 subroutine real10(a)
   real(10), intent(in) :: a(:)
   real(10) :: res
-  res = reduce(a, red_real10, 1)
+  res = reduce(a, red_real10)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceReal10
@@ -191,7 +191,7 @@ pure function red_real16(a,b)
 subroutine real16(a)
   real(16), intent(in) :: a(:)
   real(16) :: res
-  res = reduce(a, red_real16, 1)
+  res = reduce(a, red_real16)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceReal16
@@ -205,7 +205,7 @@ pure function red_complex2(a,b)
 subroutine complex2(a)
   complex(2), intent(in) :: a(:)
   complex(2) :: res
-  res = reduce(a, red_complex2, 1)
+  res = reduce(a, red_complex2)
 end subroutine
 
 ! CHECK: fir.call @_FortranACppReduceComplex2
@@ -219,7 +219,7 @@ pure function red_complex3(a,b)
 subroutine complex3(a)
   complex(3), intent(in) :: a(:)
   complex(3) :: res
-  res = reduce(a, red_complex3, 1)
+  res = reduce(a, red_complex3)
 end subroutine
 
 ! CHECK: fir.call @_FortranACppReduceComplex3
@@ -233,7 +233,7 @@ pure function red_complex4(a,b)
 subroutine complex4(a)
   complex(4), intent(in) :: a(:)
   complex(4) :: res
-  res = reduce(a, red_complex4, 1)
+  res = reduce(a, red_complex4)
 end subroutine
 
 ! CHECK: fir.call @_FortranACppReduceComplex4
@@ -247,7 +247,7 @@ pure function red_complex8(a,b)
 subroutine complex8(a)
   complex(8), intent(in) :: a(:)
   complex(8) :: res
-  res = reduce(a, red_complex8, 1)
+  res = reduce(a, red_complex8)
 end subroutine
 
 ! CHECK: fir.call @_FortranACppReduceComplex8
@@ -261,7 +261,7 @@ pure function red_complex10(a,b)
 subroutine complex10(a)
   complex(10), intent(in) :: a(:)
   complex(10) :: res
-!  res = reduce(a, red_complex10, 1)
+!  res = reduce(a, red_complex10)
 end subroutine
 
 pure function red_log1(a,b)
@@ -273,7 +273,7 @@ pure function red_log1(a,b)
 subroutine log1(a)
   logical(1), intent(in) :: a(:)
   logical(1) :: res
-  res = reduce(a, red_log1, 1)
+  res = reduce(a, red_log1)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceLogical1
@@ -287,7 +287,7 @@ pure function red_log2(a,b)
 subroutine log2(a)
   logical(2), intent(in) :: a(:)
   logical(2) :: res
-  res = reduce(a, red_log2, 1)
+  res = reduce(a, red_log2)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceLogical2
@@ -301,7 +301,7 @@ pure function red_log4(a,b)
 subroutine log4(a)
   logical(4), intent(in) :: a(:)
   logical(4) :: res
-  res = reduce(a, red_log4, 1)
+  res = reduce(a, red_log4)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceLogical4
@@ -315,7 +315,7 @@ pure function red_log8(a,b)
 subroutine log8(a)
   logical(8), intent(in) :: a(:)
   logical(8) :: res
-  res = reduce(a, red_log8, 1)
+  res = reduce(a, red_log8)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceLogical8
@@ -329,7 +329,7 @@ pure function red_char1(a,b)
 subroutine char1(a)
   character(1), intent(in) :: a(:)
   character(1) :: res
-  res = reduce(a, red_char1, 1)
+  res = reduce(a, red_char1)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceChar1
@@ -343,7 +343,7 @@ pure function red_char2(a,b)
 subroutine char2(a)
   character(kind=2), intent(in) :: a(:)
   character(kind=2) :: res
-  res = reduce(a, red_char2, 1)
+  res = reduce(a, red_char2)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceChar2
@@ -357,7 +357,7 @@ pure function red_char4(a,b)
 subroutine char4(a)
   character(kind=4), intent(in) :: a(:)
   character(kind=4) :: res
-  res = reduce(a, red_char4, 1)
+  res = reduce(a, red_char4)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceChar4
@@ -371,7 +371,7 @@ pure function red_type(a,b)
 subroutine testtype(a)
   type(t1), intent(in) :: a(:)
   type(t1) :: res
-  res = reduce(a, red_type, 1)
+  res = reduce(a, red_type)
 end subroutine
 
 ! CHECK: fir.call @_FortranAReduceDerivedType

>From 369388aacab517687e5f330309a68e12faf296ac Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Thu, 6 Jun 2024 13:54:54 -0700
Subject: [PATCH 3/8] Update comment

---
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 93bbc2465ed07..c424d08319ab8 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -5717,7 +5717,7 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
   mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
   mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrTy).getEleTy();
 
-  // Handle optional mask argument
+  // Handle optional arguments
   bool absentDim = isStaticallyAbsent(args[1]);
 
   auto mask = isStaticallyAbsent(args[3])

>From 1956000f38b88fc0ad1224f0aaca3d5dbb6c90d3 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Thu, 6 Jun 2024 15:07:58 -0700
Subject: [PATCH 4/8] Address comments

---
 .../Optimizer/Builder/Runtime/Reduction.h     |  13 +-
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp |  12 +-
 .../Optimizer/Builder/Runtime/Reduction.cpp   | 113 +++++++++++-------
 flang/lib/Optimizer/Dialect/FIROps.cpp        |   3 +-
 flang/test/Lower/Intrinsics/reduce.f90        |  28 ++++-
 5 files changed, 110 insertions(+), 59 deletions(-)

diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h b/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
index b586fc3f3e608..27652208b524e 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
@@ -225,11 +225,20 @@ void genIParityDim(fir::FirOpBuilder &builder, mlir::Location loc,
                    mlir::Value maskBox);
 
 /// Generate call to `Reduce` intrinsic runtime routine. This is the version
-/// that does not take a dim argument.
+/// that does not take a dim argument and store the result in the provided
+/// result value. This is used for COMPLEX, CHARACTER and DERIVED TYPES.
+void genReduce(fir::FirOpBuilder &builder, mlir::Location loc,
+               mlir::Value arrayBox, mlir::Value operation, mlir::Value maskBox,
+               mlir::Value identity, mlir::Value ordered,
+               mlir::Value resultBox);
+
+/// Generate call to `Reduce` intrinsic runtime routine. This is the version
+/// that does not take a dim argument and return a scalare result. This is used
+/// for REAL, INTEGER and LOGICAL TYPES.
 mlir::Value genReduce(fir::FirOpBuilder &builder, mlir::Location loc,
                       mlir::Value arrayBox, mlir::Value operation,
                       mlir::Value maskBox, mlir::Value identity,
-                      mlir::Value ordered, mlir::Value resultBox);
+                      mlir::Value ordered);
 
 } // namespace fir::runtime
 
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index c424d08319ab8..3b606a6e9423e 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -522,8 +522,8 @@ static constexpr IntrinsicHandler handlers[]{
        {"operation", asAddr},
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional},
-       {"identity", asAddr},
-       {"ordered", asValue}}},
+       {"identity", asAddr, handleDynamicOptional},
+       {"ordered", asValue, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"repeat",
      &I::genRepeat,
@@ -5718,7 +5718,7 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
   mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrTy).getEleTy();
 
   // Handle optional arguments
-  bool absentDim = isStaticallyAbsent(args[1]);
+  bool absentDim = isStaticallyAbsent(args[2]);
 
   auto mask = isStaticallyAbsent(args[3])
                   ? builder.create<fir::AbsentOp>(
@@ -5731,7 +5731,7 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
           : fir::getBase(args[4]);
 
   mlir::Value ordered = isStaticallyAbsent(args[5])
-                            ? builder.createBool(loc, true)
+                            ? builder.createBool(loc, false)
                             : fir::getBase(args[5]);
 
   // We call the type specific versions because the result is scalar
@@ -5756,10 +5756,8 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
       // Handle cleanup of allocatable result descriptor and return
       return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE");
     }
-    auto resultBox = builder.create<fir::AbsentOp>(
-        loc, fir::BoxType::get(builder.getI1Type()));
     return fir::runtime::genReduce(builder, loc, array, operation, mask,
-                                   identity, ordered, resultBox);
+                                   identity, ordered);
   }
   TODO(loc, "reduce with array result");
 }
diff --git a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
index 85cbaef453b4c..a7cd53328d69a 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
@@ -521,7 +521,8 @@ struct ForcedReduceComplex10 {
       auto refTy = fir::ReferenceType::get(ty);
       auto i1Ty = mlir::IntegerType::get(ctx, 1);
       return mlir::FunctionType::get(
-          ctx, {ty, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {});
+          ctx, {refTy, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty},
+          {});
     };
   }
 };
@@ -541,7 +542,8 @@ struct ForcedReduceComplex16 {
       auto refTy = fir::ReferenceType::get(ty);
       auto i1Ty = mlir::IntegerType::get(ctx, 1);
       return mlir::FunctionType::get(
-          ctx, {ty, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {});
+          ctx, {refTy, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty},
+          {});
     };
   }
 };
@@ -1319,12 +1321,71 @@ void fir::runtime::genIParityDim(fir::FirOpBuilder &builder, mlir::Location loc,
 GEN_IALL_IANY_IPARITY(IParity)
 
 /// Generate call to `Reduce` intrinsic runtime routine. This is the version
-/// that does have a scalar result.
+/// that does not take a DIM argument and store result in the passed result
+/// value.
+void fir::runtime::genReduce(fir::FirOpBuilder &builder, mlir::Location loc,
+                             mlir::Value arrayBox, mlir::Value operation,
+                             mlir::Value maskBox, mlir::Value identity,
+                             mlir::Value ordered, mlir::Value resultBox) {
+  mlir::func::FuncOp func;
+  auto ty = arrayBox.getType();
+  auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
+  auto eleTy = mlir::cast<fir::SequenceType>(arrTy).getEleTy();
+  auto dim = builder.createIntegerConstant(loc, builder.getI32Type(), 1);
+
+  assert(resultBox && "expect non null value for the result");
+  assert((fir::isa_char(eleTy) || fir::isa_complex(eleTy) ||
+          fir::isa_derived(eleTy)) &&
+         "expect character, complex or derived-type");
+
+  mlir::MLIRContext *ctx = builder.getContext();
+  fir::factory::CharacterExprHelper charHelper{builder, loc};
+
+  if (eleTy == fir::ComplexType::get(ctx, 2))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex2)>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 3))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex3)>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 4))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex4)>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 8))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex8)>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 10))
+    func = fir::runtime::getRuntimeFunc<ForcedReduceComplex10>(loc, builder);
+  else if (eleTy == fir::ComplexType::get(ctx, 16))
+    func = fir::runtime::getRuntimeFunc<ForcedReduceComplex16>(loc, builder);
+  else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 1)
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceChar1)>(loc, builder);
+  else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 2)
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceChar2)>(loc, builder);
+  else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 4)
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceChar4)>(loc, builder);
+  else if (fir::isa_derived(eleTy))
+    func =
+        fir::runtime::getRuntimeFunc<mkRTKey(ReduceDerivedType)>(loc, builder);
+  else
+    fir::intrinsicTypeTODO(builder, eleTy, loc, "REDUCE");
+
+  auto fTy = func.getFunctionType();
+  auto sourceFile = fir::factory::locationToFilename(builder, loc);
+  auto sourceLine =
+      fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
+  auto opAddr = builder.create<fir::BoxAddrOp>(loc, fTy.getInput(2), operation);
+  auto args = fir::runtime::createArguments(
+      builder, loc, fTy, resultBox, arrayBox, opAddr, sourceFile, sourceLine,
+      dim, maskBox, identity, ordered);
+  builder.create<fir::CallOp>(loc, func, args);
+}
+
+/// Generate call to `Reduce` intrinsic runtime routine. This is the version
+/// that does not take DIM argument and return a scalar result.
 mlir::Value fir::runtime::genReduce(fir::FirOpBuilder &builder,
                                     mlir::Location loc, mlir::Value arrayBox,
                                     mlir::Value operation, mlir::Value maskBox,
-                                    mlir::Value identity, mlir::Value ordered,
-                                    mlir::Value resultBox) {
+                                    mlir::Value identity, mlir::Value ordered) {
   mlir::func::FuncOp func;
   auto ty = arrayBox.getType();
   auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
@@ -1334,6 +1395,10 @@ mlir::Value fir::runtime::genReduce(fir::FirOpBuilder &builder,
   mlir::MLIRContext *ctx = builder.getContext();
   fir::factory::CharacterExprHelper charHelper{builder, loc};
 
+  assert((fir::isa_real(eleTy) || fir::isa_integer(eleTy) ||
+          mlir::isa<fir::LogicalType>(eleTy)) &&
+         "expect real, interger or logical");
+
   if (eleTy.isF16())
     func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceReal2)>(loc, builder);
   else if (eleTy.isBF16())
@@ -1356,22 +1421,6 @@ mlir::Value fir::runtime::genReduce(fir::FirOpBuilder &builder,
     func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceInteger8)>(loc, builder);
   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
     func = fir::runtime::getRuntimeFunc<ForcedReduceInteger16>(loc, builder);
-  else if (eleTy == fir::ComplexType::get(ctx, 2))
-    func =
-        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex2)>(loc, builder);
-  else if (eleTy == fir::ComplexType::get(ctx, 3))
-    func =
-        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex3)>(loc, builder);
-  else if (eleTy == fir::ComplexType::get(ctx, 4))
-    func =
-        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex4)>(loc, builder);
-  else if (eleTy == fir::ComplexType::get(ctx, 8))
-    func =
-        fir::runtime::getRuntimeFunc<mkRTKey(CppReduceComplex8)>(loc, builder);
-  else if (eleTy == fir::ComplexType::get(ctx, 10))
-    func = fir::runtime::getRuntimeFunc<ForcedReduceComplex10>(loc, builder);
-  else if (eleTy == fir::ComplexType::get(ctx, 16))
-    func = fir::runtime::getRuntimeFunc<ForcedSumComplex16>(loc, builder);
   else if (eleTy == fir::LogicalType::get(ctx, 1))
     func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceLogical1)>(loc, builder);
   else if (eleTy == fir::LogicalType::get(ctx, 2))
@@ -1380,33 +1429,11 @@ mlir::Value fir::runtime::genReduce(fir::FirOpBuilder &builder,
     func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceLogical4)>(loc, builder);
   else if (eleTy == fir::LogicalType::get(ctx, 8))
     func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceLogical8)>(loc, builder);
-  else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 1)
-    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceChar1)>(loc, builder);
-  else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 2)
-    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceChar2)>(loc, builder);
-  else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 4)
-    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceChar4)>(loc, builder);
-  else if (fir::isa_derived(eleTy))
-    func =
-        fir::runtime::getRuntimeFunc<mkRTKey(ReduceDerivedType)>(loc, builder);
   else
     fir::intrinsicTypeTODO(builder, eleTy, loc, "REDUCE");
 
   auto fTy = func.getFunctionType();
   auto sourceFile = fir::factory::locationToFilename(builder, loc);
-  if (fir::isa_complex(eleTy) || fir::isa_char(eleTy) ||
-      fir::isa_derived(eleTy)) {
-    auto sourceLine =
-        fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
-    auto opAddr =
-        builder.create<fir::BoxAddrOp>(loc, fTy.getInput(2), operation);
-    auto args = fir::runtime::createArguments(
-        builder, loc, fTy, resultBox, arrayBox, opAddr, sourceFile, sourceLine,
-        dim, maskBox, identity, ordered);
-    builder.create<fir::CallOp>(loc, func, args);
-    return resultBox;
-  }
-
   auto sourceLine =
       fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
   auto opAddr = builder.create<fir::BoxAddrOp>(loc, fTy.getInput(1), operation);
diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp
index 9672cdccc111a..ac2213d0e5d10 100644
--- a/flang/lib/Optimizer/Dialect/FIROps.cpp
+++ b/flang/lib/Optimizer/Dialect/FIROps.cpp
@@ -1055,7 +1055,8 @@ bool fir::ConvertOp::canBeConverted(mlir::Type inType, mlir::Type outType) {
 mlir::LogicalResult fir::ConvertOp::verify() {
   if (canBeConverted(getValue().getType(), getType()))
     return mlir::success();
-  return emitOpError("invalid type conversion");
+  return emitOpError("invalid type conversion")
+         << getValue().getType() << " / " << getType();
 }
 
 //===----------------------------------------------------------------------===//
diff --git a/flang/test/Lower/Intrinsics/reduce.f90 b/flang/test/Lower/Intrinsics/reduce.f90
index b2db3088e6de9..36900abaa79f8 100644
--- a/flang/test/Lower/Intrinsics/reduce.f90
+++ b/flang/test/Lower/Intrinsics/reduce.f90
@@ -22,7 +22,7 @@ subroutine integer1(a, id)
 
   res = reduce(a, red_int1, identity=id)
   
-  res = reduce(a, red_int1, identity=id, ordered = .false.)
+  res = reduce(a, red_int1, identity=id, ordered = .true.)
 
   res = reduce(a, red_int1, [.true., .true., .false.])
 end subroutine
@@ -40,7 +40,7 @@ subroutine integer1(a, id)
 ! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX_PROC]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>)
 ! CHECK: %[[A_NONE:.*]] = fir.convert %[[A]]#1 : (!fir.box<!fir.array<?xi8>>) -> !fir.box<none>
 ! CHECK: %[[MASK_NONE:.*]] = fir.convert %[[MASK]] : (!fir.box<i1>) -> !fir.box<none>
-! CHECK: %[[REDUCE_RES:.*]] = fir.call @_FortranAReduceInteger1(%[[A_NONE]], %[[BOX_ADDR]], %{{.*}}, %{{.*}}, %c1{{.*}}, %[[MASK_NONE]], %[[IDENTITY]], %true) fastmath<contract> : (!fir.box<none>, (!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>, !fir.ref<i8>, i32, i32, !fir.box<none>, !fir.ref<i8>, i1) -> i8
+! CHECK: %[[REDUCE_RES:.*]] = fir.call @_FortranAReduceInteger1(%[[A_NONE]], %[[BOX_ADDR]], %{{.*}}, %{{.*}}, %c1{{.*}}, %[[MASK_NONE]], %[[IDENTITY]], %false) fastmath<contract> : (!fir.box<none>, (!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>, !fir.ref<i8>, i32, i32, !fir.box<none>, !fir.ref<i8>, i1) -> i8
 ! CHECK: hlfir.assign %[[REDUCE_RES]] to %[[RES]]#0 : i8, !fir.ref<i8>
 ! CHECK: %[[ADDR_OP:.*]] = fir.address_of(@_QMreduce_modPred_int1) : (!fir.ref<i8>, !fir.ref<i8>) -> i8
 ! CHECK: %[[BOX_PROC:.*]] = fir.emboxproc %[[ADDR_OP]] : ((!fir.ref<i8>, !fir.ref<i8>) -> i8) -> !fir.boxproc<() -> ()>
@@ -48,13 +48,13 @@ subroutine integer1(a, id)
 ! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX_PROC]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>)
 ! CHECK: %[[A_NONE:.*]] = fir.convert %[[A]]#1 : (!fir.box<!fir.array<?xi8>>) -> !fir.box<none>
 ! CHECK: %[[MASK_NONE:.*]] = fir.convert %[[MASK]] : (!fir.box<i1>) -> !fir.box<none>
-! CHECK: %{{.*}} = fir.call @_FortranAReduceInteger1(%[[A_NONE]], %[[BOX_ADDR]], %{{.*}}, %{{.*}}, %c1{{.*}}, %[[MASK_NONE]], %[[ID]]#1, %true{{.*}}) fastmath<contract> : (!fir.box<none>, (!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>, !fir.ref<i8>, i32, i32, !fir.box<none>, !fir.ref<i8>, i1) -> i8
-! CHECK: fir.call @_FortranAReduceInteger1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}#1, %false)
+! CHECK: %{{.*}} = fir.call @_FortranAReduceInteger1(%[[A_NONE]], %[[BOX_ADDR]], %{{.*}}, %{{.*}}, %c1{{.*}}, %[[MASK_NONE]], %[[ID]]#1, %false{{.*}}) fastmath<contract> : (!fir.box<none>, (!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>, !fir.ref<i8>, i32, i32, !fir.box<none>, !fir.ref<i8>, i1) -> i8
+! CHECK: fir.call @_FortranAReduceInteger1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}#1, %true)
 ! CHECK: %[[MASK:.*]]:2 = hlfir.declare %{{.*}}(%{{.*}}) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.0"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.ref<!fir.array<3x!fir.logical<4>>>)
 ! CHECK: %[[SHAPE_C3:.*]] = fir.shape %c3{{.*}} : (index) -> !fir.shape<1>
 ! CHECK: %[[BOXED_MASK:.*]] = fir.embox %[[MASK]]#1(%[[SHAPE_C3]]) : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.box<!fir.array<3x!fir.logical<4>>>
 ! CHECK: %[[CONV_MASK:.*]] = fir.convert %[[BOXED_MASK]] : (!fir.box<!fir.array<3x!fir.logical<4>>>) -> !fir.box<none>
-! CHECK: fir.call @_FortranAReduceInteger1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %[[CONV_MASK]], %{{.*}}, %true{{.*}})
+! CHECK: fir.call @_FortranAReduceInteger1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %[[CONV_MASK]], %{{.*}}, %false{{.*}})
 
 pure function red_int2(a,b)
   integer(2), intent(in) :: a, b
@@ -261,9 +261,25 @@ pure function red_complex10(a,b)
 subroutine complex10(a)
   complex(10), intent(in) :: a(:)
   complex(10) :: res
-!  res = reduce(a, red_complex10)
+  res = reduce(a, red_complex10)
 end subroutine
 
+! CHECK: fir.call @_FortranACppReduceComplex10
+
+pure function red_complex16(a,b)
+  complex(16), intent(in) :: a, b
+  complex(16) :: red_complex16
+  red_complex16 = a + b
+end function
+
+subroutine complex16(a)
+  complex(16), intent(in) :: a(:)
+  complex(16) :: res
+  res = reduce(a, red_complex16)
+end subroutine
+
+! CHECK: fir.call @_FortranACppReduceComplex16
+
 pure function red_log1(a,b)
   logical(1), intent(in) :: a, b
   logical(1) :: red_log1

>From 7a456bc5943b6dc257b7367f1e2bdce31965bff4 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Fri, 7 Jun 2024 22:41:58 -0700
Subject: [PATCH 5/8] Used Forced definition for Real10

---
 .../Optimizer/Builder/Runtime/Reduction.cpp   | 21 ++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
index a7cd53328d69a..0a280816ffcc8 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
@@ -467,6 +467,25 @@ struct ForcedIParity16 {
   }
 };
 
+/// Placeholder for real*10 version of Reduce Intrinsic
+struct ForcedReduceReal10 {
+  static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ReduceReal10));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto ty = mlir::FloatType::getF80(ctx);
+      auto boxTy =
+          fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+      auto opTy = mlir::FunctionType::get(ctx, {ty, ty}, ty);
+      auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+      auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+      auto refTy = fir::ReferenceType::get(ty);
+      auto i1Ty = mlir::IntegerType::get(ctx, 1);
+      return mlir::FunctionType::get(
+          ctx, {boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {ty});
+    };
+  }
+};
+
 /// Placeholder for real*16 version of Reduce Intrinsic
 struct ForcedReduceReal16 {
   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ReduceReal16));
@@ -1408,7 +1427,7 @@ mlir::Value fir::runtime::genReduce(fir::FirOpBuilder &builder,
   else if (eleTy.isF64())
     func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceReal8)>(loc, builder);
   else if (eleTy.isF80())
-    func = fir::runtime::getRuntimeFunc<mkRTKey(ReduceReal10)>(loc, builder);
+    func = fir::runtime::getRuntimeFunc<ForcedReduceReal10>(loc, builder);
   else if (eleTy.isF128())
     func = fir::runtime::getRuntimeFunc<ForcedReduceReal16>(loc, builder);
   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))

>From e2d0832eceb44968edc8afc03d6cecb1af6471fc Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Mon, 10 Jun 2024 09:44:52 -0700
Subject: [PATCH 6/8] Add int64_t getModel for Windows bot

---
 .../flang/Optimizer/Builder/Runtime/RTBuilder.h     | 13 +++++++++++++
 flang/runtime/reduce.cpp                            |  1 +
 2 files changed, 14 insertions(+)

diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index 1367e6147f9f9..ec1e2eb02c9f2 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -303,6 +303,19 @@ constexpr TypeBuilderFunc getModel<unsigned long long>() {
   };
 }
 template <>
+constexpr TypeBuilderFunc getModel<std::int64_t>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(std::int64_t));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const std::int64_t*>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<std::int64_t>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
 constexpr TypeBuilderFunc getModel<double>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return mlir::FloatType::getF64(context);
diff --git a/flang/runtime/reduce.cpp b/flang/runtime/reduce.cpp
index f8a5221a1ebf7..5fb2c8d8880e6 100644
--- a/flang/runtime/reduce.cpp
+++ b/flang/runtime/reduce.cpp
@@ -158,6 +158,7 @@ void RTDEF(ReduceInteger4Dim)(Descriptor &result, const Descriptor &array,
     ReductionOperation<std::int32_t> operation, const char *source, int line,
     int dim, const Descriptor *mask, const std::int32_t *identity,
     bool ordered) {
+  printf("dim: %d\n", dim);
   Terminator terminator{source, line};
   using Accumulator = ReduceAccumulator<std::int32_t>;
   Accumulator accumulator{array, operation, identity, terminator};

>From 831330b7a46f0b58cfd5c2c16407e3882eb53624 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Mon, 10 Jun 2024 09:48:49 -0700
Subject: [PATCH 7/8] clang-format

---
 flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index ec1e2eb02c9f2..4df49d7c1745d 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -309,7 +309,7 @@ constexpr TypeBuilderFunc getModel<std::int64_t>() {
   };
 }
 template <>
-constexpr TypeBuilderFunc getModel<const std::int64_t*>() {
+constexpr TypeBuilderFunc getModel<const std::int64_t *>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     TypeBuilderFunc f{getModel<std::int64_t>()};
     return fir::ReferenceType::get(f(context));

>From 4bcd85ef44df82f8aada708af38ef3dfb34f75b6 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Mon, 10 Jun 2024 11:01:08 -0700
Subject: [PATCH 8/8] Remove getModel std::int64_t

---
 .../flang/Optimizer/Builder/Runtime/RTBuilder.h     | 13 -------------
 1 file changed, 13 deletions(-)

diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index 4df49d7c1745d..1367e6147f9f9 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -303,19 +303,6 @@ constexpr TypeBuilderFunc getModel<unsigned long long>() {
   };
 }
 template <>
-constexpr TypeBuilderFunc getModel<std::int64_t>() {
-  return [](mlir::MLIRContext *context) -> mlir::Type {
-    return mlir::IntegerType::get(context, 8 * sizeof(std::int64_t));
-  };
-}
-template <>
-constexpr TypeBuilderFunc getModel<const std::int64_t *>() {
-  return [](mlir::MLIRContext *context) -> mlir::Type {
-    TypeBuilderFunc f{getModel<std::int64_t>()};
-    return fir::ReferenceType::get(f(context));
-  };
-}
-template <>
 constexpr TypeBuilderFunc getModel<double>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return mlir::FloatType::getF64(context);



More information about the flang-commits mailing list