flang/lib/Lower/ConvertProcedureDesignator.cpp

   1 //===- ConvertProcedureDesignator.cpp -- Procedure Designator ---*- C++ -*-===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "flang/Lower/ConvertProcedureDesignator.h"
  10 #include "flang/Evaluate/intrinsics.h"
  11 #include "flang/Lower/AbstractConverter.h"
  12 #include "flang/Lower/CallInterface.h"
  13 #include "flang/Lower/ConvertCall.h"
  14 #include "flang/Lower/ConvertExprToHLFIR.h"
  15 #include "flang/Lower/ConvertVariable.h"
  16 #include "flang/Lower/Support/Utils.h"
  17 #include "flang/Lower/SymbolMap.h"
  18 #include "flang/Optimizer/Builder/Character.h"
  19 #include "flang/Optimizer/Builder/IntrinsicCall.h"
  20 #include "flang/Optimizer/Builder/Todo.h"
  21 #include "flang/Optimizer/Dialect/FIROps.h"
  22 #include "flang/Optimizer/HLFIR/HLFIROps.h"
  23
  24 static bool areAllSymbolsInExprMapped(const Fortran::evaluate::ExtentExpr &expr,
  25                                       Fortran::lower::SymMap &symMap) {
  26   for (const auto &sym : Fortran::evaluate::CollectSymbols(expr))
  27     if (!symMap.lookupSymbol(sym))
  28       return false;
  29   return true;
  30 }
  31
  32 fir::ExtendedValue Fortran::lower::convertProcedureDesignator(
  33     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
  34     const Fortran::evaluate::ProcedureDesignator &proc,
  35     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
  36   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  37
  38   if (const Fortran::evaluate::SpecificIntrinsic *intrinsic =
  39           proc.GetSpecificIntrinsic()) {
  40     mlir::FunctionType signature =
  41         Fortran::lower::translateSignature(proc, converter);
  42     // Intrinsic lowering is based on the generic name, so retrieve it here in
  43     // case it is different from the specific name. The type of the specific
  44     // intrinsic is retained in the signature.
  45     std::string genericName =
  46         converter.getFoldingContext().intrinsics().GetGenericIntrinsicName(
  47             intrinsic->name);
  48     mlir::SymbolRefAttr symbolRefAttr =
  49         fir::getUnrestrictedIntrinsicSymbolRefAttr(builder, loc, genericName,
  50                                                    signature);
  51     mlir::Value funcPtr =
  52         builder.create<fir::AddrOfOp>(loc, signature, symbolRefAttr);
  53     return funcPtr;
  54   }
  55   const Fortran::semantics::Symbol *symbol = proc.GetSymbol();
  56   assert(symbol && "expected symbol in ProcedureDesignator");
  57   mlir::Value funcPtr;
  58   mlir::Value funcPtrResultLength;
  59   if (Fortran::semantics::IsDummy(*symbol)) {
  60     Fortran::lower::SymbolBox val = symMap.lookupSymbol(*symbol);
  61     assert(val && "Dummy procedure not in symbol map");
  62     funcPtr = val.getAddr();
  63     if (fir::isCharacterProcedureTuple(funcPtr.getType(),
  64                                        /*acceptRawFunc=*/false))
  65       std::tie(funcPtr, funcPtrResultLength) =
  66           fir::factory::extractCharacterProcedureTuple(builder, loc, funcPtr);
  67   } else {
  68     mlir::func::FuncOp func =
  69         Fortran::lower::getOrDeclareFunction(proc, converter);
  70     mlir::SymbolRefAttr nameAttr = builder.getSymbolRefAttr(func.getSymName());
  71     funcPtr =
  72         builder.create<fir::AddrOfOp>(loc, func.getFunctionType(), nameAttr);
  73   }
  74   if (Fortran::lower::mustPassLengthWithDummyProcedure(proc, converter)) {
  75     // The result length, if available here, must be propagated along the
  76     // procedure address so that call sites where the result length is assumed
  77     // can retrieve the length.
  78     Fortran::evaluate::DynamicType resultType = proc.GetType().value();
  79     if (const auto &lengthExpr = resultType.GetCharLength()) {
  80       // The length expression may refer to dummy argument symbols that are
  81       // meaningless without any actual arguments. Leave the length as
  82       // unknown in that case, it be resolved on the call site
  83       // with the actual arguments.
  84       if (areAllSymbolsInExprMapped(*lengthExpr, symMap)) {
  85         mlir::Value rawLen = fir::getBase(
  86             converter.genExprValue(toEvExpr(*lengthExpr), stmtCtx));
  87         // F2018 7.4.4.2 point 5.
  88         funcPtrResultLength =
  89             fir::factory::genMaxWithZero(builder, loc, rawLen);
  90       }
  91     }
  92     // The caller of the function pointer will have to allocate
  93     // the function result with the character length specified
  94     // by the boxed value. If the result length cannot be
  95     // computed statically, set it to zero (we used to use -1,
  96     // but this could cause assertions in LLVM after inlining
  97     // exposed alloca of size -1).
  98     if (!funcPtrResultLength)
  99       funcPtrResultLength = builder.createIntegerConstant(
 100           loc, builder.getCharacterLengthType(), 0);
 101     return fir::CharBoxValue{funcPtr, funcPtrResultLength};
 102   }
 103   return funcPtr;
 104 }
 105
 106 static hlfir::EntityWithAttributes designateProcedurePointerComponent(
 107     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
 108     const Fortran::evaluate::Symbol &procComponentSym, mlir::Value base,
 109     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
 110   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
 111   fir::FortranVariableFlagsAttr attributes =
 112       Fortran::lower::translateSymbolAttributes(builder.getContext(),
 113                                                 procComponentSym);
 114   /// Passed argument may be a descriptor. This is a scalar reference, so the
 115   /// base address can be directly addressed.
 116   if (mlir::isa<fir::BaseBoxType>(base.getType()))
 117     base = builder.create<fir::BoxAddrOp>(loc, base);
 118   std::string fieldName = converter.getRecordTypeFieldName(procComponentSym);
 119   auto recordType =
 120       mlir::cast<fir::RecordType>(hlfir::getFortranElementType(base.getType()));
 121   mlir::Type fieldType = recordType.getType(fieldName);
 122   // Note: semantics turns x%p() into x%t%p() when the procedure pointer
 123   // component is part of parent component t.
 124   if (!fieldType)
 125     TODO(loc, "passing type bound procedure (extension)");
 126   mlir::Type designatorType = fir::ReferenceType::get(fieldType);
 127   mlir::Value compRef = builder.create<hlfir::DesignateOp>(
 128       loc, designatorType, base, fieldName,
 129       /*compShape=*/mlir::Value{}, hlfir::DesignateOp::Subscripts{},
 130       /*substring=*/mlir::ValueRange{},
 131       /*complexPart=*/std::nullopt,
 132       /*shape=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{}, attributes);
 133   return hlfir::EntityWithAttributes{compRef};
 134 }
 135
 136 static hlfir::EntityWithAttributes convertProcedurePointerComponent(
 137     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
 138     const Fortran::evaluate::Component &procComponent,
 139     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
 140   fir::ExtendedValue baseExv = Fortran::lower::convertDataRefToValue(
 141       loc, converter, procComponent.base(), symMap, stmtCtx);
 142   mlir::Value base = fir::getBase(baseExv);
 143   const Fortran::semantics::Symbol &procComponentSym =
 144       procComponent.GetLastSymbol();
 145   return designateProcedurePointerComponent(loc, converter, procComponentSym,
 146                                             base, symMap, stmtCtx);
 147 }
 148
 149 hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
 150     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
 151     const Fortran::evaluate::ProcedureDesignator &proc,
 152     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
 153   const auto *sym = proc.GetSymbol();
 154   if (sym) {
 155     if (sym->GetUltimate().attrs().test(Fortran::semantics::Attr::INTRINSIC))
 156       TODO(loc, "Procedure pointer with intrinsic target.");
 157     if (std::optional<fir::FortranVariableOpInterface> varDef =
 158             symMap.lookupVariableDefinition(*sym))
 159       return *varDef;
 160   }
 161
 162   if (const Fortran::evaluate::Component *procComponent = proc.GetComponent())
 163     return convertProcedurePointerComponent(loc, converter, *procComponent,
 164                                             symMap, stmtCtx);
 165
 166   fir::ExtendedValue procExv =
 167       convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
 168   // Directly package the procedure address as a fir.boxproc or
 169   // tuple<fir.boxbroc, len> so that it can be returned as a single mlir::Value.
 170   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
 171
 172   mlir::Value funcAddr = fir::getBase(procExv);
 173   if (!mlir::isa<fir::BoxProcType>(funcAddr.getType())) {
 174     mlir::Type boxTy =
 175         Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext());
 176     if (auto host = Fortran::lower::argumentHostAssocs(converter, funcAddr))
 177       funcAddr = builder.create<fir::EmboxProcOp>(
 178           loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});
 179     else
 180       funcAddr = builder.create<fir::EmboxProcOp>(loc, boxTy, funcAddr);
 181   }
 182
 183   mlir::Value res = procExv.match(
 184       [&](const fir::CharBoxValue &box) -> mlir::Value {
 185         mlir::Type tupleTy =
 186             fir::factory::getCharacterProcedureTupleType(funcAddr.getType());
 187         return fir::factory::createCharacterProcedureTuple(
 188             builder, loc, tupleTy, funcAddr, box.getLen());
 189       },
 190       [funcAddr](const auto &) { return funcAddr; });
 191   return hlfir::EntityWithAttributes{res};
 192 }
 193
 194 mlir::Value Fortran::lower::convertProcedureDesignatorInitialTarget(
 195     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
 196     const Fortran::semantics::Symbol &sym) {
 197   Fortran::lower::SymMap globalOpSymMap;
 198   Fortran::lower::StatementContext stmtCtx;
 199   Fortran::evaluate::ProcedureDesignator proc(sym);
 200   auto procVal{Fortran::lower::convertProcedureDesignatorToHLFIR(
 201       loc, converter, proc, globalOpSymMap, stmtCtx)};
 202   return fir::getBase(Fortran::lower::convertToAddress(
 203       loc, converter, procVal, stmtCtx, procVal.getType()));
 204 }
 205
 206 mlir::Value Fortran::lower::derefPassProcPointerComponent(
 207     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
 208     const Fortran::evaluate::ProcedureDesignator &proc, mlir::Value passedArg,
 209     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
 210   const Fortran::semantics::Symbol *procComponentSym = proc.GetSymbol();
 211   assert(procComponentSym &&
 212          "failed to retrieve pointer procedure component symbol");
 213   hlfir::EntityWithAttributes pointerComp = designateProcedurePointerComponent(
 214       loc, converter, *procComponentSym, passedArg, symMap, stmtCtx);
 215   return converter.getFirOpBuilder().create<fir::LoadOp>(loc, pointerComp);
 216 }