diff --git a/flang/include/flang/Lower/ConvertExprToHLFIR.h b/flang/include/flang/Lower/ConvertExprToHLFIR.h --- a/flang/include/flang/Lower/ConvertExprToHLFIR.h +++ b/flang/include/flang/Lower/ConvertExprToHLFIR.h @@ -39,7 +39,7 @@ inline fir::ExtendedValue translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder, - hlfir::EntityWithAttributes entity, + hlfir::Entity entity, Fortran::lower::StatementContext &context) { auto [exv, exvCleanup] = hlfir::translateToExtendedValue(loc, builder, entity); @@ -48,18 +48,41 @@ return exv; } +/// Lower an evaluate::Expr to a fir::Box. fir::BoxValue convertExprToBox(mlir::Location loc, Fortran::lower::AbstractConverter &, const Fortran::lower::SomeExpr &, Fortran::lower::SymMap &, Fortran::lower::StatementContext &); +fir::BoxValue convertToBox(mlir::Location loc, + Fortran::lower::AbstractConverter &, + hlfir::Entity entity, + Fortran::lower::StatementContext &); -// Probably not what you think. +/// Lower an evaluate::Expr to fir::ExtendedValue raw address. +/// Beware that this will create a temporary for non simply contiguous +/// designator expressions. fir::ExtendedValue convertExprToAddress(mlir::Location loc, Fortran::lower::AbstractConverter &, const Fortran::lower::SomeExpr &, Fortran::lower::SymMap &, Fortran::lower::StatementContext &); +fir::ExtendedValue convertToAddress(mlir::Location loc, + Fortran::lower::AbstractConverter &, + hlfir::Entity entity, + bool isSimplyContiguous, + Fortran::lower::StatementContext &); + +/// Lower an evaluate::Expr to a fir::ExtendedValue value. +fir::ExtendedValue convertExprToValue(mlir::Location loc, + Fortran::lower::AbstractConverter &, + const Fortran::lower::SomeExpr &, + Fortran::lower::SymMap &, + Fortran::lower::StatementContext &); +fir::ExtendedValue convertToValue(mlir::Location loc, + Fortran::lower::AbstractConverter &, + hlfir::Entity entity, + Fortran::lower::StatementContext &); } // namespace Fortran::lower #endif // FORTRAN_LOWER_CONVERTEXPRTOHLFIR_H diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -112,12 +112,14 @@ return false; if (isMutableBox()) return true; - if (auto varIface = getIfVariableInterface()) + if (auto varIface = getIfVariableInterface()) { if (auto shape = varIface.getShape()) { auto shapeTy = shape.getType(); return shapeTy.isa() || shapeTy.isa(); } + return false; + } return true; } diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -489,35 +489,9 @@ Fortran::lower::StatementContext &context, mlir::Location *locPtr = nullptr) override final { mlir::Location loc = locPtr ? *locPtr : toLocation(); - if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) { - hlfir::EntityWithAttributes loweredExpr = - Fortran::lower::convertExprToHLFIR(loc, *this, expr, localSymbols, - context); - fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue( - loc, getFirOpBuilder(), loweredExpr, context); - // Load scalar references to integer, logical, real, or complex value - // to an mlir value, dereference allocatable and pointers, and get rid - // of fir.box that are no needed or create a copy into contiguous memory. - return exv.match( - [&](const fir::UnboxedValue &box) -> fir::ExtendedValue { - if (mlir::Type elementType = fir::dyn_cast_ptrEleTy(box.getType())) - if (fir::isa_trivial(elementType)) - return getFirOpBuilder().create(loc, box); - return box; - }, - [&](const fir::CharBoxValue &box) -> fir::ExtendedValue { - return box; - }, - [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue { - return box; - }, - [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue { - return box; - }, - [&](const auto &) -> fir::ExtendedValue { - TODO(loc, "lower descriptor designator to HLFIR value"); - }); - } + if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) + return Fortran::lower::convertExprToValue(loc, *this, expr, localSymbols, + context); return Fortran::lower::createSomeExtendedExpression(loc, *this, expr, localSymbols, context); } diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -657,134 +657,52 @@ return extendedValueToHlfirEntity(loc, builder, result, ".tmp.func_result"); } -/// Lower calls to elemental user procedure with array actual arguments. -static std::optional -genElementalUserCall(PreparedActualArguments &loweredActuals, - Fortran::lower::CallerInterface &caller, - mlir::FunctionType callSiteType, bool isImpure, - CallContext &callContext) { - using PassBy = Fortran::lower::CallerInterface::PassEntityBy; - mlir::Location loc = callContext.loc; - fir::FirOpBuilder &builder = callContext.getBuilder(); - assert(loweredActuals.size() == caller.getPassedArguments().size()); - unsigned numArgs = loweredActuals.size(); - // Step 1: dereference pointers/allocatables and compute elemental shape. - mlir::Value shape; - // 10.1.4 p5. Impure elemental procedures must be called in element order. - bool mustBeOrdered = isImpure; - for (unsigned i = 0; i < numArgs; ++i) { - const auto &arg = caller.getPassedArguments()[i]; - auto &preparedActual = loweredActuals[i]; - if (preparedActual) { - hlfir::Entity &actual = preparedActual->actual; - // Elemental procedure dummy arguments cannot be pointer/allocatables - // (C15100), so it is safe to dereference any pointer or allocatable - // actual argument now instead of doing this inside the elemental - // region. - actual = hlfir::derefPointersAndAllocatables(loc, builder, actual); - // Better to load scalars outside of the loop when possible. - if (!preparedActual->handleDynamicOptional && - (arg.passBy == PassBy::Value || - arg.passBy == PassBy::BaseAddressValueAttribute)) - actual = hlfir::loadTrivialScalar(loc, builder, actual); - // TODO: merge shape instead of using the first one. - if (!shape && actual.isArray()) { - if (preparedActual->handleDynamicOptional) - TODO(loc, "deal with optional with shapes in HLFIR elemental call"); - shape = hlfir::genShape(loc, builder, actual); - } - // 15.8.3 p1. Elemental procedure with intent(out)/intent(inout) - // arguments must be called in element order. - if (arg.mayBeModifiedByCall()) - mustBeOrdered = true; - } - } - assert(shape && - "elemental array calls must have at least one array arguments"); - if (mustBeOrdered) - TODO(loc, "ordered elemental calls in HLFIR"); - if (!callContext.resultType) { - // Subroutine case. Generate call inside loop nest. - auto [innerLoop, oneBasedIndices] = hlfir::genLoopNest(loc, builder, shape); - auto insPt = builder.saveInsertionPoint(); - builder.setInsertionPointToStart(innerLoop.getBody()); - for (auto &preparedActual : loweredActuals) - if (preparedActual) - preparedActual->actual = hlfir::getElementAt( - loc, builder, preparedActual->actual, oneBasedIndices); - genUserCall(loweredActuals, caller, callSiteType, callContext); - builder.restoreInsertionPoint(insPt); - return std::nullopt; - } - // Function case: generate call inside hlfir.elemental - mlir::Type elementType = - hlfir::getFortranElementType(*callContext.resultType); - // Get result length parameters. - llvm::SmallVector typeParams; - if (elementType.isa() || - fir::isRecordWithTypeParameters(elementType)) - TODO(loc, "compute elemental function result length parameters in HLFIR"); - auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b, - mlir::ValueRange oneBasedIndices) -> hlfir::Entity { - for (auto &preparedActual : loweredActuals) - if (preparedActual) - preparedActual->actual = - hlfir::getElementAt(l, b, preparedActual->actual, oneBasedIndices); - return *genUserCall(loweredActuals, caller, callSiteType, callContext); - }; - // TODO: deal with hlfir.elemental result destruction. - return hlfir::EntityWithAttributes{hlfir::genElementalOp( - loc, builder, elementType, shape, typeParams, genKernel)}; -} - -/// Lower an intrinsic procedure reference. -static hlfir::EntityWithAttributes -genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic &intrinsic, - CallContext &callContext) { - mlir::Location loc = callContext.loc; - auto &converter = callContext.converter; - auto &stmtCtx = callContext.stmtCtx; - if (Fortran::lower::intrinsicRequiresCustomOptionalHandling( - callContext.procRef, intrinsic, converter)) - TODO(loc, "special cases of intrinsic with optional arguments"); - if (callContext.isElementalProcWithArrayArgs()) - TODO(loc, "lowering elemental intrinsic call to HLFIR"); - +/// Lower calls to intrinsic procedures with actual arguments that have been +/// pre-lowered but have not yet been prepared according to the interface. +static hlfir::EntityWithAttributes genIntrinsicRefCore( + PreparedActualArguments &loweredActuals, + const Fortran::evaluate::SpecificIntrinsic &intrinsic, + const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering, + std::optional coreResultType, CallContext &callContext) { llvm::SmallVector operands; - // Lower arguments to ... hlfir::Entity. - // Create elem context. - // Call inside code. - const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering = - Fortran::lower::getIntrinsicArgumentLowering(intrinsic.name); - for (const auto &arg : llvm::enumerate(callContext.procRef.arguments())) { - auto *expr = - Fortran::evaluate::UnwrapExpr(arg.value()); - if (!expr) { - // Absent optional. + auto &stmtCtx = callContext.stmtCtx; + auto &converter = callContext.converter; + mlir::Location loc = callContext.loc; + for (auto arg : llvm::enumerate(loweredActuals)) { + if (!arg.value()) { operands.emplace_back(Fortran::lower::getAbsentIntrinsicArgument()); continue; } + hlfir::Entity actual = arg.value()->actual; + if (arg.value()->handleDynamicOptional) + TODO(loc, "intrinsic dynamically optional arguments"); if (!argLowering) { // No argument lowering instruction, lower by value. - operands.emplace_back(converter.genExprValue(loc, *expr, stmtCtx)); + operands.emplace_back( + Fortran::lower::convertToValue(loc, converter, actual, stmtCtx)); continue; } // Ad-hoc argument lowering handling. Fortran::lower::ArgLoweringRule argRules = Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index()); - if (argRules.handleDynamicOptional && - Fortran::evaluate::MayBePassedAsAbsentOptional( - *expr, converter.getFoldingContext())) - TODO(loc, "intrinsic dynamically optional arguments"); switch (argRules.lowerAs) { case Fortran::lower::LowerIntrinsicArgAs::Value: - operands.emplace_back(converter.genExprValue(loc, *expr, stmtCtx)); + operands.emplace_back( + Fortran::lower::convertToValue(loc, converter, actual, stmtCtx)); continue; - case Fortran::lower::LowerIntrinsicArgAs::Addr: - operands.emplace_back(converter.genExprAddr(loc, *expr, stmtCtx)); + case Fortran::lower::LowerIntrinsicArgAs::Addr: { + const auto *argExpr = callContext.procRef.UnwrapArgExpr(arg.index()); + bool isSimplyContiguous = + actual.isScalar() || + (argExpr && Fortran::evaluate::IsSimplyContiguous( + *argExpr, converter.getFoldingContext())); + operands.emplace_back(Fortran::lower::convertToAddress( + loc, converter, actual, isSimplyContiguous, stmtCtx)); continue; + } case Fortran::lower::LowerIntrinsicArgAs::Box: - operands.emplace_back(converter.genExprBox(loc, *expr, stmtCtx)); + operands.emplace_back( + Fortran::lower::convertToBox(loc, converter, actual, stmtCtx)); continue; case Fortran::lower::LowerIntrinsicArgAs::Inquired: TODO(loc, "as inquired arguments in HLFIR"); @@ -794,12 +712,215 @@ } // Let the intrinsic library lower the intrinsic procedure call. fir::ExtendedValue val = Fortran::lower::genIntrinsicCall( - callContext.getBuilder(), loc, intrinsic.name, callContext.resultType, - operands, stmtCtx); + callContext.getBuilder(), loc, intrinsic.name, coreResultType, operands, + stmtCtx); return extendedValueToHlfirEntity(loc, callContext.getBuilder(), val, ".tmp.intrinsic_result"); } +namespace { +template +class ElementalCallBuilder { +public: + std::optional + genElementalCall(PreparedActualArguments &loweredActuals, bool isImpure, + CallContext &callContext) { + mlir::Location loc = callContext.loc; + fir::FirOpBuilder &builder = callContext.getBuilder(); + unsigned numArgs = loweredActuals.size(); + // Step 1: dereference pointers/allocatables and compute elemental shape. + mlir::Value shape; + // 10.1.4 p5. Impure elemental procedures must be called in element order. + bool mustBeOrdered = isImpure; + for (unsigned i = 0; i < numArgs; ++i) { + auto &preparedActual = loweredActuals[i]; + if (preparedActual) { + hlfir::Entity &actual = preparedActual->actual; + // Elemental procedure dummy arguments cannot be pointer/allocatables + // (C15100), so it is safe to dereference any pointer or allocatable + // actual argument now instead of doing this inside the elemental + // region. + actual = hlfir::derefPointersAndAllocatables(loc, builder, actual); + // Better to load scalars outside of the loop when possible. + if (!preparedActual->handleDynamicOptional && + impl().canLoadActualArgumentBeforeLoop(i)) + actual = hlfir::loadTrivialScalar(loc, builder, actual); + // TODO: merge shape instead of using the first one. + if (!shape && actual.isArray()) { + if (preparedActual->handleDynamicOptional) + TODO(loc, "deal with optional with shapes in HLFIR elemental call"); + shape = hlfir::genShape(loc, builder, actual); + } + // 15.8.3 p1. Elemental procedure with intent(out)/intent(inout) + // arguments must be called in element order. + if (impl().argMayBeModifiedByCall(i)) + mustBeOrdered = true; + } + } + assert(shape && + "elemental array calls must have at least one array arguments"); + if (mustBeOrdered) + TODO(loc, "ordered elemental calls in HLFIR"); + // Push a new local scope so that any temps made inside the elemental + // iterations are cleaned up inside the iterations. + callContext.stmtCtx.pushScope(); + if (!callContext.resultType) { + // Subroutine case. Generate call inside loop nest. + auto [innerLoop, oneBasedIndices] = + hlfir::genLoopNest(loc, builder, shape); + auto insPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(innerLoop.getBody()); + for (auto &preparedActual : loweredActuals) + if (preparedActual) + preparedActual->actual = hlfir::getElementAt( + loc, builder, preparedActual->actual, oneBasedIndices); + impl().genElementalKernel(loweredActuals, callContext); + callContext.stmtCtx.finalizeAndPop(); + builder.restoreInsertionPoint(insPt); + return std::nullopt; + } + // Function case: generate call inside hlfir.elemental + mlir::Type elementType = + hlfir::getFortranElementType(*callContext.resultType); + // Get result length parameters. + llvm::SmallVector typeParams; + if (elementType.isa() || + fir::isRecordWithTypeParameters(elementType)) + TODO(loc, "compute elemental function result length parameters in HLFIR"); + auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b, + mlir::ValueRange oneBasedIndices) -> hlfir::Entity { + for (auto &preparedActual : loweredActuals) + if (preparedActual) + preparedActual->actual = hlfir::getElementAt( + l, b, preparedActual->actual, oneBasedIndices); + auto res = *impl().genElementalKernel(loweredActuals, callContext); + callContext.stmtCtx.finalizeAndPop(); + return res; + }; + // TODO: deal with hlfir.elemental result destruction. + return hlfir::EntityWithAttributes{hlfir::genElementalOp( + loc, builder, elementType, shape, typeParams, genKernel)}; + } + +private: + ElementalCallBuilderImpl &impl() { + return *static_cast(this); + } +}; + +class ElementalUserCallBuilder + : public ElementalCallBuilder { +public: + ElementalUserCallBuilder(Fortran::lower::CallerInterface &caller, + mlir::FunctionType callSiteType) + : caller{caller}, callSiteType{callSiteType} {} + std::optional + genElementalKernel(PreparedActualArguments &loweredActuals, + CallContext &callContext) { + return genUserCall(loweredActuals, caller, callSiteType, callContext); + } + + bool argMayBeModifiedByCall(unsigned argIdx) const { + assert(argIdx < caller.getPassedArguments().size() && "bad argument index"); + return caller.getPassedArguments()[argIdx].mayBeModifiedByCall(); + } + + bool canLoadActualArgumentBeforeLoop(unsigned argIdx) const { + using PassBy = Fortran::lower::CallerInterface::PassEntityBy; + assert(argIdx < caller.getPassedArguments().size() && "bad argument index"); + // If the actual argument does not need to be passed via an address, + // or will be passed in the address of a temporary copy, it can be loaded + // before the elemental loop nest. + const auto &arg = caller.getPassedArguments()[argIdx]; + return arg.passBy == PassBy::Value || + arg.passBy == PassBy::BaseAddressValueAttribute; + } + +private: + Fortran::lower::CallerInterface &caller; + mlir::FunctionType callSiteType; +}; + +class ElementalIntrinsicCallBuilder + : public ElementalCallBuilder { +public: + ElementalIntrinsicCallBuilder( + const Fortran::evaluate::SpecificIntrinsic &intrinsic, + const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering, + bool isFunction) + : intrinsic{intrinsic}, argLowering{argLowering}, isFunction{isFunction} { + } + std::optional + genElementalKernel(PreparedActualArguments &loweredActuals, + CallContext &callContext) { + std::optional coreResultType; + if (callContext.resultType.has_value()) + coreResultType = hlfir::getFortranElementType(*callContext.resultType); + return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering, + coreResultType, callContext); + } + // Elemental intrinsic functions cannot modify their arguments. + bool argMayBeModifiedByCall(int) const { return !isFunction; } + bool canLoadActualArgumentBeforeLoop(int) const { + // Elemental intrinsic functions never need the actual addresses + // of their arguments. + return isFunction; + } + +private: + const Fortran::evaluate::SpecificIntrinsic &intrinsic; + const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering; + const bool isFunction; +}; +} // namespace + +/// Lower an intrinsic procedure reference. +static hlfir::EntityWithAttributes +genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic &intrinsic, + CallContext &callContext) { + mlir::Location loc = callContext.loc; + auto &converter = callContext.converter; + if (Fortran::lower::intrinsicRequiresCustomOptionalHandling( + callContext.procRef, intrinsic, converter)) + TODO(loc, "special cases of intrinsic with optional arguments"); + + PreparedActualArguments loweredActuals; + const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering = + Fortran::lower::getIntrinsicArgumentLowering(intrinsic.name); + for (const auto &arg : llvm::enumerate(callContext.procRef.arguments())) { + auto *expr = + Fortran::evaluate::UnwrapExpr(arg.value()); + if (!expr) { + // Absent optional. + loweredActuals.push_back(std::nullopt); + continue; + } + auto loweredActual = Fortran::lower::convertExprToHLFIR( + loc, callContext.converter, *expr, callContext.symMap, + callContext.stmtCtx); + bool handleDynamicOptional = false; + if (argLowering) { + Fortran::lower::ArgLoweringRule argRules = + Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index()); + handleDynamicOptional = argRules.handleDynamicOptional && + Fortran::evaluate::MayBePassedAsAbsentOptional( + *expr, converter.getFoldingContext()); + } + loweredActuals.push_back( + PreparedActualArgument{loweredActual, handleDynamicOptional}); + } + + if (callContext.isElementalProcWithArrayArgs()) { + // All intrinsic elemental functions are pure. + const bool isFunction = callContext.resultType.has_value(); + return ElementalIntrinsicCallBuilder{intrinsic, argLowering, isFunction} + .genElementalCall(loweredActuals, /*isImpure=*/!isFunction, callContext) + .value(); + } + return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering, + callContext.resultType, callContext); +} + /// Main entry point to lower procedure references, regardless of what they are. static std::optional genProcedureRef(CallContext &callContext) { @@ -843,8 +964,8 @@ if (const Fortran::semantics::Symbol *procSym = callContext.procRef.proc().GetSymbol()) isImpure = !Fortran::semantics::IsPureProcedure(*procSym); - return genElementalUserCall(loweredActuals, caller, callSiteType, isImpure, - callContext); + return ElementalUserCallBuilder{caller, callSiteType}.genElementalCall( + loweredActuals, isImpure, callContext); } return genUserCall(loweredActuals, caller, callSiteType, callContext); } diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -1200,30 +1200,33 @@ return HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); } -fir::BoxValue Fortran::lower::convertExprToBox( +fir::BoxValue Fortran::lower::convertToBox( mlir::Location loc, Fortran::lower::AbstractConverter &converter, - const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, - Fortran::lower::StatementContext &stmtCtx) { - hlfir::EntityWithAttributes loweredExpr = - HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); + hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx) { auto exv = Fortran::lower::translateToExtendedValue( - loc, converter.getFirOpBuilder(), loweredExpr, stmtCtx); + loc, converter.getFirOpBuilder(), entity, stmtCtx); if (fir::isa_trivial(fir::getBase(exv).getType())) TODO(loc, "place trivial in memory"); return fir::factory::createBoxValue(converter.getFirOpBuilder(), loc, exv); } - -fir::ExtendedValue Fortran::lower::convertExprToAddress( +fir::BoxValue Fortran::lower::convertExprToBox( mlir::Location loc, Fortran::lower::AbstractConverter &converter, const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { hlfir::EntityWithAttributes loweredExpr = HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); - if (expr.Rank() > 0 && !Fortran::evaluate::IsSimplyContiguous( - expr, converter.getFoldingContext())) + return convertToBox(loc, converter, loweredExpr, stmtCtx); +} + +fir::ExtendedValue +Fortran::lower::convertToAddress(mlir::Location loc, + Fortran::lower::AbstractConverter &converter, + hlfir::Entity entity, bool isSimplyContiguous, + Fortran::lower::StatementContext &stmtCtx) { + if (!isSimplyContiguous) TODO(loc, "genExprAddr of non contiguous variables in HLFIR"); fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue( - loc, converter.getFirOpBuilder(), loweredExpr, stmtCtx); + loc, converter.getFirOpBuilder(), entity, stmtCtx); if (fir::isa_trivial(fir::getBase(exv).getType())) TODO(loc, "place trivial in memory"); if (const auto *mutableBox = exv.getBoxOf()) @@ -1231,3 +1234,50 @@ *mutableBox); return exv; } +fir::ExtendedValue Fortran::lower::convertExprToAddress( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, + Fortran::lower::StatementContext &stmtCtx) { + hlfir::EntityWithAttributes loweredExpr = + HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); + bool isSimplyContiguous = + expr.Rank() == 0 || Fortran::evaluate::IsSimplyContiguous( + expr, converter.getFoldingContext()); + return convertToAddress(loc, converter, loweredExpr, isSimplyContiguous, + stmtCtx); +} + +fir::ExtendedValue Fortran::lower::convertToValue( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx) { + auto &builder = converter.getFirOpBuilder(); + fir::ExtendedValue exv = + Fortran::lower::translateToExtendedValue(loc, builder, entity, stmtCtx); + // Load scalar references to integer, logical, real, or complex value + // to an mlir value, dereference allocatable and pointers, and get rid + // of fir.box that are not needed or create a copy into contiguous memory. + return exv.match( + [&](const fir::UnboxedValue &box) -> fir::ExtendedValue { + if (mlir::Type elementType = fir::dyn_cast_ptrEleTy(box.getType())) + if (fir::isa_trivial(elementType)) + return builder.create(loc, box); + return box; + }, + [&](const fir::CharBoxValue &box) -> fir::ExtendedValue { return box; }, + [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue { return box; }, + [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue { + return box; + }, + [&](const auto &) -> fir::ExtendedValue { + TODO(loc, "lower descriptor designator to HLFIR value"); + }); +} + +fir::ExtendedValue Fortran::lower::convertExprToValue( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, + Fortran::lower::StatementContext &stmtCtx) { + hlfir::EntityWithAttributes loweredExpr = + HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); + return convertToValue(loc, converter, loweredExpr, stmtCtx); +} diff --git a/flang/test/Lower/HLFIR/elemental-intrinsics.f90 b/flang/test/Lower/HLFIR/elemental-intrinsics.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/elemental-intrinsics.f90 @@ -0,0 +1,82 @@ +! Test lowering of intrinsic elemental procedure reference to HLFIR +! The goal here is not to test every intrinsics, it is to test the +! lowering framework for elemental intrinsics. This test various +! intrinsics that have different number or arguments and argument types. +! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s + +subroutine simple_elemental(x,y) + real :: x(100), y(100) + x = acos(y) +end subroutine +! CHECK-LABEL: func.func @_QPsimple_elemental( +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_3:[a-z0-9]*]]) {{.*}}Ex +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) {{.*}}Ey +! CHECK: %[[VAL_8:.*]] = hlfir.elemental %[[VAL_6]] : (!fir.shape<1>) -> !hlfir.expr<100xf32> { +! CHECK: ^bb0(%[[VAL_9:.*]]: index): +! CHECK: %[[VAL_10:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_9]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_10]] : !fir.ref +! CHECK: %[[VAL_12:.*]] = fir.call @acosf(%[[VAL_11]]) fastmath : (f32) -> f32 +! CHECK: hlfir.yield_element %[[VAL_12]] : f32 +! CHECK: } + +subroutine elemental_mixed_args(x,y, scalar) + real :: x(100), y(100), scalar + x = atan2(x, scalar) +end subroutine +! CHECK-LABEL: func.func @_QPelemental_mixed_args( +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2:[a-z0-9]*]] {{.*}}Escalar +! CHECK: %[[VAL_4:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_5:[a-z0-9]*]]) {{.*}}Ex +! CHECK: %[[VAL_7:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_7]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_8:[a-z0-9]*]]) {{.*}}Ey +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref +! CHECK: %[[VAL_11:.*]] = hlfir.elemental %[[VAL_5]] : (!fir.shape<1>) -> !hlfir.expr<100xf32> { +! CHECK: ^bb0(%[[VAL_12:.*]]: index): +! CHECK: %[[VAL_13:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_12]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_13]] : !fir.ref +! CHECK: %[[VAL_15:.*]] = math.atan2 %[[VAL_14]], %[[VAL_10]] fastmath : f32 +! CHECK: hlfir.yield_element %[[VAL_15]] : f32 +! CHECK: } + +subroutine elemental_assumed_shape_arg(x) + real :: x(:) + print *, sin(x) +end subroutine +! CHECK-LABEL: func.func @_QPelemental_assumed_shape_arg( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex +! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_7]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_8]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_10:.*]] = hlfir.elemental %[[VAL_9]] : (!fir.shape<1>) -> !hlfir.expr { +! CHECK: ^bb0(%[[VAL_11:.*]]: index): +! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_11]]) : (!fir.box>, index) -> !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref +! CHECK: %[[VAL_14:.*]] = math.sin %[[VAL_13]] fastmath : f32 +! CHECK: hlfir.yield_element %[[VAL_14]] : f32 +! CHECK: } + +subroutine elemental_with_char_args(x,y) + character(*) :: x(100), y(:) + print *, scan(x, y) +end subroutine +! CHECK-LABEL: func.func @_QPelemental_with_char_args( +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_3:[a-z0-9]*]](%[[VAL_5:[a-z0-9]*]]) typeparams %[[VAL_2:[a-z0-9]*]]#1 {{.*}}Ex +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {{.*}}Ey +! CHECK: %[[VAL_13:.*]] = hlfir.elemental %[[VAL_5]] : (!fir.shape<1>) -> !hlfir.expr<100xi32> { +! CHECK: ^bb0(%[[VAL_14:.*]]: index): +! CHECK: %[[VAL_15:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_14]]) typeparams %[[VAL_2]]#1 : (!fir.box>>, index, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_16:.*]] = fir.box_elesize %[[VAL_7]]#1 : (!fir.box>>) -> index +! CHECK: %[[VAL_17:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_14]]) typeparams %[[VAL_16]] : (!fir.box>>, index, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_18:.*]]:2 = fir.unboxchar %[[VAL_15]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_19:.*]]:2 = fir.unboxchar %[[VAL_17]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_20:.*]] = arith.constant false +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_18]]#0 : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_2]]#1 : (index) -> i64 +! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_19]]#0 : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_16]] : (index) -> i64 +! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAScan1(%[[VAL_21]], %[[VAL_22]], %[[VAL_23]], %[[VAL_24]], %[[VAL_20]]) +! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i64) -> i32 +! CHECK: hlfir.yield_element %[[VAL_26]] : i32 +! CHECK: }