caio/clang-p2996
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
05727d94de75e2e98e6ae37c36aeb4f6ca6b2aed
clang-p2996/flang/lib/Lower/ConvertCall.cpp
Kazu Hirata c09215860f [flang] Use std::optional instead of llvm::Optional (NFC) 
This patch replaces (llvm::|)Optional< with std::optional<.  I'll post
a separate patch to remove #include "llvm/ADT/Optional.h".

This is part of an effort to migrate from llvm::Optional to
std::optional:

https://discourse.llvm.org/t/deprecating-llvm-optional-x-hasvalue-getvalue-getvalueor/63716
2023-01-07 22:26:48 -08:00

831 lines
37 KiB
C++
Raw Blame History

//===-- ConvertCall.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/ConvertCall.h"
#include "flang/Lower/ConvertExprToHLFIR.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/CustomIntrinsicCall.h"
#include "flang/Lower/IntrinsicCall.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/SymbolMap.h"
#include "flang/Optimizer/Builder/BoxValue.h"
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/LowLevelIntrinsics.h"
#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include "llvm/Support/Debug.h"
#include <optional>
#define DEBUG_TYPE "flang-lower-expr"
/// Helper to package a Value and its properties into an ExtendedValue.
static fir::ExtendedValue toExtendedValue(mlir::Location loc, mlir::Value base,
llvm::ArrayRef<mlir::Value> extents,
llvm::ArrayRef<mlir::Value> lengths) {
mlir::Type type = base.getType();
if (type.isa<fir::BaseBoxType>())
return fir::BoxValue(base, /*lbounds=*/{}, lengths, extents);
type = fir::unwrapRefType(type);
if (type.isa<fir::BaseBoxType>())
return fir::MutableBoxValue(base, lengths, /*mutableProperties*/ {});
if (auto seqTy = type.dyn_cast<fir::SequenceType>()) {
if (seqTy.getDimension() != extents.size())
fir::emitFatalError(loc, "incorrect number of extents for array");
if (seqTy.getEleTy().isa<fir::CharacterType>()) {
if (lengths.empty())
fir::emitFatalError(loc, "missing length for character");
assert(lengths.size() == 1);
return fir::CharArrayBoxValue(base, lengths[0], extents);
}
return fir::ArrayBoxValue(base, extents);
}
if (type.isa<fir::CharacterType>()) {
if (lengths.empty())
fir::emitFatalError(loc, "missing length for character");
assert(lengths.size() == 1);
return fir::CharBoxValue(base, lengths[0]);
}
return base;
}
/// Lower a type(C_PTR/C_FUNPTR) argument with VALUE attribute into a
/// reference. A C pointer can correspond to a Fortran dummy argument of type
/// C_PTR with the VALUE attribute. (see 18.3.6 note 3).
static mlir::Value
genRecordCPtrValueArg(Fortran::lower::AbstractConverter &converter,
mlir::Value rec, mlir::Type ty) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::Location loc = converter.getCurrentLocation();
mlir::Value cAddr = fir::factory::genCPtrOrCFunptrAddr(builder, loc, rec, ty);
mlir::Value cVal = builder.create<fir::LoadOp>(loc, cAddr);
return builder.createConvert(loc, cAddr.getType(), cVal);
}
// Find the argument that corresponds to the host associations.
// Verify some assumptions about how the signature was built here.
[[maybe_unused]] static unsigned findHostAssocTuplePos(mlir::func::FuncOp fn) {
// Scan the argument list from last to first as the host associations are
// appended for now.
for (unsigned i = fn.getNumArguments(); i > 0; --i)
if (fn.getArgAttr(i - 1, fir::getHostAssocAttrName())) {
// Host assoc tuple must be last argument (for now).
assert(i == fn.getNumArguments() && "tuple must be last");
return i - 1;
}
llvm_unreachable("anyFuncArgsHaveAttr failed");
}
mlir::Value
Fortran::lower::argumentHostAssocs(Fortran::lower::AbstractConverter &converter,
mlir::Value arg) {
if (auto addr = mlir::dyn_cast_or_null<fir::AddrOfOp>(arg.getDefiningOp())) {
auto &builder = converter.getFirOpBuilder();
if (auto funcOp = builder.getNamedFunction(addr.getSymbol()))
if (fir::anyFuncArgsHaveAttr(funcOp, fir::getHostAssocAttrName()))
return converter.hostAssocTupleValue();
}
return {};
}
fir::ExtendedValue Fortran::lower::genCallOpAndResult(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
Fortran::lower::CallerInterface &caller, mlir::FunctionType callSiteType,
std::optional<mlir::Type> resultType) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
// Handle cases where caller must allocate the result or a fir.box for it.
bool mustPopSymMap = false;
if (caller.mustMapInterfaceSymbols()) {
symMap.pushScope();
mustPopSymMap = true;
Fortran::lower::mapCallInterfaceSymbols(converter, caller, symMap);
}
// If this is an indirect call, retrieve the function address. Also retrieve
// the result length if this is a character function (note that this length
// will be used only if there is no explicit length in the local interface).
mlir::Value funcPointer;
mlir::Value charFuncPointerLength;
if (const Fortran::semantics::Symbol *sym =
caller.getIfIndirectCallSymbol()) {
funcPointer = symMap.lookupSymbol(*sym).getAddr();
if (!funcPointer)
fir::emitFatalError(loc, "failed to find indirect call symbol address");
if (fir::isCharacterProcedureTuple(funcPointer.getType(),
/*acceptRawFunc=*/false))
std::tie(funcPointer, charFuncPointerLength) =
fir::factory::extractCharacterProcedureTuple(builder, loc,
funcPointer);
}
mlir::IndexType idxTy = builder.getIndexType();
auto lowerSpecExpr = [&](const auto &expr) -> mlir::Value {
mlir::Value convertExpr = builder.createConvert(
loc, idxTy, fir::getBase(converter.genExprValue(expr, stmtCtx)));
return fir::factory::genMaxWithZero(builder, loc, convertExpr);
};
llvm::SmallVector<mlir::Value> resultLengths;
auto allocatedResult = [&]() -> std::optional<fir::ExtendedValue> {
llvm::SmallVector<mlir::Value> extents;
llvm::SmallVector<mlir::Value> lengths;
if (!caller.callerAllocateResult())
return {};
mlir::Type type = caller.getResultStorageType();
if (type.isa<fir::SequenceType>())
caller.walkResultExtents([&](const Fortran::lower::SomeExpr &e) {
extents.emplace_back(lowerSpecExpr(e));
});
caller.walkResultLengths([&](const Fortran::lower::SomeExpr &e) {
lengths.emplace_back(lowerSpecExpr(e));
});
// Result length parameters should not be provided to box storage
// allocation and save_results, but they are still useful information to
// keep in the ExtendedValue if non-deferred.
if (!type.isa<fir::BoxType>()) {
if (fir::isa_char(fir::unwrapSequenceType(type)) && lengths.empty()) {
// Calling an assumed length function. This is only possible if this
// is a call to a character dummy procedure.
if (!charFuncPointerLength)
fir::emitFatalError(loc, "failed to retrieve character function "
"length while calling it");
lengths.push_back(charFuncPointerLength);
}
resultLengths = lengths;
}
if (!extents.empty() || !lengths.empty()) {
auto *bldr = &converter.getFirOpBuilder();
auto stackSaveFn = fir::factory::getLlvmStackSave(builder);
auto stackSaveSymbol = bldr->getSymbolRefAttr(stackSaveFn.getName());
mlir::Value sp = bldr->create<fir::CallOp>(
loc, stackSaveFn.getFunctionType().getResults(),
stackSaveSymbol, mlir::ValueRange{})
.getResult(0);
stmtCtx.attachCleanup([bldr, loc, sp]() {
auto stackRestoreFn = fir::factory::getLlvmStackRestore(*bldr);
auto stackRestoreSymbol =
bldr->getSymbolRefAttr(stackRestoreFn.getName());
bldr->create<fir::CallOp>(loc,
stackRestoreFn.getFunctionType().getResults(),
stackRestoreSymbol, mlir::ValueRange{sp});
});
}
mlir::Value temp =
builder.createTemporary(loc, type, ".result", extents, resultLengths);
return toExtendedValue(loc, temp, extents, lengths);
}();
if (mustPopSymMap)
symMap.popScope();
// Place allocated result or prepare the fir.save_result arguments.
mlir::Value arrayResultShape;
if (allocatedResult) {
if (std::optional<Fortran::lower::CallInterface<
Fortran::lower::CallerInterface>::PassedEntity>
resultArg = caller.getPassedResult()) {
if (resultArg->passBy == PassBy::AddressAndLength)
caller.placeAddressAndLengthInput(*resultArg,
fir::getBase(*allocatedResult),
fir::getLen(*allocatedResult));
else if (resultArg->passBy == PassBy::BaseAddress)
caller.placeInput(*resultArg, fir::getBase(*allocatedResult));
else
fir::emitFatalError(
loc, "only expect character scalar result to be passed by ref");
} else {
assert(caller.mustSaveResult());
arrayResultShape = allocatedResult->match(
[&](const fir::CharArrayBoxValue &) {
return builder.createShape(loc, *allocatedResult);
},
[&](const fir::ArrayBoxValue &) {
return builder.createShape(loc, *allocatedResult);
},
[&](const auto &) { return mlir::Value{}; });
}
}
// In older Fortran, procedure argument types are inferred. This may lead
// different view of what the function signature is in different locations.
// Casts are inserted as needed below to accommodate this.
// The mlir::func::FuncOp type prevails, unless it has a different number of
// arguments which can happen in legal program if it was passed as a dummy
// procedure argument earlier with no further type information.
mlir::SymbolRefAttr funcSymbolAttr;
bool addHostAssociations = false;
if (!funcPointer) {
mlir::FunctionType funcOpType = caller.getFuncOp().getFunctionType();
mlir::SymbolRefAttr symbolAttr =
builder.getSymbolRefAttr(caller.getMangledName());
if (callSiteType.getNumResults() == funcOpType.getNumResults() &&
callSiteType.getNumInputs() + 1 == funcOpType.getNumInputs() &&
fir::anyFuncArgsHaveAttr(caller.getFuncOp(),
fir::getHostAssocAttrName())) {
// The number of arguments is off by one, and we're lowering a function
// with host associations. Modify call to include host associations
// argument by appending the value at the end of the operands.
assert(funcOpType.getInput(findHostAssocTuplePos(caller.getFuncOp())) ==
converter.hostAssocTupleValue().getType());
addHostAssociations = true;
}
if (!addHostAssociations &&
(callSiteType.getNumResults() != funcOpType.getNumResults() ||
callSiteType.getNumInputs() != funcOpType.getNumInputs())) {
// Deal with argument number mismatch by making a function pointer so
// that function type cast can be inserted. Do not emit a warning here
// because this can happen in legal program if the function is not
// defined here and it was first passed as an argument without any more
// information.
funcPointer = builder.create<fir::AddrOfOp>(loc, funcOpType, symbolAttr);
} else if (callSiteType.getResults() != funcOpType.getResults()) {
// Implicit interface result type mismatch are not standard Fortran, but
// some compilers are not complaining about it. The front end is not
// protecting lowering from this currently. Support this with a
// discouraging warning.
LLVM_DEBUG(mlir::emitWarning(
loc, "a return type mismatch is not standard compliant and may "
"lead to undefined behavior."));
// Cast the actual function to the current caller implicit type because
// that is the behavior we would get if we could not see the definition.
funcPointer = builder.create<fir::AddrOfOp>(loc, funcOpType, symbolAttr);
} else {
funcSymbolAttr = symbolAttr;
}
}
mlir::FunctionType funcType =
funcPointer ? callSiteType : caller.getFuncOp().getFunctionType();
llvm::SmallVector<mlir::Value> operands;
// First operand of indirect call is the function pointer. Cast it to
// required function type for the call to handle procedures that have a
// compatible interface in Fortran, but that have different signatures in
// FIR.
if (funcPointer) {
operands.push_back(
funcPointer.getType().isa<fir::BoxProcType>()
? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
: builder.createConvert(loc, funcType, funcPointer));
}
// Deal with potential mismatches in arguments types. Passing an array to a
// scalar argument should for instance be tolerated here.
bool callingImplicitInterface = caller.canBeCalledViaImplicitInterface();
for (auto [fst, snd] : llvm::zip(caller.getInputs(), funcType.getInputs())) {
// When passing arguments to a procedure that can be called by implicit
// interface, allow any character actual arguments to be passed to dummy
// arguments of any type and vice versa.
mlir::Value cast;
auto *context = builder.getContext();
if (snd.isa<fir::BoxProcType>() &&
fst.getType().isa<mlir::FunctionType>()) {
auto funcTy =
mlir::FunctionType::get(context, std::nullopt, std::nullopt);
auto boxProcTy = builder.getBoxProcType(funcTy);
if (mlir::Value host = argumentHostAssocs(converter, fst)) {
cast = builder.create<fir::EmboxProcOp>(
loc, boxProcTy, llvm::ArrayRef<mlir::Value>{fst, host});
} else {
cast = builder.create<fir::EmboxProcOp>(loc, boxProcTy, fst);
}
} else {
mlir::Type fromTy = fir::unwrapRefType(fst.getType());
if (fir::isa_builtin_cptr_type(fromTy) &&
Fortran::lower::isCPtrArgByValueType(snd)) {
cast = genRecordCPtrValueArg(converter, fst, fromTy);
} else if (fir::isa_derived(snd)) {
// FIXME: This seems like a serious bug elsewhere in lowering. Paper
// over the problem for now.
TODO(loc, "derived type argument passed by value");
} else {
cast = builder.convertWithSemantics(loc, snd, fst,
callingImplicitInterface);
}
}
operands.push_back(cast);
}
// Add host associations as necessary.
if (addHostAssociations)
operands.push_back(converter.hostAssocTupleValue());
mlir::Value callResult;
unsigned callNumResults;
if (caller.requireDispatchCall()) {
// Procedure call requiring a dynamic dispatch. Call is created with
// fir.dispatch.
// Get the raw procedure name. The procedure name is not mangled in the
// binding table.
const auto &ultimateSymbol =
caller.getCallDescription().proc().GetSymbol()->GetUltimate();
auto procName = toStringRef(ultimateSymbol.name());
fir::DispatchOp dispatch;
if (std::optional<unsigned> passArg = caller.getPassArgIndex()) {
// PASS, PASS(arg-name)
dispatch = builder.create<fir::DispatchOp>(
loc, funcType.getResults(), builder.getStringAttr(procName),
operands[*passArg], operands, builder.getI32IntegerAttr(*passArg));
} else {
// NOPASS
const Fortran::evaluate::Component *component =
caller.getCallDescription().proc().GetComponent();
assert(component && "expect component for type-bound procedure call.");
fir::ExtendedValue pass =
symMap.lookupSymbol(component->GetFirstSymbol()).toExtendedValue();
mlir::Value passObject = fir::getBase(pass);
if (fir::isa_ref_type(passObject.getType()))
passObject = builder.create<fir::ConvertOp>(
loc, passObject.getType().dyn_cast<fir::ReferenceType>().getEleTy(),
passObject);
dispatch = builder.create<fir::DispatchOp>(
loc, funcType.getResults(), builder.getStringAttr(procName),
passObject, operands, nullptr);
}
callResult = dispatch.getResult(0);
callNumResults = dispatch.getNumResults();
} else {
// Standard procedure call with fir.call.
auto call = builder.create<fir::CallOp>(loc, funcType.getResults(),
funcSymbolAttr, operands);
callResult = call.getResult(0);
callNumResults = call.getNumResults();
}
if (caller.mustSaveResult()) {
assert(allocatedResult.has_value());
builder.create<fir::SaveResultOp>(loc, callResult,
fir::getBase(*allocatedResult),
arrayResultShape, resultLengths);
}
if (allocatedResult) {
allocatedResult->match(
[&](const fir::MutableBoxValue &box) {
if (box.isAllocatable()) {
// 9.7.3.2 point 4. Finalize allocatables.
fir::FirOpBuilder *bldr = &converter.getFirOpBuilder();
stmtCtx.attachCleanup([bldr, loc, box]() {
fir::factory::genFinalization(*bldr, loc, box);
});
}
},
[](const auto &) {});
return *allocatedResult;
}
if (!resultType)
return mlir::Value{}; // subroutine call
// For now, Fortran return values are implemented with a single MLIR
// function return value.
assert(callNumResults == 1 && "Expected exactly one result in FUNCTION call");
(void)callNumResults;
// Call a BIND(C) function that return a char.
if (caller.characterize().IsBindC() &&
funcType.getResults()[0].isa<fir::CharacterType>()) {
fir::CharacterType charTy =
funcType.getResults()[0].dyn_cast<fir::CharacterType>();
mlir::Value len = builder.createIntegerConstant(
loc, builder.getCharacterLengthType(), charTy.getLen());
return fir::CharBoxValue{callResult, len};
}
return callResult;
}
static hlfir::EntityWithAttributes genStmtFunctionRef(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
const Fortran::evaluate::ProcedureRef &procRef) {
const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
assert(symbol && "expected symbol in ProcedureRef of statement functions");
const auto &details = symbol->get<Fortran::semantics::SubprogramDetails>();
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
// Statement functions have their own scope, we just need to associate
// the dummy symbols to argument expressions. There are no
// optional/alternate return arguments. Statement functions cannot be
// recursive (directly or indirectly) so it is safe to add dummy symbols to
// the local map here.
symMap.pushScope();
llvm::SmallVector<hlfir::AssociateOp> exprAssociations;
for (auto [arg, bind] : llvm::zip(details.dummyArgs(), procRef.arguments())) {
assert(arg && "alternate return in statement function");
assert(bind && "optional argument in statement function");
const auto *expr = bind->UnwrapExpr();
// TODO: assumed type in statement function, that surprisingly seems
// allowed, probably because nobody thought of restricting this usage.
// gfortran/ifort compiles this.
assert(expr && "assumed type used as statement function argument");
// As per Fortran 2018 C1580, statement function arguments can only be
// scalars.
// The only care is to use the dummy character explicit length if any
// instead of the actual argument length (that can be bigger).
hlfir::EntityWithAttributes loweredArg = Fortran::lower::convertExprToHLFIR(
loc, converter, *expr, symMap, stmtCtx);
fir::FortranVariableOpInterface variableIface = loweredArg.getIfVariable();
if (!variableIface) {
// So far only FortranVariableOpInterface can be mapped to symbols.
// Create an hlfir.associate to create a variable from a potential
// value argument.
mlir::Type argType = converter.genType(*arg);
auto associate = hlfir::genAssociateExpr(
loc, builder, loweredArg, argType, toStringRef(arg->name()));
exprAssociations.push_back(associate);
variableIface = associate;
}
const Fortran::semantics::DeclTypeSpec *type = arg->GetType();
if (type &&
type->category() == Fortran::semantics::DeclTypeSpec::Character) {
// Instantiate character as if it was a normal dummy argument so that the
// statement function dummy character length is applied and dealt with
// correctly.
symMap.addSymbol(*arg, variableIface.getBase());
Fortran::lower::mapSymbolAttributes(converter, *arg, symMap, stmtCtx);
} else {
// No need to create an extra hlfir.declare otherwise for
// numerical and logical scalar dummies.
symMap.addVariableDefinition(*arg, variableIface);
}
}
// Explicitly map statement function host associated symbols to their
// parent scope lowered symbol box.
for (const Fortran::semantics::SymbolRef &sym :
Fortran::evaluate::CollectSymbols(*details.stmtFunction()))
if (const auto *details =
sym->detailsIf<Fortran::semantics::HostAssocDetails>())
converter.copySymbolBinding(details->symbol(), sym);
hlfir::Entity result = Fortran::lower::convertExprToHLFIR(
loc, converter, details.stmtFunction().value(), symMap, stmtCtx);
symMap.popScope();
// The result must not be a variable.
result = hlfir::loadTrivialScalar(loc, builder, result);
if (result.isVariable())
result = hlfir::Entity{builder.create<hlfir::AsExprOp>(loc, result)};
for (auto associate : exprAssociations)
builder.create<hlfir::EndAssociateOp>(loc, associate);
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<Fortran::evaluate::ActualArgument> &arg :
procRef.arguments())
if (arg && arg->Rank() != 0)
return true;
return false;
}
/// 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<Fortran::semantics::SubprogramDetails>())
return details->stmtFunction().has_value();
return false;
}
namespace {
class CallBuilder {
private:
struct PreparedActualArgument {
hlfir::Entity actual;
bool handleDynamicOptional;
};
using PreparedActualArguments =
llvm::SmallVector<std::optional<PreparedActualArgument>>;
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<hlfir::EntityWithAttributes>
gen(const Fortran::evaluate::ProcedureRef &procRef,
std::optional<mlir::Type> 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);
}
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});
} else {
// Optional dummy argument for which there is no actual argument.
loweredActuals.emplace_back(std::nullopt);
}
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);
}
return genUserCall(loweredActuals, caller, resultType, callSiteType);
}
private:
std::optional<hlfir::EntityWithAttributes>
genUserCall(PreparedActualArguments &loweredActuals,
Fortran::lower::CallerInterface &caller,
std::optional<mlir::Type> resultType,
mlir::FunctionType callSiteType) {
mlir::Location loc = getLoc();
fir::FirOpBuilder &builder = getBuilder();
llvm::SmallVector<hlfir::AssociateOp> 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<fir::AbsentOp>(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;
}
}
// 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<hlfir::EndAssociateOp>(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");
}
std::optional<hlfir::EntityWithAttributes>
genElementalUserCall(PreparedActualArguments &loweredActuals,
Fortran::lower::CallerInterface &caller,
std::optional<mlir::Type> 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;
}
}
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;
}
// Function case: generate call inside hlfir.elemental
mlir::Type elementType = hlfir::getFortranElementType(*resultType);
// Get result length parameters.
llvm::SmallVector<mlir::Value> typeParams;
if (elementType.isa<fir::CharacterType>() ||
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)};
}
hlfir::EntityWithAttributes
genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef,
std::optional<mlir::Type> 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<fir::ExtendedValue> operands;
const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering =
Fortran::lower::getIntrinsicArgumentLowering(intrinsic.name);
for (const auto &arg : llvm::enumerate(procRef.arguments())) {
auto *expr =
Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(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 &&
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");
}
// 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{});
}
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
std::optional<hlfir::EntityWithAttributes> Fortran::lower::convertCallToHLFIR(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
const evaluate::ProcedureRef &procRef, std::optional<mlir::Type> resultType,
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
return CallBuilder(loc, converter, symMap, stmtCtx).gen(procRef, resultType);
}
Reference in New Issue View Git Blame Copy Permalink