[Flang] Add partial support for lowering procedure pointer assignment.

[DanielCChen]

Scope of the PR:

1. Lowering global and local procedure pointer declaration statement with explicit or implicit interface. The explicit interface can be from an interface block, a module procedure or an internal procedure.
2. Lowering procedure pointer assignment, where the target procedure could be external, module or internal procedures.
3. Lowering reference to procedure pointers so that it works end to end.

PR notes:

1. The first commit of the PR does not include testing. I would like to collect some comments first, which may alter the output. Once I confirm the implementation, I will add some testing as a follow up commit to this PR.
2. No special handling of the host-associated entities when an internal procedure is the target of a procedure pointer assignment in this PR.

Implementation notes:

1. The implementation is using the HLFIR path.
2. Flang currently uses getUntypedBoxProcType to get the fir::BoxProcType for ProcedureDesignator when getting the address of a procedure in order to pass it as an actual argument. This PR inherits the same design decision for procedure pointer as the fir::StoreOp requires the same memory type.

[llvmbot]

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

@llvm/pr-subscribers-flang-codegen

Author: Daniel Chen (DanielCChen)

Changes

Scope of the PR:

1. Lowering global and local procedure pointer declaration statement with explicit or implicit interface. The explicit interface can from an interface block, a module procedure or an internal procedure.
2. Lowering procedure pointer assignment, where the target procedure could be external, module or internal procedures.
3. Lowering reference to procedure pointers so that it works end to end.

PR notes:

1. The first commit of the PR does not include testing. I would like to collect some comments first, which may alter the output. Once I confirm the implementation, I will add some testing as a follow up commit to this PR.
2. No special handling of the host-associated entities when an internal procedure is the target of a procedure pointer assignment in this PR.

Implementation notes:

1. The implementation is using the HLFIR path.
2. Flang currently uses getUntypedBoxProcType to get the fir::BoxProcType for ProcedureDesignator when getting the address of a procedure in order to pass it as an actual argument. This PR inherits the same design decision for procedure pointer as the fir::StoreOp requires the same memory type.

---

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

5 Files Affected:

• (modified) flang/lib/Lower/Bridge.cpp (+7-2)
• (modified) flang/lib/Lower/ConvertCall.cpp (+9-1)
• (modified) flang/lib/Lower/ConvertProcedureDesignator.cpp (+4)
• (modified) flang/lib/Lower/ConvertType.cpp (+49-2)
• (modified) flang/lib/Lower/ConvertVariable.cpp (+53-6)

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 9875e37393ef869..b2f00fac481f909 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3224,8 +3224,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       mlir::Location loc, const Fortran::evaluate::Assignment &assign,
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
     Fortran::lower::StatementContext stmtCtx;
-    if (Fortran::evaluate::IsProcedure(assign.rhs))
-      TODO(loc, "procedure pointer assignment");
+
+    if (Fortran::evaluate::IsProcedure(assign.rhs)) {
+      auto lhs{fir::getBase(genExprAddr(assign.lhs, stmtCtx, &loc))};
+      auto rhs{fir::getBase(genExprAddr(assign.rhs, stmtCtx, &loc))};
+      builder->create<fir::StoreOp>(loc, rhs, lhs);
+      return;
+    }
 
     std::optional<Fortran::evaluate::DynamicType> lhsType =
         assign.lhs.GetType();
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index bc9426827c3ba1d..6918001a3f17baa 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -165,8 +165,10 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // will be used only if there is no explicit length in the local interface).
   mlir::Value funcPointer;
   mlir::Value charFuncPointerLength;
