[flang][hlfir] Lower procedure designators to HLFIR

- Add a convertProcedureDesignatorToHLFIR that converts the
  fir::ExtendedValue from the current lowering to a
  fir.boxproc/tuple<fir.boxproc, len> mlir::Value.

- Allow fir.boxproc/tuple<fir.boxproc, len> as hlfir::Entity values
  (a function is an address, but from a Fortran entity point of view,
  procedure that are not procedure pointers cannot be assigned to, so
  it makes a lot more sense to consider those as values).

- Modify symbol association to not generate an hlfir.declare for dummy
  procedures. They are not needed and allowing hlfir.declare to declare
  function values would make its verifier and handling overly complex
  for little benefits (maybe an hlfir.declare_proc could be added if it
  turnout out useful later for debug info and attributes storing
  purposes).

- Allow translation from hlfir::Entity to fir::ExtendedValue.
  convertToBox return type had to be relaxed because some intrinsics
  handles both object and procedure arguments and need to lower their
  object arguments "asBox". fir::BoxValue is not intended to carry
  dummy procedures (all its member functions would make little sense
  and its verifier does not accept such type).
  Note that AsAddr, AsValue and AsBox will always return the same MLIR
  value for procedure designators because they are always handled the
  same way in FIR.

Differential Revision: https://reviews.llvm.org/D143585

Author: jeanPerier

flang/include/flang/Lower/CallInterface.h

@@ -429,6 +429,9 @@ getOrDeclareFunction(llvm::StringRef name,
 mlir::Type getDummyProcedureType(const Fortran::semantics::Symbol &dummyProc,
                                  Fortran::lower::AbstractConverter &);
 
+/// Return !fir.boxproc<() -> ()> type.
+mlir::Type getUntypedBoxProcType(mlir::MLIRContext *context);
+
 /// Return true if \p ty is "!fir.ref<i64>", which is the interface for
 /// type(C_PTR/C_FUNPTR) passed by value.
 bool isCPtrArgByValueType(mlir::Type ty);

flang/include/flang/Lower/ConvertExprToHLFIR.h

@@ -48,21 +48,24 @@ translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
   return exv;
 }
 
-/// Lower an evaluate::Expr to a fir::Box.
-fir::BoxValue convertExprToBox(mlir::Location loc,
-                               Fortran::lower::AbstractConverter &,
-                               const Fortran::lower::SomeExpr &,
-                               Fortran::lower::SymMap &,
-                               Fortran::lower::StatementContext &);
-fir::BoxValue convertToBox(mlir::Location loc,
-                           Fortran::lower::AbstractConverter &,
-                           hlfir::Entity entity,
-                           Fortran::lower::StatementContext &,
-                           mlir::Type fortranType);
+/// Lower an evaluate::Expr object to a fir.box, and a procedure designator to a
+/// fir.boxproc<>
+fir::ExtendedValue convertExprToBox(mlir::Location loc,
+                                    Fortran::lower::AbstractConverter &,
+                                    const Fortran::lower::SomeExpr &,
+                                    Fortran::lower::SymMap &,
+                                    Fortran::lower::StatementContext &);
+fir::ExtendedValue convertToBox(mlir::Location loc,
+                                Fortran::lower::AbstractConverter &,
+                                hlfir::Entity entity,
+                                Fortran::lower::StatementContext &,
+                                mlir::Type fortranType);
 
 /// Lower an evaluate::Expr to fir::ExtendedValue address.
-/// The address may be a raw fir.ref<T>, or a fir.box<T>/fir.class<T>, (pointer
-/// and allocatable are dereferenced).
+/// The address may be a raw fir.ref<T>, or a fir.box<T>/fir.class<T>, or a
+/// fir.boxproc<>. Pointers and allocatable are dereferenced.
+/// - If the expression is a procedure designator, it is lowered to fir.boxproc
+/// (with an extra length for character function procedure designators).
 /// - If expression is not a variable, or is a designator with vector
 ///   subscripts, a temporary is created to hold the expression value and
 ///   is returned as:

flang/include/flang/Lower/ConvertProcedureDesignator.h

@@ -23,6 +23,9 @@ class Location;
 namespace fir {
 class ExtendedValue;
 }
+namespace hlfir {
+class EntityWithAttributes;
+}
 namespace Fortran::evaluate {
 struct ProcedureDesignator;
 }
@@ -40,5 +43,12 @@ fir::ExtendedValue convertProcedureDesignator(
     const Fortran::evaluate::ProcedureDesignator &proc,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx);
 
