[flang-commits] [flang] 0babff9 - [flang] Lower REDUCE intrinsic with no DIM argument and rank 1 (#94652)
via flang-commits
flang-commits at lists.llvm.org
Mon Jun 10 14:13:02 PDT 2024
Author: Valentin Clement (バレンタイン クレメン)
Date: 2024-06-10T14:12:57-07:00
New Revision: 0babff96759d2fa91af2dcab7564b6f08954e8fa
URL: https://github.com/llvm/llvm-project/commit/0babff96759d2fa91af2dcab7564b6f08954e8fa
DIFF: https://github.com/llvm/llvm-project/commit/0babff96759d2fa91af2dcab7564b6f08954e8fa.diff
LOG: [flang] Lower REDUCE intrinsic with no DIM argument and rank 1 (#94652)
This patch lowers the `REDUCE` intrinsic call to the runtime equivalent
for scalar results. Call with array result will follow.
Added:
flang/test/Lower/Intrinsics/reduce.f90
Modified:
flang/include/flang/Optimizer/Builder/IntrinsicCall.h
flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
flang/lib/Optimizer/Dialect/FIROps.cpp
flang/runtime/reduce.cpp
Removed:
flang/test/Lower/Intrinsics/Todo/reduce.f90
################################################################################
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 8ef5d59b92f0c..52f2034b8707a 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -328,6 +328,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/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index 575746374fcc4..99161c57fbe28 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));
@@ -199,6 +290,10 @@ constexpr TypeBuilderFunc getModel<long long *>() {
return getModel<long long &>();
}
template <>
+constexpr TypeBuilderFunc getModel<const long long *>() {
+ return getModel<long long *>();
+}
+template <>
constexpr TypeBuilderFunc getModel<unsigned long>() {
return [](mlir::MLIRContext *context) -> mlir::Type {
return mlir::IntegerType::get(context, 8 * sizeof(unsigned long));
@@ -228,6 +323,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 +361,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 +378,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 +480,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..27652208b524e 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h
@@ -224,6 +224,22 @@ 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 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);
+
} // 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 b3e1ee3da3a77..6101730ce1728 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -526,8 +526,8 @@ static constexpr IntrinsicHandler handlers[]{
{"operation", asAddr},
{"dim", asValue},
{"mask", asBox, handleDynamicOptional},
- {"identity", asValue},
- {"ordered", asValue}}},
+ {"identity", asAddr, handleDynamicOptional},
+ {"ordered", asValue, handleDynamicOptional}}},
/*isElemental=*/false},
{"repeat",
&I::genRepeat,
@@ -5736,7 +5736,61 @@ 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 arguments
+ bool absentDim = isStaticallyAbsent(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, false)
+ : fir::getBase(args[5]);
+
+ // We call the type specific versions because the result is scalar
+ // in the case below.
+ 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, 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, mask, identity,
+ ordered, resultIrBox);
+ // Handle cleanup of allocatable result descriptor and return
+ return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE");
+ }
+ return fir::runtime::genReduce(builder, loc, array, operation, mask,
+ identity, ordered);
+ }
+ 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 d4076067bf103..0a280816ffcc8 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,106 @@ 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));
+ 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, {refTy, 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, {refTy, 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 +1338,126 @@ 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 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::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};
+
+ 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())
+ 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<ForcedReduceReal10>(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::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
+ 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(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/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp
index 75ca738211abe..ea8a9752eeeee 100644
--- a/flang/lib/Optimizer/Dialect/FIROps.cpp
+++ b/flang/lib/Optimizer/Dialect/FIROps.cpp
@@ -1432,7 +1432,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/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};
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..36900abaa79f8
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/reduce.f90
@@ -0,0 +1,395 @@
+! 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, identity=id)
+
+ res = reduce(a, red_int1, identity=id, ordered = .true.)
+
+ res = reduce(a, red_int1, [.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]], %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<() -> ()>
+! 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, %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]], %{{.*}}, %false{{.*}})
+
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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
+ red_log1 = a .and. b
+end function
+
+subroutine log1(a)
+ logical(1), intent(in) :: a(:)
+ logical(1) :: res
+ res = reduce(a, red_log1)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+end subroutine
+
+! CHECK: fir.call @_FortranAReduceDerivedType
+
+end module
More information about the flang-commits
mailing list