[Flang]: Lowering reference to functions that return a procedure pointer

[DanielCChen]

This PR adds lowering the reference to a function that returns a procedure pointer. It also fixed intrinsic ASSOCIATED to take such argument.

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

Author: Daniel Chen (DanielCChen)

Changes

This PR adds lowering the reference to a function that returns a procedure pointer.

Note: The LIT test will be added once the lowering design is confirmed.

---

Full diff: https://github.com/llvm/llvm-project/pull/78194.diff

3 Files Affected:

• (modified) flang/lib/Lower/CallInterface.cpp (+33-31)
• (modified) flang/lib/Lower/ConvertCall.cpp (+9-1)
• (modified) flang/lib/Lower/ConvertExprToHLFIR.cpp (+8-3)

diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 45487197fcbbbe..a7a69fffe90627 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1115,39 +1115,41 @@ class Fortran::lower::CallInterfaceImpl {
       const Fortran::evaluate::characteristics::FunctionResult &result) {
     using Attr = Fortran::evaluate::characteristics::FunctionResult::Attr;
     mlir::Type mlirType;
-    if (auto proc{result.IsProcedurePointer()})
+    if (auto proc{result.IsProcedurePointer()}) {
       mlirType = fir::BoxProcType::get(
           &mlirContext, getProcedureType(*proc, interface.converter));
-    else {
-      const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
-          result.GetTypeAndShape();
-      assert(typeAndShape && "expect type for non proc pointer result");
-      mlirType = translateDynamicType(typeAndShape->type());
-      fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape());
-      const auto *resTypeAndShape{result.GetTypeAndShape()};
-      bool resIsPolymorphic =
-          resTypeAndShape && resTypeAndShape->type().IsPolymorphic();
-      bool resIsAssumedType =
-          resTypeAndShape && resTypeAndShape->type().IsAssumedType();
-      if (!bounds.empty())
-        mlirType = fir::SequenceType::get(bounds, mlirType);
-      if (result.attrs.test(Attr::Allocatable))
-        mlirType = fir::wrapInClassOrBoxType(
-            fir::HeapType::get(mlirType), resIsPolymorphic, resIsAssumedType);
-      if (result.attrs.test(Attr::Pointer))
-        mlirType =
-            fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType),
-                                      resIsPolymorphic, resIsAssumedType);
-
-      if (fir::isa_char(mlirType)) {
-        // Character scalar results must be passed as arguments in lowering so
-        // that an assumed length character function callee can access the
-        // result length. A function with a result requiring an explicit
-        // interface does not have to be compatible with assumed length
-        // function, but most compilers supports it.
-        handleImplicitCharacterResult(typeAndShape->type());
-        return;
-      }
+      addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
+                   Property::Value);
+      return;
+    }
+
+    const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
+        result.GetTypeAndShape();
+    assert(typeAndShape && "expect type for non proc pointer result");
+    mlirType = translateDynamicType(typeAndShape->type());
+    fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape());
+    const auto *resTypeAndShape{result.GetTypeAndShape()};
+    bool resIsPolymorphic =
+        resTypeAndShape && resTypeAndShape->type().IsPolymorphic();
+    bool resIsAssumedType =
+        resTypeAndShape && resTypeAndShape->type().IsAssumedType();
+    if (!bounds.empty())
+      mlirType = fir::SequenceType::get(bounds, mlirType);
+    if (result.attrs.test(Attr::Allocatable))
+      mlirType = fir::wrapInClassOrBoxType(fir::HeapType::get(mlirType),
+                                           resIsPolymorphic, resIsAssumedType);
+    if (result.attrs.test(Attr::Pointer))
+      mlirType = fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType),
+                                           resIsPolymorphic, resIsAssumedType);
+
+    if (fir::isa_char(mlirType)) {
+      // Character scalar results must be passed as arguments in lowering so
+      // that an assumed length character function callee can access the
+      // result length. A function with a result requiring an explicit
+      // interface does not have to be compatible with assumed length
+      // function, but most compilers supports it.
+      handleImplicitCharacterResult(typeAndShape->type());
+      return;
     }
 
     addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 57ac9d0652b317..f76ec5f007e6bb 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -156,7 +156,10 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
   // Handle cases where caller must allocate the result or a fir.box for it.
   bool mustPopSymMap = false;