+/// Lower a procedure designator to a !fir.boxproc<()->() or
+/// tuple<!fir.boxproc<()->(), len>.
+hlfir::EntityWithAttributes convertProcedureDesignatorToHLFIR(
+    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

flang/include/flang/Optimizer/Builder/Character.h

@@ -224,9 +224,11 @@ mlir::Value createCharacterProcedureTuple(fir::FirOpBuilder &builder,
 
 /// Given a tuple containing a character function address and its result length,
 /// extract the tuple into a pair of value <function address, result length>.
+/// If openBoxProc is true, the function address is extracted from the
+/// fir.boxproc, otherwise, the returned function address is the fir.boxproc.
 std::pair<mlir::Value, mlir::Value>
 extractCharacterProcedureTuple(fir::FirOpBuilder &builder, mlir::Location loc,
-                               mlir::Value tuple);
+                               mlir::Value tuple, bool openBoxProc = true);
 
 } // namespace fir::factory
 

flang/include/flang/Optimizer/Builder/HLFIRTools.h

@@ -29,9 +29,18 @@ class AssociateOp;
 class ElementalOp;
 class YieldElementOp;
 
+/// Is this an SSA value type for the value of a Fortran procedure
+/// designator ?
+inline bool isFortranProcedureValue(mlir::Type type) {
+  return type.isa<fir::BoxProcType>() ||
+         (type.isa<mlir::TupleType>() &&
+          fir::isCharacterProcedureTuple(type, /*acceptRawFunc=*/false));
+}
+
 /// Is this an SSA value type for the value of a Fortran expression?
 inline bool isFortranValueType(mlir::Type type) {
-  return type.isa<hlfir::ExprType>() || fir::isa_trivial(type);
+  return type.isa<hlfir::ExprType>() || fir::isa_trivial(type) ||
+         isFortranProcedureValue(type);
 }
 
 /// Is this the value of a Fortran expression in an SSA value form?
@@ -77,6 +86,10 @@ class Entity : public mlir::Value {
   bool isBoxAddressOrValue() const {
     return hlfir::isBoxAddressOrValueType(getType());
   }
+
+  /// Is this entity a procedure designator?
+  bool isProcedure() const { return isFortranProcedureValue(getType()); }
+
   /// Is this an array or an assumed ranked entity?
   bool isArray() const { return getRank() != 0; }
 
@@ -357,7 +370,7 @@ std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
 convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder,
                  const hlfir::Entity &entity, mlir::Type targetType);
 
-std::pair<fir::BoxValue, std::optional<hlfir::CleanupFunction>>
+std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
 convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
              const hlfir::Entity &entity, mlir::Type targetType);
 } // namespace hlfir

flang/lib/Lower/Bridge.cpp

@@ -807,6 +807,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
             },
             [](auto x) -> Fortran::lower::SymbolBox { return x; });
       }
+      // Procedure dummies are not mapped with an hlfir.declare because
+      // they are not "variable" (cannot be assigned to), and it would
+      // make hlfir.declare more complex than it needs to to allow this.
+      // Do a regular lookup.
+      if (Fortran::semantics::IsProcedure(sym))
+        return symMap->lookupSymbol(sym);
       return {};
     }
     if (Fortran::lower::SymbolBox v = symMap->lookupSymbol(sym))

flang/lib/Lower/CallInterface.cpp

@@ -39,24 +39,27 @@ static std::string getMangledName(mlir::Location loc,
   return bindName ? *bindName : Fortran::lower::mangle::mangleName(symbol);
 }
 
+mlir::Type Fortran::lower::getUntypedBoxProcType(mlir::MLIRContext *context) {
+  llvm::SmallVector<mlir::Type> resultTys;
+  llvm::SmallVector<mlir::Type> inputTys;
+  auto untypedFunc = mlir::FunctionType::get(context, inputTys, resultTys);
+  return fir::BoxProcType::get(context, untypedFunc);
+}
+
 /// Return the type of a dummy procedure given its characteristic (if it has
 /// one).
