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 @@ -485,346 +485,374 @@ return hlfir::EntityWithAttributes{result}; } -/// Is this a call to an elemental procedure with at least one array argument? -static bool -isElementalProcWithArrayArgs(const Fortran::evaluate::ProcedureRef &procRef) { - if (procRef.IsElemental()) - for (const std::optional &arg : - procRef.arguments()) - if (arg && arg->Rank() != 0) - return true; - return false; -} +namespace { +// Structure to hold the information about the call and the lowering context. +// This structure is intended to help threading the information +// through the various lowering calls without having to pass every +// required structure one by one. +struct CallContext { + CallContext(const Fortran::evaluate::ProcedureRef &procRef, + std::optional resultType, mlir::Location loc, + Fortran::lower::AbstractConverter &converter, + Fortran::lower::SymMap &symMap, + Fortran::lower::StatementContext &stmtCtx) + : procRef{procRef}, converter{converter}, symMap{symMap}, + stmtCtx{stmtCtx}, resultType{resultType}, loc{loc} {} -/// helper to detect statement functions -static bool -isStatementFunctionCall(const Fortran::evaluate::ProcedureRef &procRef) { - if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol()) - if (const auto *details = - symbol->detailsIf()) - return details->stmtFunction().has_value(); - return false; + fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); } + + /// Is this a call to an elemental procedure with at least one array argument? + bool isElementalProcWithArrayArgs() const { + if (procRef.IsElemental()) + for (const std::optional &arg : + procRef.arguments()) + if (arg && arg->Rank() != 0) + return true; + return false; + } + + /// Is this a statement function reference? + bool isStatementFunctionCall() const { + if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol()) + if (const auto *details = + symbol->detailsIf()) + return details->stmtFunction().has_value(); + return false; + } + + const Fortran::evaluate::ProcedureRef &procRef; + Fortran::lower::AbstractConverter &converter; + Fortran::lower::SymMap &symMap; + Fortran::lower::StatementContext &stmtCtx; + std::optional resultType; + mlir::Location loc; +}; + +/// This structure holds the initial lowered value of an actual argument that +/// was lowered regardless of the interface, and it holds whether or not it +/// may be absent at runtime and the dummy is optional. +struct PreparedActualArgument { + hlfir::Entity actual; + bool handleDynamicOptional; +}; +} // namespace + +/// Vector of pre-lowered actual arguments. nullopt if the actual is +/// "statically" absent (if it was not syntactically provided). +using PreparedActualArguments = + llvm::SmallVector>; + +// Helper to transform a fir::ExtendedValue to an hlfir::EntityWithAttributes. +static hlfir::EntityWithAttributes +extendedValueToHlfirEntity(mlir::Location loc, fir::FirOpBuilder &builder, + const fir::ExtendedValue &exv, + llvm::StringRef name) { + mlir::Value firBase = fir::getBase(exv); + if (fir::isa_trivial(firBase.getType())) + return hlfir::EntityWithAttributes{firBase}; + return hlfir::genDeclare(loc, builder, exv, name, + fir::FortranVariableFlagsAttr{}); } -namespace { -class CallBuilder { -private: - struct PreparedActualArgument { - hlfir::Entity actual; - bool handleDynamicOptional; - }; - using PreparedActualArguments = - llvm::SmallVector>; +/// Lower calls to user procedures with actual arguments that have been +/// pre-lowered but not yet prepared according to the interface. +/// This can be called for elemental procedures, but only with scalar +/// arguments: if there are array arguments, it must be provided with +/// the array argument elements value and will return the corresponding +/// scalar result value. +static std::optional +genUserCall(PreparedActualArguments &loweredActuals, + Fortran::lower::CallerInterface &caller, + mlir::FunctionType callSiteType, CallContext &callContext) { using PassBy = Fortran::lower::CallerInterface::PassEntityBy; - -public: - CallBuilder(mlir::Location loc, Fortran::lower::AbstractConverter &converter, - Fortran::lower::SymMap &symMap, - Fortran::lower::StatementContext &stmtCtx) - : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {} - - std::optional - gen(const Fortran::evaluate::ProcedureRef &procRef, - std::optional resultType) { - mlir::Location loc = getLoc(); - if (auto *specific = procRef.proc().GetSpecificIntrinsic()) { - if (isElementalProcWithArrayArgs(procRef)) - TODO(loc, "lowering elemental intrinsic call to HLFIR"); - return genIntrinsicRef(procRef, resultType, *specific); + mlir::Location loc = callContext.loc; + fir::FirOpBuilder &builder = callContext.getBuilder(); + llvm::SmallVector exprAssociations; + for (auto [preparedActual, arg] : + llvm::zip(loweredActuals, caller.getPassedArguments())) { + mlir::Type argTy = callSiteType.getInput(arg.firArgument); + if (!preparedActual) { + // Optional dummy argument for which there is no actual argument. + caller.placeInput(arg, builder.create(loc, argTy)); + continue; } - if (isStatementFunctionCall(procRef)) - return genStmtFunctionRef(loc, converter, symMap, stmtCtx, procRef); - - Fortran::lower::CallerInterface caller(procRef, converter); - mlir::FunctionType callSiteType = caller.genFunctionType(); - - PreparedActualArguments loweredActuals; - // Lower the actual arguments - for (const Fortran::lower::CallInterface< - Fortran::lower::CallerInterface>::PassedEntity &arg : - caller.getPassedArguments()) - if (const auto *actual = arg.entity) { - const auto *expr = actual->UnwrapExpr(); - if (!expr) - TODO(loc, "assumed type actual argument"); - - const bool handleDynamicOptional = - arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional( - *expr, getConverter().getFoldingContext()); - auto loweredActual = Fortran::lower::convertExprToHLFIR( - loc, getConverter(), *expr, getSymMap(), getStmtCtx()); - loweredActuals.emplace_back( - PreparedActualArgument{loweredActual, handleDynamicOptional}); + hlfir::Entity actual = preparedActual->actual; + const auto *expr = arg.entity->UnwrapExpr(); + if (!expr) + TODO(loc, "assumed type actual argument"); + + if (preparedActual->handleDynamicOptional) + TODO(loc, "passing optional arguments in HLFIR"); + + const bool isSimplyContiguous = + actual.isScalar() || + Fortran::evaluate::IsSimplyContiguous( + *expr, callContext.converter.getFoldingContext()); + + switch (arg.passBy) { + case PassBy::Value: { + // True pass-by-value semantics. + auto value = hlfir::loadTrivialScalar(loc, builder, actual); + if (!value.isValue()) + TODO(loc, "Passing CPTR an CFUNCTPTR VALUE in HLFIR"); + caller.placeInput(arg, builder.createConvert(loc, argTy, value)); + } break; + case PassBy::BaseAddressValueAttribute: { + // VALUE attribute or pass-by-reference to a copy semantics. (byval*) + TODO(loc, "HLFIR PassBy::BaseAddressValueAttribute"); + } break; + case PassBy::BaseAddress: + case PassBy::BoxChar: { + hlfir::Entity entity = actual; + if (entity.isVariable()) { + entity = hlfir::derefPointersAndAllocatables(loc, builder, entity); + // Copy-in non contiguous variable + if (!isSimplyContiguous) + TODO(loc, "HLFIR copy-in/copy-out"); } else { - // Optional dummy argument for which there is no actual argument. - loweredActuals.emplace_back(std::nullopt); + hlfir::AssociateOp associate = hlfir::genAssociateExpr( + loc, builder, entity, argTy, "adapt.valuebyref"); + exprAssociations.push_back(associate); + entity = hlfir::Entity{associate.getBase()}; } - if (isElementalProcWithArrayArgs(procRef)) { - bool isImpure = false; - if (const Fortran::semantics::Symbol *procSym = - procRef.proc().GetSymbol()) - isImpure = !Fortran::semantics::IsPureProcedure(*procSym); - return genElementalUserCall(loweredActuals, caller, resultType, - callSiteType, isImpure); + mlir::Value addr = + arg.passBy == PassBy::BaseAddress + ? hlfir::genVariableRawAddress(loc, builder, entity) + : hlfir::genVariableBoxChar(loc, builder, entity); + caller.placeInput(arg, builder.createConvert(loc, argTy, addr)); + } break; + case PassBy::CharBoxValueAttribute: { + TODO(loc, "HLFIR PassBy::CharBoxValueAttribute"); + } break; + case PassBy::AddressAndLength: + // PassBy::AddressAndLength is only used for character results. Results + // are not handled here. + fir::emitFatalError( + loc, "unexpected PassBy::AddressAndLength for actual arguments"); + break; + case PassBy::CharProcTuple: { + TODO(loc, "HLFIR PassBy::CharProcTuple"); + } break; + case PassBy::Box: { + TODO(loc, "HLFIR PassBy::Box"); + } break; + case PassBy::MutableBox: { + TODO(loc, "HLFIR PassBy::MutableBox"); + } break; } - return genUserCall(loweredActuals, caller, resultType, callSiteType); } + // Prepare lowered arguments according to the interface + // and map the lowered values to the dummy + // arguments. + fir::ExtendedValue result = Fortran::lower::genCallOpAndResult( + loc, callContext.converter, callContext.symMap, callContext.stmtCtx, + caller, callSiteType, callContext.resultType); + + /// Clean-up associations and copy-in. + for (auto associate : exprAssociations) + builder.create(loc, associate); + if (!fir::getBase(result)) + return std::nullopt; // subroutine call. + // TODO: "move" non pointer results into hlfir.expr. + return extendedValueToHlfirEntity(loc, builder, result, ".tmp.func_result"); +} -private: - std::optional - genUserCall(PreparedActualArguments &loweredActuals, - Fortran::lower::CallerInterface &caller, - std::optional resultType, - mlir::FunctionType callSiteType) { - mlir::Location loc = getLoc(); - fir::FirOpBuilder &builder = getBuilder(); - llvm::SmallVector exprAssociations; - for (auto [preparedActual, arg] : - llvm::zip(loweredActuals, caller.getPassedArguments())) { - mlir::Type argTy = callSiteType.getInput(arg.firArgument); - if (!preparedActual) { - // Optional dummy argument for which there is no actual argument. - caller.placeInput(arg, builder.create(loc, argTy)); - continue; - } - hlfir::Entity actual = preparedActual->actual; - const auto *expr = arg.entity->UnwrapExpr(); - if (!expr) - TODO(loc, "assumed type actual argument"); - - if (preparedActual->handleDynamicOptional) - TODO(loc, "passing optional arguments in HLFIR"); - - const bool isSimplyContiguous = - actual.isScalar() || Fortran::evaluate::IsSimplyContiguous( - *expr, getConverter().getFoldingContext()); - - switch (arg.passBy) { - case PassBy::Value: { - // True pass-by-value semantics. - auto value = hlfir::loadTrivialScalar(loc, builder, actual); - if (!value.isValue()) - TODO(loc, "Passing CPTR an CFUNCTPTR VALUE in HLFIR"); - caller.placeInput(arg, builder.createConvert(loc, argTy, value)); - } break; - case PassBy::BaseAddressValueAttribute: { - // VALUE attribute or pass-by-reference to a copy semantics. (byval*) - TODO(loc, "HLFIR PassBy::BaseAddressValueAttribute"); - } break; - case PassBy::BaseAddress: - case PassBy::BoxChar: { - hlfir::Entity entity = actual; - if (entity.isVariable()) { - entity = hlfir::derefPointersAndAllocatables(loc, builder, entity); - // Copy-in non contiguous variable - if (!isSimplyContiguous) - TODO(loc, "HLFIR copy-in/copy-out"); - } else { - hlfir::AssociateOp associate = hlfir::genAssociateExpr( - loc, builder, entity, argTy, "adapt.valuebyref"); - exprAssociations.push_back(associate); - entity = hlfir::Entity{associate.getBase()}; - } - mlir::Value addr = - arg.passBy == PassBy::BaseAddress - ? hlfir::genVariableRawAddress(loc, builder, entity) - : hlfir::genVariableBoxChar(loc, builder, entity); - caller.placeInput(arg, builder.createConvert(loc, argTy, addr)); - } break; - case PassBy::CharBoxValueAttribute: { - TODO(loc, "HLFIR PassBy::CharBoxValueAttribute"); - } break; - case PassBy::AddressAndLength: - // PassBy::AddressAndLength is only used for character results. Results - // are not handled here. - fir::emitFatalError( - loc, "unexpected PassBy::AddressAndLength for actual arguments"); - break; - case PassBy::CharProcTuple: { - TODO(loc, "HLFIR PassBy::CharProcTuple"); - } break; - case PassBy::Box: { - TODO(loc, "HLFIR PassBy::Box"); - } break; - case PassBy::MutableBox: { - TODO(loc, "HLFIR PassBy::MutableBox"); - } break; +/// 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; } - // Prepare lowered arguments according to the interface - // and map the lowered values to the dummy - // arguments. - fir::ExtendedValue result = Fortran::lower::genCallOpAndResult( - loc, getConverter(), getSymMap(), getStmtCtx(), caller, callSiteType, - resultType); - - /// Clean-up associations and copy-in. - for (auto associate : exprAssociations) - builder.create(loc, associate); - if (!fir::getBase(result)) - return std::nullopt; // subroutine call. - // TODO: "move" non pointer results into hlfir.expr. - return extendedValueToHlfirEntity(result, ".tmp.func_result"); } + 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)}; +} - std::optional - genElementalUserCall(PreparedActualArguments &loweredActuals, - Fortran::lower::CallerInterface &caller, - std::optional resultType, - mlir::FunctionType callSiteType, bool isImpure) { - mlir::Location loc = getLoc(); - fir::FirOpBuilder &builder = 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; - } +/// 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"); + + 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. + operands.emplace_back(Fortran::lower::getAbsentIntrinsicArgument()); + continue; + } + if (!argLowering) { + // No argument lowering instruction, lower by value. + operands.emplace_back(converter.genExprValue(loc, *expr, stmtCtx)); + continue; } - assert(shape && - "elemental array calls must have at least one array arguments"); - if (mustBeOrdered) - TODO(loc, "ordered elemental calls in HLFIR"); - if (!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, resultType, callSiteType); - builder.restoreInsertionPoint(insPt); - return std::nullopt; + // 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)); + continue; + case Fortran::lower::LowerIntrinsicArgAs::Addr: + operands.emplace_back(converter.genExprAddr(loc, *expr, stmtCtx)); + continue; + case Fortran::lower::LowerIntrinsicArgAs::Box: + operands.emplace_back(converter.genExprBox(loc, *expr, stmtCtx)); + continue; + case Fortran::lower::LowerIntrinsicArgAs::Inquired: + TODO(loc, "as inquired arguments in HLFIR"); + continue; } - // Function case: generate call inside hlfir.elemental - mlir::Type elementType = hlfir::getFortranElementType(*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, resultType, callSiteType); - }; - // TODO: deal with hlfir.elemental result destruction. - return hlfir::EntityWithAttributes{hlfir::genElementalOp( - loc, builder, elementType, shape, typeParams, genKernel)}; + llvm_unreachable("bad switch"); } + // Let the intrinsic library lower the intrinsic procedure call. + fir::ExtendedValue val = Fortran::lower::genIntrinsicCall( + callContext.getBuilder(), loc, intrinsic.name, callContext.resultType, + operands, stmtCtx); + return extendedValueToHlfirEntity(loc, callContext.getBuilder(), val, + ".tmp.intrinsic_result"); +} - hlfir::EntityWithAttributes - genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef, - std::optional resultType, - const Fortran::evaluate::SpecificIntrinsic &intrinsic) { - mlir::Location loc = getLoc(); - if (Fortran::lower::intrinsicRequiresCustomOptionalHandling( - procRef, intrinsic, converter)) - TODO(loc, "special cases of intrinsic with optional arguments"); - - llvm::SmallVector operands; - const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering = - Fortran::lower::getIntrinsicArgumentLowering(intrinsic.name); - for (const auto &arg : llvm::enumerate(procRef.arguments())) { - auto *expr = - Fortran::evaluate::UnwrapExpr(arg.value()); - if (!expr) { - // Absent optional. - operands.emplace_back(Fortran::lower::getAbsentIntrinsicArgument()); - continue; - } - if (!argLowering) { - // No argument lowering instruction, lower by value. - operands.emplace_back(converter.genExprValue(loc, *expr, stmtCtx)); - continue; - } - // Ad-hoc argument lowering handling. - Fortran::lower::ArgLoweringRule argRules = - Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index()); - if (argRules.handleDynamicOptional && +/// Main entry point to lower procedure references, regardless of what they are. +static std::optional +genProcedureRef(CallContext &callContext) { + mlir::Location loc = callContext.loc; + if (auto *intrinsic = callContext.procRef.proc().GetSpecificIntrinsic()) + return genIntrinsicRef(*intrinsic, callContext); + + if (callContext.isStatementFunctionCall()) + return genStmtFunctionRef(loc, callContext.converter, callContext.symMap, + callContext.stmtCtx, callContext.procRef); + + Fortran::lower::CallerInterface caller(callContext.procRef, + callContext.converter); + mlir::FunctionType callSiteType = caller.genFunctionType(); + + PreparedActualArguments loweredActuals; + // Lower the actual arguments + for (const Fortran::lower::CallInterface< + Fortran::lower::CallerInterface>::PassedEntity &arg : + caller.getPassedArguments()) + if (const auto *actual = arg.entity) { + const auto *expr = actual->UnwrapExpr(); + if (!expr) + TODO(loc, "assumed type actual argument"); + + const bool handleDynamicOptional = + arg.isOptional() && 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)); - continue; - case Fortran::lower::LowerIntrinsicArgAs::Addr: - operands.emplace_back(converter.genExprAddr(loc, *expr, stmtCtx)); - continue; - case Fortran::lower::LowerIntrinsicArgAs::Box: - operands.emplace_back(converter.genExprBox(loc, *expr, stmtCtx)); - continue; - case Fortran::lower::LowerIntrinsicArgAs::Inquired: - TODO(loc, "as inquired arguments in HLFIR"); - continue; - } - llvm_unreachable("bad switch"); + *expr, callContext.converter.getFoldingContext()); + auto loweredActual = Fortran::lower::convertExprToHLFIR( + loc, callContext.converter, *expr, callContext.symMap, + callContext.stmtCtx); + loweredActuals.emplace_back( + PreparedActualArgument{loweredActual, handleDynamicOptional}); + } else { + // Optional dummy argument for which there is no actual argument. + loweredActuals.emplace_back(std::nullopt); } - // Let the intrinsic library lower the intrinsic procedure call - fir::ExtendedValue val = Fortran::lower::genIntrinsicCall( - getBuilder(), getLoc(), intrinsic.name, resultType, operands, stmtCtx); - return extendedValueToHlfirEntity(val, ".tmp.intrinsic_result"); - } - - hlfir::EntityWithAttributes - extendedValueToHlfirEntity(const fir::ExtendedValue &exv, - llvm::StringRef name) { - mlir::Value firBase = fir::getBase(exv); - if (fir::isa_trivial(firBase.getType())) - return hlfir::EntityWithAttributes{firBase}; - return hlfir::genDeclare(getLoc(), getBuilder(), exv, name, - fir::FortranVariableFlagsAttr{}); + if (callContext.isElementalProcWithArrayArgs()) { + bool isImpure = false; + if (const Fortran::semantics::Symbol *procSym = + callContext.procRef.proc().GetSymbol()) + isImpure = !Fortran::semantics::IsPureProcedure(*procSym); + return genElementalUserCall(loweredActuals, caller, callSiteType, isImpure, + callContext); } - - mlir::Location getLoc() const { return loc; } - Fortran::lower::AbstractConverter &getConverter() { return converter; } - fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); } - Fortran::lower::SymMap &getSymMap() { return symMap; } - Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; } - - Fortran::lower::AbstractConverter &converter; - Fortran::lower::SymMap &symMap; - Fortran::lower::StatementContext &stmtCtx; - mlir::Location loc; -}; -} // namespace + return genUserCall(loweredActuals, caller, callSiteType, callContext); +} std::optional Fortran::lower::convertCallToHLFIR( mlir::Location loc, Fortran::lower::AbstractConverter &converter, const evaluate::ProcedureRef &procRef, std::optional resultType, Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { - return CallBuilder(loc, converter, symMap, stmtCtx).gen(procRef, resultType); + CallContext callContext(procRef, resultType, loc, converter, symMap, stmtCtx); + return genProcedureRef(callContext); }