+  bool isProcPtr = false;
   if (const Fortran::semantics::Symbol *sym =
           caller.getIfIndirectCallSymbol()) {
+    isProcPtr = Fortran::semantics::IsProcedurePointer(sym);
     funcPointer = fir::getBase(converter.getSymbolExtendedValue(*sym, &symMap));
     if (!funcPointer)
       fir::emitFatalError(loc, "failed to find indirect call symbol address");
@@ -325,7 +327,13 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // compatible interface in Fortran, but that have different signatures in
   // FIR.
   if (funcPointer) {
-    operands.push_back(
+    if (isProcPtr) {
+      auto funcVal{builder.create<fir::LoadOp>(loc, funcPointer)};
+      auto boxProcTy{fir::BoxProcType::get(builder.getContext(), funcType)};
+      auto func{builder.createConvert(loc, boxProcTy, funcVal)};
+      operands.push_back(builder.create<fir::BoxAddrOp>(loc, funcType, func));
+    } else
+      operands.push_back(
         funcPointer.getType().isa<fir::BoxProcType>()
             ? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
             : builder.createConvert(loc, funcType, funcPointer));
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index 20ade1a04049fc4..b02fb3eb38141c8 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -98,6 +98,10 @@ 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) {
+  if (std::optional<fir::FortranVariableOpInterface> varDef =
+          symMap.lookupVariableDefinition(*proc.GetSymbol()))
+    return *varDef;
+
   fir::ExtendedValue procExv =
       convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
   // Directly package the procedure address as a fir.boxproc or
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 1ed3b602621b449..25e301dbf8a4b29 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -24,6 +24,10 @@
 #define DEBUG_TYPE "flang-lower-type"
 
 using Fortran::common::VectorElementCategory;
+using Fortran::semantics::Details;
+using Fortran::semantics::ProcEntityDetails;
+using Fortran::semantics::SubprogramDetails;
+using Fortran::semantics::UseDetails;
 
 //===--------------------------------------------------------------------===//
 // Intrinsic type translation helpers
@@ -248,8 +252,22 @@ struct TypeBuilderImpl {
     // links, the fir type is built based on the ultimate symbol. This relies
     // on the fact volatile and asynchronous are not reflected in fir types.
     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
-    if (Fortran::semantics::IsProcedurePointer(ultimate))
-      TODO(loc, "procedure pointers");
+
+    if (Fortran::semantics::IsProcedurePointer(ultimate)) {
+      const auto procDetails{ultimate.detailsIf<ProcEntityDetails>()};
+      if (!procDetails)
+        fir::emitFatalError(loc, "Procedure pointer must be ProcEntity.");
+
+      // Procedure pointer with an explicit interface
+      if (const auto procIface{procDetails->procInterface()})
+        return genProcType(procIface, loc);
+
+      // Procedure pointer with an implicit interface
+      llvm::SmallVector<mlir::Type> resTys;
+      llvm::SmallVector<mlir::Type> argTys;
+      return mlir::FunctionType::get(context, argTys, resTys);
+    }
+
     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
               type->AsIntrinsic()) {
@@ -560,6 +578,35 @@ struct TypeBuilderImpl {
     derivedTypeInConstruction.pop_back();
   }
 
+  mlir::Type genProcType(const Fortran::semantics::Symbol *proc,
+                         mlir::Location loc) {
+    if (auto procDetails{proc->detailsIf<SubprogramDetails>()})
+      return genFunctionType(*procDetails);
+
+    // Use association. Need to get to the ultimate definition.
+    if (auto procDetails{proc->detailsIf<UseDetails>()}) {
+      auto sym{procDetails->symbol()};
+      for (;sym.detailsIf<UseDetails>();)
+        sym = sym.detailsIf<UseDetails>()->symbol();
+      if (auto pd{sym.detailsIf<SubprogramDetails>()})
+        return genFunctionType(*pd);
+    }
+    fir::emitFatalError(loc, "Procedure pointer error.");
+  }
+
+  mlir::FunctionType genFunctionType(const SubprogramDetails &details) {
+    llvm::SmallVector<mlir::Type> resTys;
+    llvm::SmallVector<mlir::Type> argTys;
+    if (details.isFunction())
+      resTys.emplace_back(genSymbolType(details.result()));
+    for (auto args : details.dummyArgs())
+      if (args->attrs().test(Fortran::semantics::Attr::VALUE))
+        argTys.emplace_back(genSymbolType(*args));
+      else
+        argTys.emplace_back(fir::ReferenceType::get(genSymbolType(*args)));
+    return mlir::FunctionType::get(context, argTys, resTys);
+  }
+
   /// Stack derived type being processed to avoid infinite loops in case of
   /// recursive derived types. The depth of derived types is expected to be
   /// shallow (<10), so a SmallVector is sufficient.
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 57fb9fc432de2ff..54dd5709b4a7ce9 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -479,8 +479,20 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
   if (global && globalIsInitialized(global))
     return global;
 
-  if (Fortran::semantics::IsProcedurePointer(sym))
-    TODO(loc, "procedure pointer globals");
+  if (Fortran::semantics::IsProcedurePointer(sym)) {
+    auto boxProcTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
+    global = builder.createGlobal(loc, boxProcTy, globalName, linkage,
+                                  mlir::Attribute{}, isConst, var.isTarget());
+    Fortran::lower::createGlobalInitialization(
+        builder, global, [&](fir::FirOpBuilder &builder) {
+          mlir::Value initVal{builder.create<fir::ZeroOp>(loc, symTy)};
+          auto emBoxVal{
+              builder.create<fir::EmboxProcOp>(loc, boxProcTy, initVal)};
+          builder.create<fir::HasValueOp>(loc, emBoxVal);
+        });
+    global.setVisibility(mlir::SymbolTable::Visibility::Public);
+    return global;
+  }
 
   // If this is an array, check to see if we can use a dense attribute
   // with a tensor mlir type. This optimization currently only supports
@@ -645,8 +657,19 @@ static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
       var.getSymbol().GetUltimate();
   llvm::StringRef symNm = toStringRef(ultimateSymbol.name());
   bool isTarg = var.isTarget();
+
   // Let the builder do all the heavy lifting.
-  return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
+  if (!Fortran::semantics::IsProcedurePointer(ultimateSymbol))
+    return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
+
+  // Local procedure pointer.
+  auto boxProcTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
+  auto res{builder.allocateLocal(loc, boxProcTy, nm, symNm, shape, lenParams,
+                                 isTarg)};
+  mlir::Value initVal{builder.create<fir::ZeroOp>(loc, ty)};
+  auto emBoxVal{builder.create<fir::EmboxProcOp>(loc, boxProcTy, initVal)};
+  builder.create<fir::StoreOp>(loc, emBoxVal, res);
+  return res;
 }
 
 /// Must \p var be default initialized at runtime when entering its scope.
@@ -1542,7 +1565,8 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
   // is useful to maintain the address of the commonblock in an MLIR value and
   // query it. hlfir.declare need not be created for these.
   if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
-      !Fortran::semantics::IsProcedure(sym) &&
+      (!Fortran::semantics::IsProcedure(sym) ||
+       Fortran::semantics::IsPointer(sym)) &&
       !sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
     bool isCrayPointee =
         sym.test(Fortran::semantics::Symbol::Flag::CrayPointee);
@@ -1683,6 +1707,17 @@ genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter,
                    /*lbounds=*/std::nullopt, force);
 }
 
+/// Map a procedure pointer
+static void
+genProcPointer(Fortran::lower::AbstractConverter &converter,
+               Fortran::lower::SymMap &symMap,
+               const Fortran::semantics::Symbol &sym,
+               mlir::Value addr, bool force = false) {
+  genDeclareSymbol(converter, symMap, sym, addr, mlir::Value {},
+                   /*shape=*/std::nullopt,
+                   /*lbounds=*/std::nullopt, force);
+}
+
 /// Map a symbol represented with a runtime descriptor to its FIR fir.box and
 /// evaluated specification expressions. Will optionally create fir.declare.
 static void genBoxDeclare(Fortran::lower::AbstractConverter &converter,
@@ -1734,8 +1769,20 @@ void Fortran::lower::mapSymbolAttributes(
 
       Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp);
     }
-    if (Fortran::semantics::IsPointer(sym))
-      TODO(loc, "procedure pointers");
+
+    // Procedure pointer.
+    if (Fortran::semantics::IsPointer(sym)) {
+      // global
+      mlir::Value boxAlloc = preAlloc;
+      // dummy or passed result
+      if (!boxAlloc)
+        if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym))
+          boxAlloc = symbox.getAddr();
+      // local
+      if (!boxAlloc)
+        boxAlloc = createNewLocal(converter, loc, var, preAlloc);
+      genProcPointer(converter, symMap, sym, boxAlloc, replace);
+    }
     return;
   }
 