-mlir::Type getProcedureDesignatorType(
+static mlir::Type getProcedureDesignatorType(
     const Fortran::evaluate::characteristics::Procedure *,
     Fortran::lower::AbstractConverter &converter) {
   // TODO: Get actual function type of the dummy procedure, at least when an
   // interface is given. The result type should be available even if the arity
   // and type of the arguments is not.
-  llvm::SmallVector<mlir::Type> resultTys;
-  llvm::SmallVector<mlir::Type> inputTys;
   // In general, that is a nice to have but we cannot guarantee to find the
   // function type that will match the one of the calls, we may not even know
   // how many arguments the dummy procedure accepts (e.g. if a procedure
   // pointer is only transiting through the current procedure without being
   // called), so a function type cast must always be inserted.
-  auto *context = &converter.getMLIRContext();
-  auto untypedFunc = mlir::FunctionType::get(context, inputTys, resultTys);
-  return fir::BoxProcType::get(context, untypedFunc);
+  return Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext());
 }
 
 //===----------------------------------------------------------------------===//

flang/lib/Lower/ConvertCall.cpp

@@ -782,6 +782,11 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
+  // Do nothing if this is a procedure argument. It is already a
+  // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
+  if (actual.isProcedure())
+    return PreparedDummyArgument{actual, std::nullopt};
+
   const bool passingPolymorphicToNonPolymorphic =
       actual.isPolymorphic() && !fir::isPolymorphicType(dummyType);
 
