[flang-commits] [flang] 6ed4a8b - [flang][hlfir] Lower intrinsic module procedures to HLFIR

Jean Perier via flang-commits flang-commits at lists.llvm.org
Mon Mar 6 05:01:07 PST 2023


Author: Jean Perier
Date: 2023-03-06T14:00:39+01:00
New Revision: 6ed4a8b9b1f3041c661b6e7be43db73cda27a2bd

URL: https://github.com/llvm/llvm-project/commit/6ed4a8b9b1f3041c661b6e7be43db73cda27a2bd
DIFF: https://github.com/llvm/llvm-project/commit/6ed4a8b9b1f3041c661b6e7be43db73cda27a2bd.diff

LOG: [flang][hlfir] Lower intrinsic module procedures to HLFIR

Intrinsic module procedures are a bit different from intrinsic
procedures: they are defined in intrinsic module files, but their
signature and representation in semantics is the same as user
procedures.
The code to lower them in lowering (when they are not implemented in
Fortran) is the same as for intrinsic procedures
(Optimizer/Builder/IntrinsicCall.cpp).

The dispatching in in HLFIR procedure reference lowering must be
slightly modified so that these evaluate::ProcRef that have a
semantics::Symbol instead of an evaluate::SpecificIntrinsic can
be dispatched as evaluate::SpecificIntrinsic:
 - move isIntrinsicModuleProcedure to detect them
 - in the helpers dealing with intrinsics, make evaluate::SpecificIntrinsic
   a pointer argument that can be null for intrinsic module procedures.
 - add getProcedureName() to call context to avoid relying on the
   evaluate::SpecificIntrinsic when it is not know to be null.

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

Added: 
    flang/test/Lower/HLFIR/intrinsic-module-procedures.f90

Modified: 
    flang/include/flang/Lower/ConvertCall.h
    flang/lib/Lower/ConvertCall.cpp
    flang/lib/Lower/ConvertExpr.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Lower/ConvertCall.h b/flang/include/flang/Lower/ConvertCall.h