[github-actions]

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

[jeanPerier]

I have comments about the code, but the overall lowering approach looks reasonable to me.

I am a bit surprised that you did not need to handle procedure pointers arguments in the CallInterface.cpp, but maybe the code there already worked.

[DanielCChen]

I have comments about the code, but the overall lowering approach looks reasonable to me.

I am a bit surprised that you did not need to handle procedure pointers arguments in the CallInterface.cpp, but maybe the code there already worked.

This PR does not have the code to handle procedure pointer arguments and function result yet. That is the next on my TODO list. It will be a separate PR though.

[github-actions]

✅ With the latest revision this PR passed the Python code formatter.

[DanielCChen]

Sorry to all the reviewers especially @jeanPerier. I messed up my PR branch when I tried to rebase it. I lost some comments when I tried to recover it. My apologies.

[DanielCChen]

Update: I pushed another commit to lower the procedure pointer actual/dummy argument. I am currently working on the procedure pointer function result.

[jeanPerier]

Looks great, thanks!

[DanielCChen]

Looks great, thanks!

Thanks again for the thorough review and very helpful comments!

[omjavaid]

This change appears to have broken following buildbots:
https://lab.llvm.org/buildbot/#/builders/176
https://lab.llvm.org/buildbot/#/builders/179
https://lab.llvm.org/buildbot/#/builders/184
https://lab.llvm.org/buildbot/#/builders/197
https://lab.llvm.org/buildbot/#/builders/198

All bots fails in testsuite where following tests seems broken (eg: https://lab.llvm.org/buildbot/#/builders/176/builds/7131):
test-suite::gfortran-regression-compile-regression__proc_ptr_46_f90.test
test-suite::gfortran-regression-compile-regression__proc_ptr_37_f90.test

Its failing since 15 hours so I am going to revert this change for now.

Thanks!