@@ -1013,7 +1018,10 @@ genUserCall(PreparedActualArguments &loweredActuals,
           loc, "unexpected PassBy::AddressAndLength for actual arguments");
       break;
     case PassBy::CharProcTuple: {
-      TODO(loc, "HLFIR PassBy::CharProcTuple");
+      hlfir::Entity actual = preparedActual->getActual(loc, builder);
+      assert(fir::isCharacterProcedureTuple(actual.getType()) &&
+             "character dummy procedure was not prepared as expected");
+      caller.placeInput(arg, actual);
     } break;
     case PassBy::MutableBox: {
       hlfir::Entity actual = preparedActual->getActual(loc, builder);

flang/lib/Lower/ConvertExprToHLFIR.cpp

@@ -16,6 +16,7 @@
 #include "flang/Lower/CallInterface.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/StatementContext.h"
@@ -1024,9 +1025,11 @@ class HlfirBuilder {
   }
 
   hlfir::EntityWithAttributes
-  gen(const Fortran::evaluate::ProcedureDesignator &expr) {
-    TODO(getLoc(), "lowering ProcDes to HLFIR");
+  gen(const Fortran::evaluate::ProcedureDesignator &proc) {
+    return Fortran::lower::convertProcedureDesignatorToHLFIR(
+        getLoc(), getConverter(), proc, getSymMap(), getStmtCtx());
   }
+
   hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) {
     TODO(getLoc(), "lowering ProcRef to HLFIR");
   }
@@ -1256,7 +1259,7 @@ hlfir::EntityWithAttributes Fortran::lower::convertExprToHLFIR(
   return HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
 }
 
-fir::BoxValue Fortran::lower::convertToBox(
+fir::ExtendedValue Fortran::lower::convertToBox(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx,
     mlir::Type fortranType) {
@@ -1266,7 +1269,8 @@ fir::BoxValue Fortran::lower::convertToBox(
     stmtCtx.attachCleanup(*cleanup);
   return exv;
 }
-fir::BoxValue Fortran::lower::convertExprToBox(
+
+fir::ExtendedValue Fortran::lower::convertExprToBox(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
     Fortran::lower::StatementContext &stmtCtx) {

flang/lib/Lower/ConvertProcedureDesignator.cpp

@@ -93,3 +93,35 @@ fir::ExtendedValue Fortran::lower::convertProcedureDesignator(
   }
   return funcPtr;
 }
+
+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) {
+  fir::ExtendedValue procExv =
+      convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
+  // Directly package the procedure address as a fir.boxproc or
+  // tuple<fir.boxbroc, len> so that it can be returned as a single mlir::Value.
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+
+  mlir::Value funcAddr = fir::getBase(procExv);
+  if (!funcAddr.getType().isa<fir::BoxProcType>()) {
+    mlir::Type boxTy =
+        Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext());
+    if (auto host = Fortran::lower::argumentHostAssocs(converter, funcAddr))
+      funcAddr = builder.create<fir::EmboxProcOp>(
+          loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});
+    else
+      funcAddr = builder.create<fir::EmboxProcOp>(loc, boxTy, funcAddr);
+  }
+
+  mlir::Value res = procExv.match(
+      [&](const fir::CharBoxValue &box) -> mlir::Value {
+        mlir::Type tupleTy =
+            fir::factory::getCharacterProcedureTupleType(funcAddr.getType());
+        return fir::factory::createCharacterProcedureTuple(
+            builder, loc, tupleTy, funcAddr, box.getLen());
+      },
+      [funcAddr](const auto &) { return funcAddr; });
+  return hlfir::EntityWithAttributes{res};
+}

flang/lib/Lower/ConvertVariable.cpp

@@ -1439,7 +1439,13 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
                              llvm::ArrayRef<mlir::Value> shape = std::nullopt,
                              llvm::ArrayRef<mlir::Value> lbounds = std::nullopt,
                              bool force = false) {
-  if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+  // In HLFIR, procedure dummy symbols are not added with an hlfir.declare
+  // because they are "values", and hlfir.declare is intended for variables. It
+  // would add too much complexity to hlfir.declare to support this case, and
+  // this would bring very little (the only point being debug info, that are not
+  // yet emitted) since alias analysis is meaningless for those.
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
+      !Fortran::semantics::IsProcedure(sym)) {
     fir::FirOpBuilder &builder = converter.getFirOpBuilder();
     const mlir::Location loc = genLocation(converter, sym);
     mlir::Value shapeOrShift;
@@ -1488,7 +1494,8 @@ void Fortran::lower::genDeclareSymbol(
     Fortran::lower::AbstractConverter &converter,
     Fortran::lower::SymMap &symMap, const Fortran::semantics::Symbol &sym,
     const fir::ExtendedValue &exv, bool force) {
-  if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
+      !Fortran::semantics::IsProcedure(sym)) {
     fir::FirOpBuilder &builder = converter.getFirOpBuilder();
     const mlir::Location loc = genLocation(converter, sym);
     fir::FortranVariableFlagsAttr attributes =

flang/lib/Optimizer/Builder/Character.cpp

@@ -710,15 +710,17 @@ mlir::Value fir::factory::CharacterExprHelper::getLength(mlir::Value memref) {
 std::pair<mlir::Value, mlir::Value>
 fir::factory::extractCharacterProcedureTuple(fir::FirOpBuilder &builder,
                                              mlir::Location loc,
-                                             mlir::Value tuple) {
+                                             mlir::Value tuple,
+                                             bool openBoxProc) {
   mlir::TupleType tupleType = tuple.getType().cast<mlir::TupleType>();
   mlir::Value addr = builder.create<fir::ExtractValueOp>(
       loc, tupleType.getType(0), tuple,
       builder.getArrayAttr(
           {builder.getIntegerAttr(builder.getIndexType(), 0)}));
   mlir::Value proc = [&]() -> mlir::Value {
-    if (auto addrTy = addr.getType().dyn_cast<fir::BoxProcType>())
-      return builder.create<fir::BoxAddrOp>(loc, addrTy.getEleTy(), addr);
+    if (openBoxProc)
+      if (auto addrTy = addr.getType().dyn_cast<fir::BoxProcType>())
+        return builder.create<fir::BoxAddrOp>(loc, addrTy.getEleTy(), addr);
     return addr;
   }();
   mlir::Value len = builder.create<fir::ExtractValueOp>(

flang/lib/Optimizer/Builder/HLFIRTools.cpp

@@ -806,6 +806,15 @@ hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
     return {translateVariableToExtendedValue(loc, builder, entity),
             std::nullopt};
 
+  if (entity.isProcedure()) {
+    if (fir::isCharacterProcedureTuple(entity.getType())) {
+      auto [boxProc, len] = fir::factory::extractCharacterProcedureTuple(
+          builder, loc, entity, /*openBoxProc=*/false);
+      return {fir::CharBoxValue{boxProc, len}, std::nullopt};
+    }
+    return {static_cast<mlir::Value>(entity), std::nullopt};
+  }
+
   if (entity.getType().isa<hlfir::ExprType>()) {
     hlfir::AssociateOp associate = hlfir::genAssociateExpr(
         loc, builder, entity, entity.getType(), "adapt.valuebyref");
@@ -856,10 +865,14 @@ static fir::ExtendedValue placeTrivialInMemory(mlir::Location loc,
   return temp;
 }
 
-std::pair<fir::BoxValue, std::optional<hlfir::CleanupFunction>>
+std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
 hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
                     const hlfir::Entity &entity, mlir::Type targetType) {
   auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
+  // Procedure entities should not go through createBoxValue that embox
+  // object entities. Return the fir.boxproc directly.
+  if (entity.isProcedure())
+    return {exv, cleanup};
   mlir::Value base = fir::getBase(exv);
   if (fir::isa_trivial(base.getType()))
     exv = placeTrivialInMemory(loc, builder, base, targetType);