| //===-- HlfirIntrinsics.cpp -----------------------------------------------===// |
| // |
| // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
| // See https://llvm.org/LICENSE.txt for license information. |
| // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
| // |
| //===----------------------------------------------------------------------===// |
| // |
| // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ |
| // |
| //===----------------------------------------------------------------------===// |
| |
| #include "flang/Lower/HlfirIntrinsics.h" |
| |
| #include "flang/Optimizer/Builder/BoxValue.h" |
| #include "flang/Optimizer/Builder/FIRBuilder.h" |
| #include "flang/Optimizer/Builder/HLFIRTools.h" |
| #include "flang/Optimizer/Builder/IntrinsicCall.h" |
| #include "flang/Optimizer/Builder/MutableBox.h" |
| #include "flang/Optimizer/Builder/Todo.h" |
| #include "flang/Optimizer/Dialect/FIRType.h" |
| #include "flang/Optimizer/HLFIR/HLFIRDialect.h" |
| #include "flang/Optimizer/HLFIR/HLFIROps.h" |
| #include "mlir/IR/Value.h" |
| #include "llvm/ADT/SmallVector.h" |
| #include <mlir/IR/ValueRange.h> |
| |
| namespace { |
| |
| class HlfirTransformationalIntrinsic { |
| public: |
| explicit HlfirTransformationalIntrinsic(fir::FirOpBuilder &builder, |
| mlir::Location loc) |
| : builder(builder), loc(loc) {} |
| |
| virtual ~HlfirTransformationalIntrinsic() = default; |
| |
| hlfir::EntityWithAttributes |
| lower(const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) { |
| mlir::Value res = lowerImpl(loweredActuals, argLowering, stmtResultType); |
| for (const hlfir::CleanupFunction &fn : cleanupFns) |
| fn(); |
| return {hlfir::EntityWithAttributes{res}}; |
| } |
| |
| protected: |
| fir::FirOpBuilder &builder; |
| mlir::Location loc; |
| llvm::SmallVector<hlfir::CleanupFunction, 3> cleanupFns; |
| |
| virtual mlir::Value |
| lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) = 0; |
| |
| llvm::SmallVector<mlir::Value> getOperandVector( |
| const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering); |
| |
| mlir::Type computeResultType(mlir::Value argArray, mlir::Type stmtResultType); |
| |
| template <typename OP, typename... BUILD_ARGS> |
| inline OP createOp(BUILD_ARGS... args) { |
| return builder.create<OP>(loc, args...); |
| } |
| |
| mlir::Value loadBoxAddress( |
| const std::optional<Fortran::lower::PreparedActualArgument> &arg); |
| |
| void addCleanup(std::optional<hlfir::CleanupFunction> cleanup) { |
| if (cleanup) |
| cleanupFns.emplace_back(std::move(*cleanup)); |
| } |
| }; |
| |
| template <typename OP, bool HAS_MASK> |
| class HlfirReductionIntrinsic : public HlfirTransformationalIntrinsic { |
| public: |
| using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic; |
| |
| protected: |
| mlir::Value |
| lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) override; |
| }; |
| using HlfirSumLowering = HlfirReductionIntrinsic<hlfir::SumOp, true>; |
| using HlfirProductLowering = HlfirReductionIntrinsic<hlfir::ProductOp, true>; |
| using HlfirMaxvalLowering = HlfirReductionIntrinsic<hlfir::MaxvalOp, true>; |
| using HlfirMinvalLowering = HlfirReductionIntrinsic<hlfir::MinvalOp, true>; |
| using HlfirAnyLowering = HlfirReductionIntrinsic<hlfir::AnyOp, false>; |
| using HlfirAllLowering = HlfirReductionIntrinsic<hlfir::AllOp, false>; |
| |
| template <typename OP> |
| class HlfirMinMaxLocIntrinsic : public HlfirTransformationalIntrinsic { |
| public: |
| using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic; |
| |
| protected: |
| mlir::Value |
| lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) override; |
| }; |
| using HlfirMinlocLowering = HlfirMinMaxLocIntrinsic<hlfir::MinlocOp>; |
| using HlfirMaxlocLowering = HlfirMinMaxLocIntrinsic<hlfir::MaxlocOp>; |
| |
| template <typename OP> |
| class HlfirProductIntrinsic : public HlfirTransformationalIntrinsic { |
| public: |
| using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic; |
| |
| protected: |
| mlir::Value |
| lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) override; |
| }; |
| using HlfirMatmulLowering = HlfirProductIntrinsic<hlfir::MatmulOp>; |
| using HlfirDotProductLowering = HlfirProductIntrinsic<hlfir::DotProductOp>; |
| |
| class HlfirTransposeLowering : public HlfirTransformationalIntrinsic { |
| public: |
| using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic; |
| |
| protected: |
| mlir::Value |
| lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) override; |
| }; |
| |
| class HlfirCountLowering : public HlfirTransformationalIntrinsic { |
| public: |
| using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic; |
| |
| protected: |
| mlir::Value |
| lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) override; |
| }; |
| |
| class HlfirCharExtremumLowering : public HlfirTransformationalIntrinsic { |
| public: |
| HlfirCharExtremumLowering(fir::FirOpBuilder &builder, mlir::Location loc, |
| hlfir::CharExtremumPredicate pred) |
| : HlfirTransformationalIntrinsic(builder, loc), pred{pred} {} |
| |
| protected: |
| mlir::Value |
| lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) override; |
| |
| protected: |
| hlfir::CharExtremumPredicate pred; |
| }; |
| |
| } // namespace |
| |
| mlir::Value HlfirTransformationalIntrinsic::loadBoxAddress( |
| const std::optional<Fortran::lower::PreparedActualArgument> &arg) { |
| if (!arg) |
| return mlir::Value{}; |
| |
| hlfir::Entity actual = arg->getActual(loc, builder); |
| |
| if (!arg->handleDynamicOptional()) { |
| if (actual.isMutableBox()) { |
| // this is a box address type but is not dynamically optional. Just load |
| // the box, assuming it is well formed (!fir.ref<!fir.box<...>> -> |
| // !fir.box<...>) |
| return builder.create<fir::LoadOp>(loc, actual.getBase()); |
| } |
| return actual; |
| } |
| |
| auto [exv, cleanup] = hlfir::translateToExtendedValue(loc, builder, actual); |
| addCleanup(cleanup); |
| |
| mlir::Value isPresent = arg->getIsPresent(); |
| // createBox will not do create any invalid memory dereferences if exv is |
| // absent. The created fir.box will not be usable, but the SelectOp below |
| // ensures it won't be. |
| mlir::Value box = builder.createBox(loc, exv); |
| mlir::Type boxType = box.getType(); |
| auto absent = builder.create<fir::AbsentOp>(loc, boxType); |
| auto boxOrAbsent = builder.create<mlir::arith::SelectOp>( |
| loc, boxType, isPresent, box, absent); |
| |
| return boxOrAbsent; |
| } |
| |
| static mlir::Value loadOptionalValue( |
| mlir::Location loc, fir::FirOpBuilder &builder, |
| const std::optional<Fortran::lower::PreparedActualArgument> &arg, |
| hlfir::Entity actual) { |
| if (!arg->handleDynamicOptional()) |
| return hlfir::loadTrivialScalar(loc, builder, actual); |
| |
| mlir::Value isPresent = arg->getIsPresent(); |
| mlir::Type eleType = hlfir::getFortranElementType(actual.getType()); |
| return builder |
| .genIfOp(loc, {eleType}, isPresent, |
| /*withElseRegion=*/true) |
| .genThen([&]() { |
| assert(actual.isScalar() && fir::isa_trivial(eleType) && |
| "must be a numerical or logical scalar"); |
| hlfir::Entity val = hlfir::loadTrivialScalar(loc, builder, actual); |
| builder.create<fir::ResultOp>(loc, val); |
| }) |
| .genElse([&]() { |
| mlir::Value zero = fir::factory::createZeroValue(builder, loc, eleType); |
| builder.create<fir::ResultOp>(loc, zero); |
| }) |
| .getResults()[0]; |
| } |
| |
| llvm::SmallVector<mlir::Value> HlfirTransformationalIntrinsic::getOperandVector( |
| const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering) { |
| llvm::SmallVector<mlir::Value> operands; |
| operands.reserve(loweredActuals.size()); |
| |
| for (size_t i = 0; i < loweredActuals.size(); ++i) { |
| std::optional<Fortran::lower::PreparedActualArgument> arg = |
| loweredActuals[i]; |
| if (!arg) { |
| operands.emplace_back(); |
| continue; |
| } |
| hlfir::Entity actual = arg->getActual(loc, builder); |
| mlir::Value valArg; |
| |
| if (!argLowering) { |
| valArg = hlfir::loadTrivialScalar(loc, builder, actual); |
| } else { |
| fir::ArgLoweringRule argRules = |
| fir::lowerIntrinsicArgumentAs(*argLowering, i); |
| if (argRules.lowerAs == fir::LowerIntrinsicArgAs::Box) |
| valArg = loadBoxAddress(arg); |
| else if (!argRules.handleDynamicOptional && |
| argRules.lowerAs != fir::LowerIntrinsicArgAs::Inquired) |
| valArg = hlfir::derefPointersAndAllocatables(loc, builder, actual); |
| else if (argRules.handleDynamicOptional && |
| argRules.lowerAs == fir::LowerIntrinsicArgAs::Value) |
| valArg = loadOptionalValue(loc, builder, arg, actual); |
| else if (argRules.handleDynamicOptional) |
| TODO(loc, "hlfir transformational intrinsic dynamically optional " |
| "argument without box lowering"); |
| else |
| valArg = actual.getBase(); |
| } |
| |
| operands.emplace_back(valArg); |
| } |
| return operands; |
| } |
| |
| mlir::Type |
| HlfirTransformationalIntrinsic::computeResultType(mlir::Value argArray, |
| mlir::Type stmtResultType) { |
| mlir::Type normalisedResult = |
| hlfir::getFortranElementOrSequenceType(stmtResultType); |
| if (auto array = mlir::dyn_cast<fir::SequenceType>(normalisedResult)) { |
| hlfir::ExprType::Shape resultShape = |
| hlfir::ExprType::Shape{array.getShape()}; |
| mlir::Type elementType = array.getEleTy(); |
| return hlfir::ExprType::get(builder.getContext(), resultShape, elementType, |
| /*polymorphic=*/false); |
| } else if (auto resCharType = |
| mlir::dyn_cast<fir::CharacterType>(stmtResultType)) { |
| normalisedResult = hlfir::ExprType::get( |
| builder.getContext(), hlfir::ExprType::Shape{}, resCharType, false); |
| } |
| return normalisedResult; |
| } |
| |
| template <typename OP, bool HAS_MASK> |
| mlir::Value HlfirReductionIntrinsic<OP, HAS_MASK>::lowerImpl( |
| const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) { |
| auto operands = getOperandVector(loweredActuals, argLowering); |
| mlir::Value array = operands[0]; |
| mlir::Value dim = operands[1]; |
| // dim, mask can be NULL if these arguments are not given |
| if (dim) |
| dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim}); |
| |
| mlir::Type resultTy = computeResultType(array, stmtResultType); |
| |
| OP op; |
| if constexpr (HAS_MASK) |
| op = createOp<OP>(resultTy, array, dim, |
| /*mask=*/operands[2]); |
| else |
| op = createOp<OP>(resultTy, array, dim); |
| return op; |
| } |
| |
| template <typename OP> |
| mlir::Value HlfirMinMaxLocIntrinsic<OP>::lowerImpl( |
| const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) { |
| auto operands = getOperandVector(loweredActuals, argLowering); |
| mlir::Value array = operands[0]; |
| mlir::Value dim = operands[1]; |
| mlir::Value mask = operands[2]; |
| mlir::Value back = operands[4]; |
| // dim, mask and back can be NULL if these arguments are not given. |
| if (dim) |
| dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim}); |
| if (back) |
| back = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{back}); |
| |
| mlir::Type resultTy = computeResultType(array, stmtResultType); |
| |
| return createOp<OP>(resultTy, array, dim, mask, back); |
| } |
| |
| template <typename OP> |
| mlir::Value HlfirProductIntrinsic<OP>::lowerImpl( |
| const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) { |
| auto operands = getOperandVector(loweredActuals, argLowering); |
| mlir::Type resultType = computeResultType(operands[0], stmtResultType); |
| return createOp<OP>(resultType, operands[0], operands[1]); |
| } |
| |
| mlir::Value HlfirTransposeLowering::lowerImpl( |
| const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) { |
| auto operands = getOperandVector(loweredActuals, argLowering); |
| hlfir::ExprType::Shape resultShape; |
| mlir::Type normalisedResult = |
| hlfir::getFortranElementOrSequenceType(stmtResultType); |
| auto array = mlir::cast<fir::SequenceType>(normalisedResult); |
| llvm::ArrayRef<int64_t> arrayShape = array.getShape(); |
| assert(arrayShape.size() == 2 && "arguments to transpose have a rank of 2"); |
| mlir::Type elementType = array.getEleTy(); |
| resultShape.push_back(arrayShape[0]); |
| resultShape.push_back(arrayShape[1]); |
| if (auto resCharType = mlir::dyn_cast<fir::CharacterType>(elementType)) |
| if (!resCharType.hasConstantLen()) { |
| // The FunctionRef expression might have imprecise character |
| // type at this point, and we can improve it by propagating |
| // the constant length from the argument. |
| auto argCharType = mlir::dyn_cast<fir::CharacterType>( |
| hlfir::getFortranElementType(operands[0].getType())); |
| if (argCharType && argCharType.hasConstantLen()) |
| elementType = fir::CharacterType::get( |
| builder.getContext(), resCharType.getFKind(), argCharType.getLen()); |
| } |
| |
| mlir::Type resultTy = |
| hlfir::ExprType::get(builder.getContext(), resultShape, elementType, |
| fir::isPolymorphicType(stmtResultType)); |
| return createOp<hlfir::TransposeOp>(resultTy, operands[0]); |
| } |
| |
| mlir::Value HlfirCountLowering::lowerImpl( |
| const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) { |
| auto operands = getOperandVector(loweredActuals, argLowering); |
| mlir::Value array = operands[0]; |
| mlir::Value dim = operands[1]; |
| if (dim) |
| dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim}); |
| mlir::Type resultType = computeResultType(array, stmtResultType); |
| return createOp<hlfir::CountOp>(resultType, array, dim); |
| } |
| |
| mlir::Value HlfirCharExtremumLowering::lowerImpl( |
| const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) { |
| auto operands = getOperandVector(loweredActuals, argLowering); |
| assert(operands.size() >= 2); |
| return createOp<hlfir::CharExtremumOp>(pred, mlir::ValueRange{operands}); |
| } |
| |
| std::optional<hlfir::EntityWithAttributes> Fortran::lower::lowerHlfirIntrinsic( |
| fir::FirOpBuilder &builder, mlir::Location loc, const std::string &name, |
| const Fortran::lower::PreparedActualArguments &loweredActuals, |
| const fir::IntrinsicArgumentLoweringRules *argLowering, |
| mlir::Type stmtResultType) { |
| // If the result is of a derived type that may need finalization, |
| // we have to use DestroyOp with 'finalize' attribute for the result |
| // of the intrinsic operation. |
| if (name == "sum") |
| return HlfirSumLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (name == "product") |
| return HlfirProductLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (name == "any") |
| return HlfirAnyLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (name == "all") |
| return HlfirAllLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (name == "matmul") |
| return HlfirMatmulLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (name == "dot_product") |
| return HlfirDotProductLowering{builder, loc}.lower( |
| loweredActuals, argLowering, stmtResultType); |
| // FIXME: the result may need finalization. |
| if (name == "transpose") |
| return HlfirTransposeLowering{builder, loc}.lower( |
| loweredActuals, argLowering, stmtResultType); |
| if (name == "count") |
| return HlfirCountLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (name == "maxval") |
| return HlfirMaxvalLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (name == "minval") |
| return HlfirMinvalLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (name == "minloc") |
| return HlfirMinlocLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (name == "maxloc") |
| return HlfirMaxlocLowering{builder, loc}.lower(loweredActuals, argLowering, |
| stmtResultType); |
| if (mlir::isa<fir::CharacterType>(stmtResultType)) { |
| if (name == "min") |
| return HlfirCharExtremumLowering{builder, loc, |
| hlfir::CharExtremumPredicate::min} |
| .lower(loweredActuals, argLowering, stmtResultType); |
| if (name == "max") |
| return HlfirCharExtremumLowering{builder, loc, |
| hlfir::CharExtremumPredicate::max} |
| .lower(loweredActuals, argLowering, stmtResultType); |
| } |
| return std::nullopt; |
| } |
