fac349a169
…ted. (#89998)" (#90250)
This partially reverts commit 7aedd7dc75.
This change removes calls to the deprecated member functions. It does
not mark the functions deprecated yet and does not disable the
deprecation warning in TypeSwitch. This seems to cause problems with
MSVC.
211 lines
9.9 KiB
C++
211 lines
9.9 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 (mlir::isa<fir::BaseBoxType>(base.getType()))
|
|
base = builder.create<fir::BoxAddrOp>(loc, base);
|
|
std::string fieldName = converter.getRecordTypeFieldName(procComponentSym);
|
|
auto recordType =
|
|
mlir::cast<fir::RecordType>(hlfir::getFortranElementType(base.getType()));
|
|
mlir::Type fieldType = recordType.getType(fieldName);
|
|
// Note: semantics turns x%p() into x%t%p() when the procedure pointer
|
|
// component is part of parent component t.
|
|
if (!fieldType)
|
|
TODO(loc, "passing type bound procedure (extension)");
|
|
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 (!mlir::isa<fir::BoxProcType>(funcAddr.getType())) {
|
|
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);
|
|
}
|