xref: /llvm-project/flang/lib/Lower/ConvertProcedureDesignator.cpp (revision 49f55d107548a340992eaec1b9767c0f8fc443cd)
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/ConvertVariable.h"
15 #include "flang/Lower/Support/Utils.h"
16 #include "flang/Lower/SymbolMap.h"
17 #include "flang/Optimizer/Builder/Character.h"
18 #include "flang/Optimizer/Builder/IntrinsicCall.h"
19 #include "flang/Optimizer/Dialect/FIROps.h"
20 
21 static bool areAllSymbolsInExprMapped(const Fortran::evaluate::ExtentExpr &expr,
22                                       Fortran::lower::SymMap &symMap) {
23   for (const auto &sym : Fortran::evaluate::CollectSymbols(expr))
24     if (!symMap.lookupSymbol(sym))
25       return false;
26   return true;
27 }
28 
29 fir::ExtendedValue Fortran::lower::convertProcedureDesignator(
30     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
31     const Fortran::evaluate::ProcedureDesignator &proc,
32     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
33   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
34 
35   if (const Fortran::evaluate::SpecificIntrinsic *intrinsic =
36           proc.GetSpecificIntrinsic()) {
37     mlir::FunctionType signature =
38         Fortran::lower::translateSignature(proc, converter);
39     // Intrinsic lowering is based on the generic name, so retrieve it here in
40     // case it is different from the specific name. The type of the specific
41     // intrinsic is retained in the signature.
42     std::string genericName =
43         converter.getFoldingContext().intrinsics().GetGenericIntrinsicName(
44             intrinsic->name);
45     mlir::SymbolRefAttr symbolRefAttr =
46         fir::getUnrestrictedIntrinsicSymbolRefAttr(builder, loc, genericName,
47                                                    signature);
48     mlir::Value funcPtr =
49         builder.create<fir::AddrOfOp>(loc, signature, symbolRefAttr);
50     return funcPtr;
51   }
52   const Fortran::semantics::Symbol *symbol = proc.GetSymbol();
53   assert(symbol && "expected symbol in ProcedureDesignator");
54   mlir::Value funcPtr;
55   mlir::Value funcPtrResultLength;
56   if (Fortran::semantics::IsDummy(*symbol)) {
57     Fortran::lower::SymbolBox val = symMap.lookupSymbol(*symbol);
58     assert(val && "Dummy procedure not in symbol map");
59     funcPtr = val.getAddr();
60     if (fir::isCharacterProcedureTuple(funcPtr.getType(),
61                                        /*acceptRawFunc=*/false))
62       std::tie(funcPtr, funcPtrResultLength) =
63           fir::factory::extractCharacterProcedureTuple(builder, loc, funcPtr);
64   } else {
65     mlir::func::FuncOp func =
66         Fortran::lower::getOrDeclareFunction(proc, converter);
67     mlir::SymbolRefAttr nameAttr = builder.getSymbolRefAttr(func.getSymName());
68     funcPtr =
69         builder.create<fir::AddrOfOp>(loc, func.getFunctionType(), nameAttr);
70   }
71   if (Fortran::lower::mustPassLengthWithDummyProcedure(proc, converter)) {
72     // The result length, if available here, must be propagated along the
73     // procedure address so that call sites where the result length is assumed
74     // can retrieve the length.
75     Fortran::evaluate::DynamicType resultType = proc.GetType().value();
76     if (const auto &lengthExpr = resultType.GetCharLength()) {
77       // The length expression may refer to dummy argument symbols that are
78       // meaningless without any actual arguments. Leave the length as
79       // unknown in that case, it be resolved on the call site
80       // with the actual arguments.
81       if (areAllSymbolsInExprMapped(*lengthExpr, symMap)) {
82         mlir::Value rawLen = fir::getBase(
83             converter.genExprValue(toEvExpr(*lengthExpr), stmtCtx));
84         // F2018 7.4.4.2 point 5.
85         funcPtrResultLength =
86             fir::factory::genMaxWithZero(builder, loc, rawLen);
87       }
88     }
89     if (!funcPtrResultLength)
90       funcPtrResultLength = builder.createIntegerConstant(
91           loc, builder.getCharacterLengthType(), -1);
92     return fir::CharBoxValue{funcPtr, funcPtrResultLength};
93   }
94   return funcPtr;
95 }
96 
97 hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
98     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
99     const Fortran::evaluate::ProcedureDesignator &proc,
100     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
101   fir::ExtendedValue procExv =
102       convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
103   // Directly package the procedure address as a fir.boxproc or
104   // tuple<fir.boxbroc, len> so that it can be returned as a single mlir::Value.
105   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
106 
107   mlir::Value funcAddr = fir::getBase(procExv);
108   if (!funcAddr.getType().isa<fir::BoxProcType>()) {
109     mlir::Type boxTy =
110         Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext());
111     if (auto host = Fortran::lower::argumentHostAssocs(converter, funcAddr))
112       funcAddr = builder.create<fir::EmboxProcOp>(
113           loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});
114     else
115       funcAddr = builder.create<fir::EmboxProcOp>(loc, boxTy, funcAddr);
116   }
117 
118   mlir::Value res = procExv.match(
119       [&](const fir::CharBoxValue &box) -> mlir::Value {
120         mlir::Type tupleTy =
121             fir::factory::getCharacterProcedureTupleType(funcAddr.getType());
122         return fir::factory::createCharacterProcedureTuple(
123             builder, loc, tupleTy, funcAddr, box.getLen());
124       },
125       [funcAddr](const auto &) { return funcAddr; });
126   return hlfir::EntityWithAttributes{res};
127 }
128