diff --git a/flang/include/flang/Lower/ConvertProcedureDesignator.h b/flang/include/flang/Lower/ConvertProcedureDesignator.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/ConvertProcedureDesignator.h @@ -0,0 +1,44 @@ +//===- ConvertProcedureDesignator.h -- Procedure Designators ----*- 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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// +/// +/// Lowering of evaluate::ProcedureDesignator to FIR and HLFIR. +/// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_CONVERT_PROCEDURE_DESIGNATOR_H +#define FORTRAN_LOWER_CONVERT_PROCEDURE_DESIGNATOR_H + +namespace mlir { +class Location; +} +namespace fir { +class ExtendedValue; +} +namespace Fortran::evaluate { +struct ProcedureDesignator; +} + +namespace Fortran::lower { +class AbstractConverter; +class StatementContext; +class SymMap; + +/// Lower a procedure designator to a fir::ExtendedValue that can be a +/// fir::CharBoxValue for character procedure designator (the CharBoxValue +/// length carries the result length if it is known). +fir::ExtendedValue convertProcedureDesignator( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::evaluate::ProcedureDesignator &proc, + Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx); + +} // namespace Fortran::lower +#endif // FORTRAN_LOWER_CONVERT_PROCEDURE_DESIGNATOR_H diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -9,6 +9,7 @@ ConvertConstant.cpp ConvertExpr.cpp ConvertExprToHLFIR.cpp + ConvertProcedureDesignator.cpp ConvertType.cpp ConvertVariable.cpp ComponentPath.cpp diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -24,6 +24,7 @@ #include "flang/Lower/ComponentPath.h" #include "flang/Lower/ConvertCall.h" #include "flang/Lower/ConvertConstant.h" +#include "flang/Lower/ConvertProcedureDesignator.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/ConvertVariable.h" #include "flang/Lower/CustomIntrinsicCall.h" @@ -403,16 +404,6 @@ } } -/// Does \p expr only refer to symbols that are mapped to IR values in \p symMap -/// ? -static bool allSymbolsInExprPresentInMap(const Fortran::lower::SomeExpr &expr, - Fortran::lower::SymMap &symMap) { - for (const auto &sym : Fortran::evaluate::CollectSymbols(expr)) - if (!symMap.lookupSymbol(sym)) - return false; - return true; -} - /// Generate a load of a value from an address. Beware that this will lose /// any dynamic type information for polymorphic entities (note that unlimited /// polymorphic cannot be loaded and must not be provided here). @@ -880,66 +871,8 @@ /// The type of the function indirection is not guaranteed to match the one /// of the ProcedureDesignator due to Fortran implicit typing rules. ExtValue genval(const Fortran::evaluate::ProcedureDesignator &proc) { - mlir::Location loc = getLoc(); - 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(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 { - std::string name = converter.mangleName(*symbol); - mlir::func::FuncOp func = - Fortran::lower::getOrDeclareFunction(name, proc, converter); - funcPtr = builder.create(loc, func.getFunctionType(), - builder.getSymbolRefAttr(name)); - } - 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 (allSymbolsInExprPresentInMap(toEvExpr(*lengthExpr), symMap)) { - mlir::Value rawLen = fir::getBase(genval(*lengthExpr)); - // F2018 7.4.4.2 point 5. - funcPtrResultLength = - fir::factory::genMaxWithZero(builder, getLoc(), rawLen); - } - } - if (!funcPtrResultLength) - funcPtrResultLength = builder.createIntegerConstant( - loc, builder.getCharacterLengthType(), -1); - return fir::CharBoxValue{funcPtr, funcPtrResultLength}; - } - return funcPtr; + return Fortran::lower::convertProcedureDesignator(getLoc(), converter, proc, + symMap, stmtCtx); } ExtValue genval(const Fortran::evaluate::NullPointer &) { return builder.createNullConstant(getLoc()); diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp @@ -0,0 +1,95 @@ +//===- 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/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/Dialect/FIROps.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(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 { + std::string name = converter.mangleName(*symbol); + mlir::func::FuncOp func = + Fortran::lower::getOrDeclareFunction(name, proc, converter); + funcPtr = builder.create(loc, func.getFunctionType(), + builder.getSymbolRefAttr(name)); + } + 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; +}