-  if (caller.mustMapInterfaceSymbols()) {
+
+  // Is procedure pointer functin result.
+  bool isProcedurePointer = resultType->isa<fir::BoxProcType>();
+  if (!isProcedurePointer && caller.mustMapInterfaceSymbols()) {
     symMap.pushScope();
     mustPopSymMap = true;
     Fortran::lower::mapCallInterfaceSymbols(converter, caller, symMap);
@@ -202,6 +205,8 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
     llvm::SmallVector<mlir::Value> lengths;
     if (!caller.callerAllocateResult())
       return {};
+    if (isProcedurePointer)
+      return {};
     mlir::Type type = caller.getResultStorageType();
     if (type.isa<fir::SequenceType>())
       caller.walkResultExtents([&](const Fortran::lower::SomeExpr &e) {
@@ -1301,6 +1306,9 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
       loc, callContext.converter, callContext.symMap, callContext.stmtCtx,
       caller, callSiteType, callContext.resultType,
       callContext.isElementalProcWithArrayArgs());
+  // For procedure pointer function result, just return the call.
+  if (callContext.resultType->isa<fir::BoxProcType>())
+    return hlfir::EntityWithAttributes(fir::getBase(result));
 
   /// Clean-up associations and copy-in.
   for (auto cleanUp : callCleanUps)
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index a3ad10978e5986..f970100f234c4a 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1425,9 +1425,14 @@ class HlfirBuilder {
   }
 
   hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) {
-    TODO(
-        getLoc(),
-        "lowering function references that return procedure pointers to HLFIR");
+    fir::FirOpBuilder &builder = getBuilder();
+    Fortran::evaluate::ProcedureDesignator proc{expr.proc()};
+    auto procTy{Fortran::lower::translateSignature(proc, getConverter())};
+    mlir::Type resType = fir::BoxProcType::get(builder.getContext(), procTy);
+    auto result = Fortran::lower::convertCallToHLFIR(
+        getLoc(), getConverter(), expr, resType, getSymMap(), getStmtCtx());
+    assert(result.has_value());
+    return *result;
   }
 
   template <typename T>

[jeanPerier]

Thanks you for working on this, the general approach looks good to me. Minor comments inlined.

[jeanPerier]

It seems to be legal to use procedure pointer result in ASSOCIATED, this currently crashes:

 interface
   function foo()
     procedure(), pointer :: foo
   end function
 end interface
 print *, associated(foo())
 end

So either the fir.boxproc results needs to be placed in a storage after the call so that code that expects to get pointers works, or the ASSOCIATED lowering should accept fir.boxproc as first argument too.

llvm-project/flang/lib/Optimizer/Builder/IntrinsicCall.cpp

Line 2180 in a90347e

fir::emitFatalError(loc, "pointer not a MutableBoxValue");

[DanielCChen]

It seems to be legal to use procedure pointer result in ASSOCIATED, this currently crashes:

 interface
   function foo()
     procedure(), pointer :: foo
   end function
 end interface
 print *, associated(foo())
 end

So either the fir.boxproc results needs to be placed in a storage after the call so that code that expects to get pointers works, or the ASSOCIATED lowering should accept fir.boxproc as first argument too.

llvm-project/flang/lib/Optimizer/Builder/IntrinsicCall.cpp

Line 2180 in a90347e

fir::emitFatalError(loc, "pointer not a MutableBoxValue");

Good point. With the current implementation, I think I can make genAssociated to take fir.boxproc as the type of arg[0] and skip the fir::load.

[github-actions]

✅ With the latest revision this PR passed the C/C++ code formatter.

[jeanPerier]

Looks great, thanks for the updates!