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); void genRandomSeed(llvm::ArrayRef); fir::ExtendedValue genReduce(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genReduceDim(mlir::Type, + llvm::ArrayRef); fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef); 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>() { \ + return [](mlir::MLIRContext *context) -> mlir::Type { \ + TypeBuilderFunc f{getModel()}; \ + 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>() { \ + return [](mlir::MLIRContext *context) -> mlir::Type { \ + TypeBuilderFunc f{getModel()}; \ + 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() { return mlir::IntegerType::get(context, 8 * sizeof(unsigned int)); }; } - template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { @@ -83,6 +111,17 @@ constexpr TypeBuilderFunc getModel() { }; } template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return mlir::IntegerType::get(context, 8 * sizeof(int)); @@ -96,6 +135,17 @@ constexpr TypeBuilderFunc getModel() { }; } template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return fir::ReferenceType::get(mlir::IntegerType::get(context, 8)); @@ -130,6 +180,43 @@ constexpr TypeBuilderFunc getModel() { }; } template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(char16_t)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(char32_t)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return mlir::IntegerType::get(context, 8 * sizeof(unsigned char)); @@ -175,6 +262,10 @@ constexpr TypeBuilderFunc getModel() { return getModel(); } template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return mlir::IntegerType::get(context, 8 * sizeof(long long)); @@ -199,6 +290,10 @@ constexpr TypeBuilderFunc getModel() { return getModel(); } template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return mlir::IntegerType::get(context, 8 * sizeof(unsigned long)); @@ -228,6 +323,27 @@ constexpr TypeBuilderFunc getModel() { return getModel(); } template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::FloatType::getF80(context); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return mlir::FloatType::getF32(context); @@ -245,6 +361,10 @@ constexpr TypeBuilderFunc getModel() { return getModel(); } template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return mlir::IntegerType::get(context, 1); @@ -258,20 +378,48 @@ constexpr TypeBuilderFunc getModel() { }; } template <> +constexpr TypeBuilderFunc getModel>() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::ComplexType::get(mlir::FloatType::getF32(context)); + }; +} +template <> constexpr TypeBuilderFunc getModel &>() { return [](mlir::MLIRContext *context) -> mlir::Type { - auto ty = mlir::ComplexType::get(mlir::FloatType::getF32(context)); - return fir::ReferenceType::get(ty); + TypeBuilderFunc f{getModel>()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel *>() { + return getModel &>(); +} +template <> +constexpr TypeBuilderFunc getModel *>() { + return getModel *>(); +} +template <> +constexpr TypeBuilderFunc getModel>() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::ComplexType::get(mlir::FloatType::getF64(context)); }; } template <> constexpr TypeBuilderFunc getModel &>() { return [](mlir::MLIRContext *context) -> mlir::Type { - auto ty = mlir::ComplexType::get(mlir::FloatType::getF64(context)); - return fir::ReferenceType::get(ty); + TypeBuilderFunc f{getModel>()}; + return fir::ReferenceType::get(f(context)); }; } template <> +constexpr TypeBuilderFunc getModel *>() { + return getModel &>(); +} +template <> +constexpr TypeBuilderFunc getModel *>() { + return getModel *>(); +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return fir::ComplexType::get(context, sizeof(float)); @@ -332,6 +480,33 @@ constexpr TypeBuilderFunc getModel() { }; } +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) +REDUCTION_OPERATION_MODEL(std::complex) + +REDUCTION_CHAR_OPERATION_MODEL(char) +REDUCTION_CHAR_OPERATION_MODEL(char16_t) +REDUCTION_CHAR_OPERATION_MODEL(char32_t) + +template <> +constexpr TypeBuilderFunc +getModel() { + 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 struct RuntimeTableKey; template 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 1cd3976d0afbe..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", asValue}, - {"ordered", asValue}}}, + {"identity", asAddr, handleDynamicOptional}, + {"ordered", asValue, handleDynamicOptional}}}, /*isElemental=*/false}, {"repeat", &I::genRepeat, @@ -5705,7 +5705,61 @@ void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef args) { fir::ExtendedValue IntrinsicLibrary::genReduce(mlir::Type resultType, llvm::ArrayRef 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(arrTy).getEleTy(); + + // Handle optional arguments + bool absentDim = isStaticallyAbsent(args[2]); + + auto mask = isStaticallyAbsent(args[3]) + ? builder.create( + loc, fir::BoxType::get(builder.getI1Type())) + : builder.createBox(loc, args[3]); + + mlir::Value identity = + isStaticallyAbsent(args[4]) + ? builder.create(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(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()(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()(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()(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()(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()(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 @@ -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(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(loc, builder); + else if (eleTy == fir::ComplexType::get(ctx, 3)) + func = + fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy == fir::ComplexType::get(ctx, 4)) + func = + fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy == fir::ComplexType::get(ctx, 8)) + func = + fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy == fir::ComplexType::get(ctx, 10)) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy == fir::ComplexType::get(ctx, 16)) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 1) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 2) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (fir::isa_char(eleTy) && charHelper.getCharacterKind(eleTy) == 4) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (fir::isa_derived(eleTy)) + func = + fir::runtime::getRuntimeFunc(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(loc, fTy.getInput(2), operation); + auto args = fir::runtime::createArguments( + builder, loc, fTy, resultBox, arrayBox, opAddr, sourceFile, sourceLine, + dim, maskBox, identity, ordered); + builder.create(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(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(eleTy)) && + "expect real, interger or logical"); + + if (eleTy.isF16()) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isBF16()) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isF32()) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isF64()) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isF80()) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isF128()) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1))) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2))) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4))) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8))) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16))) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy == fir::LogicalType::get(ctx, 1)) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy == fir::LogicalType::get(ctx, 2)) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy == fir::LogicalType::get(ctx, 4)) + func = fir::runtime::getRuntimeFunc(loc, builder); + else if (eleTy == fir::LogicalType::get(ctx, 8)) + func = fir::runtime::getRuntimeFunc(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(loc, fTy.getInput(1), operation); + auto args = fir::runtime::createArguments(builder, loc, fTy, arrayBox, opAddr, + sourceFile, sourceLine, dim, + maskBox, identity, ordered); + return builder.create(loc, func, args).getResult(0); +} 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/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 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; 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.bindc_name = "a"}, %[[ARG1:.*]]: !fir.ref {fir.bindc_name = "id"}) +! CHECK: %[[A:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs, uniq_name = "_QMreduce_modFinteger1Ea"} : (!fir.box>, !fir.dscope) -> (!fir.box>, !fir.box>) +! CHECK: %[[ID:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %{{.*}} {uniq_name = "_QMreduce_modFinteger1Eid"} : (!fir.ref, !fir.dscope) -> (!fir.ref, !fir.ref) +! 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) -> (!fir.ref, !fir.ref) +! CHECK: %[[ADDR_OP:.*]] = fir.address_of(@_QMreduce_modPred_int1) : (!fir.ref, !fir.ref) -> i8 +! CHECK: %[[BOX_PROC:.*]] = fir.emboxproc %[[ADDR_OP]] : ((!fir.ref, !fir.ref) -> i8) -> !fir.boxproc<() -> ()> +! CHECK: %[[MASK:.*]] = fir.absent !fir.box +! CHECK: %[[IDENTITY:.*]] = fir.absent !fir.ref +! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX_PROC]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref, !fir.ref) -> !fir.ref) +! CHECK: %[[A_NONE:.*]] = fir.convert %[[A]]#1 : (!fir.box>) -> !fir.box +! CHECK: %[[MASK_NONE:.*]] = fir.convert %[[MASK]] : (!fir.box) -> !fir.box +! CHECK: %[[REDUCE_RES:.*]] = fir.call @_FortranAReduceInteger1(%[[A_NONE]], %[[BOX_ADDR]], %{{.*}}, %{{.*}}, %c1{{.*}}, %[[MASK_NONE]], %[[IDENTITY]], %false) fastmath : (!fir.box, (!fir.ref, !fir.ref) -> !fir.ref, !fir.ref, i32, i32, !fir.box, !fir.ref, i1) -> i8 +! CHECK: hlfir.assign %[[REDUCE_RES]] to %[[RES]]#0 : i8, !fir.ref +! CHECK: %[[ADDR_OP:.*]] = fir.address_of(@_QMreduce_modPred_int1) : (!fir.ref, !fir.ref) -> i8 +! CHECK: %[[BOX_PROC:.*]] = fir.emboxproc %[[ADDR_OP]] : ((!fir.ref, !fir.ref) -> i8) -> !fir.boxproc<() -> ()> +! CHECK: %[[MASK:.*]] = fir.absent !fir.box +! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX_PROC]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref, !fir.ref) -> !fir.ref) +! CHECK: %[[A_NONE:.*]] = fir.convert %[[A]]#1 : (!fir.box>) -> !fir.box +! CHECK: %[[MASK_NONE:.*]] = fir.convert %[[MASK]] : (!fir.box) -> !fir.box +! CHECK: %{{.*}} = fir.call @_FortranAReduceInteger1(%[[A_NONE]], %[[BOX_ADDR]], %{{.*}}, %{{.*}}, %c1{{.*}}, %[[MASK_NONE]], %[[ID]]#1, %false{{.*}}) fastmath : (!fir.box, (!fir.ref, !fir.ref) -> !fir.ref, !fir.ref, i32, i32, !fir.box, !fir.ref, i1) -> i8 +! CHECK: fir.call @_FortranAReduceInteger1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}#1, %true) +! CHECK: %[[MASK:.*]]:2 = hlfir.declare %{{.*}}(%{{.*}}) {fortran_attrs = #fir.var_attrs, uniq_name = "_QQro.3xl4.0"} : (!fir.ref>>, !fir.shape<1>) -> (!fir.ref>>, !fir.ref>>) +! CHECK: %[[SHAPE_C3:.*]] = fir.shape %c3{{.*}} : (index) -> !fir.shape<1> +! CHECK: %[[BOXED_MASK:.*]] = fir.embox %[[MASK]]#1(%[[SHAPE_C3]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> +! CHECK: %[[CONV_MASK:.*]] = fir.convert %[[BOXED_MASK]] : (!fir.box>>) -> !fir.box +! 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