c373f58134
Lower procedure pointer components, except in the context of structure constructor (left TODO). Procedure pointer components lowering share most of the lowering logic of procedure poionters with the following particularities: - They are components, so an hlfir.designate must be generated to retrieve the procedure pointer address from its derived type base. - They may have a PASS argument. While there is no dispatching as with type bound procedure, special care must be taken to retrieve the derived type component base in this case since semantics placed it in the argument list and not in the evaluate::ProcedureDesignator. These components also bring a new level of recursive MLIR types since a fir.type may now contain a component with an MLIR function type where one of the argument is the fir.type itself. This required moving the "derived type in construction" stackto the converter so that the object and function type lowering utilities share the same state (currently the function type utilty would end-up creating a new stack when lowering its arguments, leading to infinite loops). The BoxedProcedurePass also needed an update to deal with this recursive aspect.
211 lines
10 KiB
C++
211 lines
10 KiB
C++
//===- ConvertProcedureDesignator.cpp -- Procedure Designator ---*- C++ -*-===//
|
|
//
|
|
// 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
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#include "flang/Lower/ConvertProcedureDesignator.h"
|
|
#include "flang/Evaluate/intrinsics.h"
|
|
#include "flang/Lower/AbstractConverter.h"
|
|
#include "flang/Lower/CallInterface.h"
|
|
#include "flang/Lower/ConvertCall.h"
|
|
#include "flang/Lower/ConvertExprToHLFIR.h"
|
|
#include "flang/Lower/ConvertVariable.h"
|
|
#include "flang/Lower/Support/Utils.h"
|
|
#include "flang/Lower/SymbolMap.h"
|
|
#include "flang/Optimizer/Builder/Character.h"
|
|
#include "flang/Optimizer/Builder/IntrinsicCall.h"
|
|
#include "flang/Optimizer/Builder/Todo.h"
|
|
#include "flang/Optimizer/Dialect/FIROps.h"
|
|
#include "flang/Optimizer/HLFIR/HLFIROps.h"
|
|
|
|
static bool areAllSymbolsInExprMapped(const Fortran::evaluate::ExtentExpr &expr,
|
|
Fortran::lower::SymMap &symMap) {
|
|
for (const auto &sym : Fortran::evaluate::CollectSymbols(expr))
|
|
if (!symMap.lookupSymbol(sym))
|
|
return false;
|
|
return true;
|
|
}
|
|
|
|
fir::ExtendedValue Fortran::lower::convertProcedureDesignator(
|
|
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::evaluate::ProcedureDesignator &proc,
|
|
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
|
|
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
|
|
|
if (const Fortran::evaluate::SpecificIntrinsic *intrinsic =
|
|
proc.GetSpecificIntrinsic()) {
|
|
mlir::FunctionType signature =
|
|
Fortran::lower::translateSignature(proc, converter);
|
|
// Intrinsic lowering is based on the generic name, so retrieve it here in
|
|
// case it is different from the specific name. The type of the specific
|
|
// intrinsic is retained in the signature.
|
|
std::string genericName =
|
|
converter.getFoldingContext().intrinsics().GetGenericIntrinsicName(
|
|
intrinsic->name);
|
|
mlir::SymbolRefAttr symbolRefAttr =
|
|
fir::getUnrestrictedIntrinsicSymbolRefAttr(builder, loc, genericName,
|
|
signature);
|
|
mlir::Value funcPtr =
|
|
builder.create<fir::AddrOfOp>(loc, signature, symbolRefAttr);
|
|
return funcPtr;
|
|
}
|
|
const Fortran::semantics::Symbol *symbol = proc.GetSymbol();
|
|
assert(symbol && "expected symbol in ProcedureDesignator");
|
|
mlir::Value funcPtr;
|
|
mlir::Value funcPtrResultLength;
|
|
if (Fortran::semantics::IsDummy(*symbol)) {
|
|
Fortran::lower::SymbolBox val = symMap.lookupSymbol(*symbol);
|
|
assert(val && "Dummy procedure not in symbol map");
|
|
funcPtr = val.getAddr();
|
|
if (fir::isCharacterProcedureTuple(funcPtr.getType(),
|
|
/*acceptRawFunc=*/false))
|
|
std::tie(funcPtr, funcPtrResultLength) =
|
|
fir::factory::extractCharacterProcedureTuple(builder, loc, funcPtr);
|
|
} else {
|
|
mlir::func::FuncOp func =
|
|
Fortran::lower::getOrDeclareFunction(proc, converter);
|
|
mlir::SymbolRefAttr nameAttr = builder.getSymbolRefAttr(func.getSymName());
|
|
funcPtr =
|
|
builder.create<fir::AddrOfOp>(loc, func.getFunctionType(), nameAttr);
|
|
}
|
|
if (Fortran::lower::mustPassLengthWithDummyProcedure(proc, converter)) {
|
|
// The result length, if available here, must be propagated along the
|
|
// procedure address so that call sites where the result length is assumed
|
|
// can retrieve the length.
|
|
Fortran::evaluate::DynamicType resultType = proc.GetType().value();
|
|
if (const auto &lengthExpr = resultType.GetCharLength()) {
|
|
// The length expression may refer to dummy argument symbols that are
|
|
// meaningless without any actual arguments. Leave the length as
|
|
// unknown in that case, it be resolved on the call site
|
|
// with the actual arguments.
|
|
if (areAllSymbolsInExprMapped(*lengthExpr, symMap)) {
|
|
mlir::Value rawLen = fir::getBase(
|
|
converter.genExprValue(toEvExpr(*lengthExpr), stmtCtx));
|
|
// F2018 7.4.4.2 point 5.
|
|
funcPtrResultLength =
|
|
fir::factory::genMaxWithZero(builder, loc, rawLen);
|
|
}
|
|
}
|
|
if (!funcPtrResultLength)
|
|
funcPtrResultLength = builder.createIntegerConstant(
|
|
loc, builder.getCharacterLengthType(), -1);
|
|
return fir::CharBoxValue{funcPtr, funcPtrResultLength};
|
|
}
|
|
return funcPtr;
|
|
}
|
|
|
|
static hlfir::EntityWithAttributes designateProcedurePointerComponent(
|
|
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::evaluate::Symbol &procComponentSym, mlir::Value base,
|
|
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
|
|
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
|
fir::FortranVariableFlagsAttr attributes =
|
|
Fortran::lower::translateSymbolAttributes(builder.getContext(),
|
|
procComponentSym);
|
|
/// Passed argument may be a descriptor. This is a scalar reference, so the
|
|
/// base address can be directly addressed.
|
|
if (base.getType().isa<fir::BaseBoxType>())
|
|
base = builder.create<fir::BoxAddrOp>(loc, base);
|
|
std::string fieldName = converter.getRecordTypeFieldName(procComponentSym);
|
|
auto recordType =
|
|
hlfir::getFortranElementType(base.getType()).cast<fir::RecordType>();
|
|
mlir::Type fieldType = recordType.getType(fieldName);
|
|
// FIXME: semantics is not expanding intermediate parent components in:
|
|
// call x%p() where p is a component of a parent type of x type.
|
|
if (!fieldType)
|
|
TODO(loc, "reference to procedure pointer component from parent type");
|
|
mlir::Type designatorType = fir::ReferenceType::get(fieldType);
|
|
mlir::Value compRef = builder.create<hlfir::DesignateOp>(
|
|
loc, designatorType, base, fieldName,
|
|
/*compShape=*/mlir::Value{}, hlfir::DesignateOp::Subscripts{},
|
|
/*substring=*/mlir::ValueRange{},
|
|
/*complexPart=*/std::nullopt,
|
|
/*shape=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{}, attributes);
|
|
return hlfir::EntityWithAttributes{compRef};
|
|
}
|
|
|
|
static hlfir::EntityWithAttributes convertProcedurePointerComponent(
|
|
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::evaluate::Component &procComponent,
|
|
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
|
|
fir::ExtendedValue baseExv = Fortran::lower::convertDataRefToValue(
|
|
loc, converter, procComponent.base(), symMap, stmtCtx);
|
|
mlir::Value base = fir::getBase(baseExv);
|
|
const Fortran::semantics::Symbol &procComponentSym =
|
|
procComponent.GetLastSymbol();
|
|
return designateProcedurePointerComponent(loc, converter, procComponentSym,
|
|
base, symMap, stmtCtx);
|
|
}
|
|
|
|
hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
|
|
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::evaluate::ProcedureDesignator &proc,
|
|
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
|
|
const auto *sym = proc.GetSymbol();
|
|
if (sym) {
|
|
if (sym->GetUltimate().attrs().test(Fortran::semantics::Attr::INTRINSIC))
|
|
TODO(loc, "Procedure pointer with intrinsic target.");
|
|
if (std::optional<fir::FortranVariableOpInterface> varDef =
|
|
symMap.lookupVariableDefinition(*sym))
|
|
return *varDef;
|
|
}
|
|
|
|
if (const Fortran::evaluate::Component *procComponent = proc.GetComponent())
|
|
return convertProcedurePointerComponent(loc, converter, *procComponent,
|
|
symMap, stmtCtx);
|
|
|
|
fir::ExtendedValue procExv =
|
|
convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
|
|
// Directly package the procedure address as a fir.boxproc or
|
|
// tuple<fir.boxbroc, len> so that it can be returned as a single mlir::Value.
|
|
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
|
|
|
mlir::Value funcAddr = fir::getBase(procExv);
|
|
if (!funcAddr.getType().isa<fir::BoxProcType>()) {
|
|
mlir::Type boxTy =
|
|
Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext());
|
|
if (auto host = Fortran::lower::argumentHostAssocs(converter, funcAddr))
|
|
funcAddr = builder.create<fir::EmboxProcOp>(
|
|
loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});
|
|
else
|
|
funcAddr = builder.create<fir::EmboxProcOp>(loc, boxTy, funcAddr);
|
|
}
|
|
|
|
mlir::Value res = procExv.match(
|
|
[&](const fir::CharBoxValue &box) -> mlir::Value {
|
|
mlir::Type tupleTy =
|
|
fir::factory::getCharacterProcedureTupleType(funcAddr.getType());
|
|
return fir::factory::createCharacterProcedureTuple(
|
|
builder, loc, tupleTy, funcAddr, box.getLen());
|
|
},
|
|
[funcAddr](const auto &) { return funcAddr; });
|
|
return hlfir::EntityWithAttributes{res};
|
|
}
|
|
|
|
mlir::Value Fortran::lower::convertProcedureDesignatorInitialTarget(
|
|
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
|
|
const Fortran::semantics::Symbol &sym) {
|
|
Fortran::lower::SymMap globalOpSymMap;
|
|
Fortran::lower::StatementContext stmtCtx;
|
|
Fortran::evaluate::ProcedureDesignator proc(sym);
|
|
auto procVal{Fortran::lower::convertProcedureDesignatorToHLFIR(
|
|
loc, converter, proc, globalOpSymMap, stmtCtx)};
|
|
return fir::getBase(Fortran::lower::convertToAddress(
|
|
loc, converter, procVal, stmtCtx, procVal.getType()));
|
|
}
|
|
|
|
mlir::Value Fortran::lower::derefPassProcPointerComponent(
|
|
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::evaluate::ProcedureDesignator &proc, mlir::Value passedArg,
|
|
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
|
|
const Fortran::semantics::Symbol *procComponentSym = proc.GetSymbol();
|
|
assert(procComponentSym &&
|
|
"failed to retrieve pointer procedure component symbol");
|
|
hlfir::EntityWithAttributes pointerComp = designateProcedurePointerComponent(
|
|
loc, converter, *procComponentSym, passedArg, symMap, stmtCtx);
|
|
return converter.getFirOpBuilder().create<fir::LoadOp>(loc, pointerComp);
|
|
}
|