index 9336468ec2217..76a03ea319f5b 100644
--- a/flang/include/flang/Lower/ConvertCall.h
+++ b/flang/include/flang/Lower/ConvertCall.h
@@ -40,6 +40,10 @@ fir::ExtendedValue genCallOpAndResult(
 mlir::Value argumentHostAssocs(Fortran::lower::AbstractConverter &converter,
                                mlir::Value arg);
 
+/// Is \p procRef an intrinsic module procedure that should be lowered as
+/// intrinsic procedures (with Optimizer/Builder/IntrinsicCall.h)?
+bool isIntrinsicModuleProcRef(const Fortran::evaluate::ProcedureRef &procRef);
+
 /// Lower a ProcedureRef to HLFIR. If this is a function call, return the
 /// lowered result value. Return nothing otherwise.
 std::optional<hlfir::EntityWithAttributes> convertCallToHLFIR(

diff  --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 0fe48585126d9..e171059813bd8 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -35,7 +35,8 @@
 
 static llvm::cl::opt<bool> useHlfirIntrinsicOps(
     "use-hlfir-intrinsic-ops", llvm::cl::init(true),
-    llvm::cl::desc("Lower via HLFIR transformational intrinsic operations such as hlfir.sum"));
+    llvm::cl::desc("Lower via HLFIR transformational intrinsic operations such "
+                   "as hlfir.sum"));
 
 /// Helper to package a Value and its properties into an ExtendedValue.
 static fir::ExtendedValue toExtendedValue(mlir::Location loc, mlir::Value base,
@@ -561,6 +562,8 @@ struct CallContext {
 
   fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); }
 
+  std::string getProcedureName() const { return procRef.proc().GetName(); }
+
   /// Is this a call to an elemental procedure with at least one array argument?
   bool isElementalProcWithArrayArgs() const {
     if (procRef.IsElemental())
@@ -1146,7 +1149,7 @@ genUserCall(PreparedActualArguments &loweredActuals,
 /// pre-lowered but have not yet been prepared according to the interface.
 static std::optional<hlfir::EntityWithAttributes>
 genIntrinsicRefCore(PreparedActualArguments &loweredActuals,
-                    const Fortran::evaluate::SpecificIntrinsic &intrinsic,
+                    const Fortran::evaluate::SpecificIntrinsic *intrinsic,
                     const fir::IntrinsicArgumentLoweringRules *argLowering,
                     CallContext &callContext) {
   llvm::SmallVector<fir::ExtendedValue> operands;
@@ -1213,10 +1216,10 @@ genIntrinsicRefCore(PreparedActualArguments &loweredActuals,
   std::optional<mlir::Type> scalarResultType;
   if (callContext.resultType)
     scalarResultType = hlfir::getFortranElementType(*callContext.resultType);
+  const std::string intrinsicName = callContext.getProcedureName();
   // Let the intrinsic library lower the intrinsic procedure call.
-  auto [resultExv, mustBeFreed] =
-      genIntrinsicCall(callContext.getBuilder(), loc, intrinsic.name,
-                       scalarResultType, operands);
+  auto [resultExv, mustBeFreed] = genIntrinsicCall(
+      callContext.getBuilder(), loc, intrinsicName, scalarResultType, operands);
   if (!fir::getBase(resultExv))
     return std::nullopt;
   hlfir::EntityWithAttributes resultEntity = extendedValueToHlfirEntity(
@@ -1229,7 +1232,7 @@ genIntrinsicRefCore(PreparedActualArguments &loweredActuals,
     // (this is the only intrinsic implemented in that way so far). The
     // ownership of this address cannot be taken here since it may not be a
     // temp.
-    if (intrinsic.name == "merge")
+    if (intrinsicName == "merge")
       asExpr = builder.create<hlfir::AsExprOp>(loc, resultEntity);
     else
       asExpr = builder.create<hlfir::AsExprOp>(
@@ -1243,11 +1246,12 @@ genIntrinsicRefCore(PreparedActualArguments &loweredActuals,
 /// pre-lowered but have not yet been prepared according to the interface.
 static std::optional<hlfir::EntityWithAttributes>
 genHLFIRIntrinsicRefCore(PreparedActualArguments &loweredActuals,
-                         const Fortran::evaluate::SpecificIntrinsic &intrinsic,
+                         const Fortran::evaluate::SpecificIntrinsic *intrinsic,
                          const fir::IntrinsicArgumentLoweringRules *argLowering,
                          CallContext &callContext) {
   if (!useHlfirIntrinsicOps)
-    return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering, callContext);
+    return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering,
+                               callContext);
 
   fir::FirOpBuilder &builder = callContext.getBuilder();
   mlir::Location loc = callContext.loc;
@@ -1293,8 +1297,8 @@ genHLFIRIntrinsicRefCore(PreparedActualArguments &loweredActuals,
     return hlfir::ExprType::get(builder.getContext(), resultShape, elementType,
                                 /*polymorphic=*/false);
   };
-
-  if (intrinsic.name == "sum") {
+  const std::string intrinsicName = callContext.getProcedureName();
+  if (intrinsicName == "sum") {
     llvm::SmallVector<mlir::Value> operands = getOperandVector(loweredActuals);
     assert(operands.size() == 3);
     mlir::Value array = operands[0];
@@ -1308,7 +1312,7 @@ genHLFIRIntrinsicRefCore(PreparedActualArguments &loweredActuals,
         builder.create<hlfir::SumOp>(loc, resultTy, array, dim, mask);
     return {hlfir::EntityWithAttributes{sumOp.getResult()}};
   }
-  if (intrinsic.name == "matmul") {
+  if (intrinsicName == "matmul") {
     llvm::SmallVector<mlir::Value> operands = getOperandVector(loweredActuals);
     mlir::Type resultTy =
         computeResultType(operands[0], *callContext.resultType);
@@ -1317,7 +1321,7 @@ genHLFIRIntrinsicRefCore(PreparedActualArguments &loweredActuals,
 
     return {hlfir::EntityWithAttributes{matmulOp.getResult()}};
   }
-  if (intrinsic.name == "transpose") {
+  if (intrinsicName == "transpose") {
     llvm::SmallVector<mlir::Value> operands = getOperandVector(loweredActuals);
     hlfir::ExprType::Shape resultShape;
     mlir::Type normalisedResult =
@@ -1509,7 +1513,7 @@ class ElementalIntrinsicCallBuilder
     : public ElementalCallBuilder<ElementalIntrinsicCallBuilder> {
 public:
   ElementalIntrinsicCallBuilder(
-      const Fortran::evaluate::SpecificIntrinsic &intrinsic,
+      const Fortran::evaluate::SpecificIntrinsic *intrinsic,
       const fir::IntrinsicArgumentLoweringRules *argLowering, bool isFunction)
       : intrinsic{intrinsic}, argLowering{argLowering}, isFunction{isFunction} {
   }
@@ -1530,11 +1534,12 @@ class ElementalIntrinsicCallBuilder
   mlir::Value
   computeDynamicCharacterResultLength(PreparedActualArguments &loweredActuals,
                                       CallContext &callContext) {
-    if (intrinsic.name == "adjustr" || intrinsic.name == "adjustl" ||
-        intrinsic.name == "merge")
-      return hlfir::genCharLength(
-          callContext.loc, callContext.getBuilder(),
-          loweredActuals[0].value().getOriginalActual());
+    if (intrinsic)
+      if (intrinsic->name == "adjustr" || intrinsic->name == "adjustl" ||
+          intrinsic->name == "merge")
+        return hlfir::genCharLength(
+            callContext.loc, callContext.getBuilder(),
+            loweredActuals[0].value().getOriginalActual());
     // Character MIN/MAX is the min/max of the arguments length that are
     // present.
     TODO(callContext.loc,
@@ -1542,7 +1547,7 @@ class ElementalIntrinsicCallBuilder
   }
 
 private:
-  const Fortran::evaluate::SpecificIntrinsic &intrinsic;
+  const Fortran::evaluate::SpecificIntrinsic *intrinsic;
   const fir::IntrinsicArgumentLoweringRules *argLowering;
   const bool isFunction;
 };
@@ -1581,18 +1586,22 @@ genIsPresentIfArgMaybeAbsent(mlir::Location loc, hlfir::Entity actual,
 }
 
 /// Lower an intrinsic procedure reference.
+/// \p intrinsic is null if this is an intrinsic module procedure that must be
+/// lowered as if it were an intrinsic module procedure (like C_LOC which is a
+/// procedure from intrinsic module iso_c_binding). Otherwise, \p intrinsic
+/// must not be null.
 static std::optional<hlfir::EntityWithAttributes>
-genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic &intrinsic,
+genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
                 CallContext &callContext) {
   mlir::Location loc = callContext.loc;
   auto &converter = callContext.converter;
-  if (Fortran::lower::intrinsicRequiresCustomOptionalHandling(
-          callContext.procRef, intrinsic, converter))
+  if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling(
+                       callContext.procRef, *intrinsic, converter))
     TODO(loc, "special cases of intrinsic with optional arguments");
 
   PreparedActualArguments loweredActuals;
   const fir::IntrinsicArgumentLoweringRules *argLowering =
-      fir::getIntrinsicArgumentLowering(intrinsic.name);
+      fir::getIntrinsicArgumentLowering(callContext.getProcedureName());
   for (const auto &arg : llvm::enumerate(callContext.procRef.arguments())) {
     auto *expr =
         Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
@@ -1638,7 +1647,9 @@ static std::optional<hlfir::EntityWithAttributes>
 genProcedureRef(CallContext &callContext) {
   mlir::Location loc = callContext.loc;
   if (auto *intrinsic = callContext.procRef.proc().GetSpecificIntrinsic())
-    return genIntrinsicRef(*intrinsic, callContext);
+    return genIntrinsicRef(intrinsic, callContext);
+  if (Fortran::lower::isIntrinsicModuleProcRef(callContext.procRef))
+    return genIntrinsicRef(nullptr, callContext);
 
   if (callContext.isStatementFunctionCall())
     return genStmtFunctionRef(loc, callContext.converter, callContext.symMap,
@@ -1699,6 +1710,17 @@ genProcedureRef(CallContext &callContext) {
   return genUserCall(loweredActuals, caller, callSiteType, callContext);
 }
 
+bool Fortran::lower::isIntrinsicModuleProcRef(
+    const Fortran::evaluate::ProcedureRef &procRef) {
+  const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
+  if (!symbol)
+    return false;
+  const Fortran::semantics::Symbol *module =
+      symbol->GetUltimate().owner().GetSymbol();
+  return module && module->attrs().test(Fortran::semantics::Attr::INTRINSIC) &&
+         module->name().ToString().find("omp_lib") == std::string::npos;
+}
+
 std::optional<hlfir::EntityWithAttributes> Fortran::lower::convertCallToHLFIR(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const evaluate::ProcedureRef &procRef, std::optional<mlir::Type> resultType,

diff  --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 1407b5ea81f73..045a91d034424 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -589,17 +589,6 @@ const Fortran::semantics::Symbol &getLastSym(const A &obj) {
   return obj.GetLastSymbol().GetUltimate();
 }
 
-static bool
-isIntrinsicModuleProcRef(const Fortran::evaluate::ProcedureRef &procRef) {
-  const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
-  if (!symbol)
-    return false;
-  const Fortran::semantics::Symbol *module =
-      symbol->GetUltimate().owner().GetSymbol();
-  return module && module->attrs().test(Fortran::semantics::Attr::INTRINSIC) &&
-         module->name().ToString().find("omp_lib") == std::string::npos;
-}
-
 // Return true if TRANSPOSE should be lowered without a runtime call.
 static bool
 isTransposeOptEnabled(const Fortran::lower::AbstractConverter &converter) {
@@ -2442,7 +2431,7 @@ class ScalarExprLowering {
             procRef.proc().GetSpecificIntrinsic())
       return genIntrinsicRef(procRef, resultType, *intrinsic);
 
-    if (isIntrinsicModuleProcRef(procRef))
+    if (Fortran::lower::isIntrinsicModuleProcRef(procRef))
       return genIntrinsicRef(procRef, resultType);
 
     if (isStatementFunctionCall(procRef))
@@ -4795,7 +4784,7 @@ class ArrayExprLowering {
         // The intrinsic procedure is called once per element of the array.
         return genElementalIntrinsicProcRef(procRef, retTy, *intrin);
       }
-      if (isIntrinsicModuleProcRef(procRef))
+      if (Fortran::lower::isIntrinsicModuleProcRef(procRef))
         return genElementalIntrinsicProcRef(procRef, retTy);
       if (ScalarExprLowering::isStatementFunctionCall(procRef))
         fir::emitFatalError(loc, "statement function cannot be elemental");

diff  --git a/flang/test/Lower/HLFIR/intrinsic-module-procedures.f90 b/flang/test/Lower/HLFIR/intrinsic-module-procedures.f90
new file mode 100644
index 0000000000000..40bb39e967265
--- /dev/null
+++ b/flang/test/Lower/HLFIR/intrinsic-module-procedures.f90
@@ -0,0 +1,23 @@
+! Test lowering of intrinsic module procedures to HLFIR. This
+! test is not meant to test every intrinsic module procedure,
+! it only tests that the HFLIR procedure reference lowering
+! infrastructure properly detects and dispatches intrinsic module
+! procedure calls.
+! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
+
+subroutine foo(cptr, x)
+  use iso_c_binding, only : c_ptr, c_loc
+  type(c_ptr) :: cptr
+  integer :: x
+  cptr = c_loc(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPfoo(
+! CHECK:         %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ecptr"
+! CHECK:         %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:         %[[VAL_4:.*]] = fir.embox %[[VAL_3]]#1 : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK:         %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_6]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         %[[VAL_8:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<i32>) -> !fir.ref<i32>
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<i32>) -> i64
+! CHECK:         fir.store %[[VAL_9]] to %[[VAL_7]] : !fir.ref<i64>


        


More information about the flang-commits mailing list