[flang] Lower intrinsics to HLFIR part 1

This patch adds support for lowering intrinsics that have no dynamic
optionality aspects to handle and that requires argument to be lowered
to value, addr, or box.

It uses the current intrinsic lowering framework that can be re-used in
HLFIR to start with. HLFIR operations for charater/transformational
intrinsics will be added as needed from an optimization point of view.
The current approach will still create temporary variables for their
value directly in lowering.

Later patch will still need to add:
- support for dynamically optional arguments
- inquires
- "moving" the in memory computation of character and transformational
intrinsics to hlfir.expr. This is not needed from a semantic point of
view, but will help optimizing and will probably be required inside
hlfir.elemental returning characters so that the returned element
type is an hlfir.expr and match the result type of later hlfir.apply.

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

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 5b0a6498d1ba280118d183bc5c41b55bef8178bb..8a11bfe599cce7636d83f3938437facb357c9109 100644 (file)
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -13,6 +13,8 @@
 #include "flang/Lower/ConvertCall.h"
 #include "flang/Lower/ConvertExprToHLFIR.h"
 #include "flang/Lower/ConvertVariable.h"
+#include "flang/Lower/CustomIntrinsicCall.h"
+#include "flang/Lower/IntrinsicCall.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
@@ -440,8 +442,8 @@ public:
     fir::FirOpBuilder &builder = getBuilder();
     if (isElementalProcWithArrayArgs(procRef))
       TODO(loc, "lowering elemental call to HLFIR");
-    if (procRef.proc().GetSpecificIntrinsic())
-      TODO(loc, "lowering ProcRef to HLFIR");
+    if (auto *specific = procRef.proc().GetSpecificIntrinsic())
+      return genIntrinsicRef(procRef, resultType, *specific);
     if (isStatementFunctionCall(procRef))
       TODO(loc, "lowering Statement function call to HLFIR");
 
@@ -548,21 +550,81 @@ public:
     fir::ExtendedValue result = Fortran::lower::genCallOpAndResult(
         loc, getConverter(), getSymMap(), getStmtCtx(), caller, callSiteType,
         resultType);
-    mlir::Value resultFirBase = fir::getBase(result);
 
     /// Clean-up associations and copy-in.
     for (auto associate : exprAssociations)
       builder.create<hlfir::EndAssociateOp>(loc, associate);
-    if (!resultFirBase)
+    if (!fir::getBase(result))
       return std::nullopt; // subroutine call.
-    if (fir::isa_trivial(resultFirBase.getType()))
-      return hlfir::EntityWithAttributes{resultFirBase};
-    return hlfir::genDeclare(loc, builder, result, "tmp.funcresult",
-                             fir::FortranVariableFlagsAttr{});
+    return extendedValueToHlfirEntity(result, ".tmp.func_result");
     // TODO: "move" non pointer results into hlfir.expr.
   }
 
 private:
+  hlfir::EntityWithAttributes
+  genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef,
+                  llvm::Optional<mlir::Type> resultType,
+                  const Fortran::evaluate::SpecificIntrinsic &intrinsic) {
+    mlir::Location loc = getLoc();
+    if (Fortran::lower::intrinsicRequiresCustomOptionalHandling(
+            procRef, intrinsic, converter))
+      TODO(loc, "special cases of intrinsic with optional arguments");
+
+    llvm::SmallVector<fir::ExtendedValue> operands;
+    const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering =
+        Fortran::lower::getIntrinsicArgumentLowering(intrinsic.name);
+    for (const auto &arg : llvm::enumerate(procRef.arguments())) {
+      auto *expr =
+          Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
+      if (!expr) {
+        // Absent optional.
+        operands.emplace_back(Fortran::lower::getAbsentIntrinsicArgument());
+        continue;
+      }
+      if (!argLowering) {
+        // No argument lowering instruction, lower by value.
+        operands.emplace_back(converter.genExprValue(loc, *expr, stmtCtx));
+        continue;
+      }
+      // Ad-hoc argument lowering handling.
+      Fortran::lower::ArgLoweringRule argRules =
+          Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index());
+      if (argRules.handleDynamicOptional &&
+          Fortran::evaluate::MayBePassedAsAbsentOptional(
+              *expr, converter.getFoldingContext()))
+        TODO(loc, "intrinsic dynamically optional arguments");
+      switch (argRules.lowerAs) {
+      case Fortran::lower::LowerIntrinsicArgAs::Value:
+        operands.emplace_back(converter.genExprValue(loc, *expr, stmtCtx));
+        continue;
+      case Fortran::lower::LowerIntrinsicArgAs::Addr:
+        operands.emplace_back(converter.genExprAddr(loc, *expr, stmtCtx));
+        continue;
+      case Fortran::lower::LowerIntrinsicArgAs::Box:
+        operands.emplace_back(converter.genExprBox(loc, *expr, stmtCtx));
+        continue;
+      case Fortran::lower::LowerIntrinsicArgAs::Inquired:
+        TODO(loc, "as inquired arguments in HLFIR");
+        continue;
+      }
+      llvm_unreachable("bad switch");
+    }
+    // Let the intrinsic library lower the intrinsic procedure call
+    fir::ExtendedValue val = Fortran::lower::genIntrinsicCall(
+        getBuilder(), getLoc(), intrinsic.name, resultType, operands, stmtCtx);
+    return extendedValueToHlfirEntity(val, ".tmp.intrinsic_result");
+  }
+
+  hlfir::EntityWithAttributes
+  extendedValueToHlfirEntity(const fir::ExtendedValue &exv,
+                             llvm::StringRef name) {
+    mlir::Value firBase = fir::getBase(exv);
+    if (fir::isa_trivial(firBase.getType()))
+      return hlfir::EntityWithAttributes{firBase};
+    return hlfir::genDeclare(getLoc(), getBuilder(), exv, name,
+                             fir::FortranVariableFlagsAttr{});
+  }
+
   mlir::Location getLoc() const { return loc; }
   Fortran::lower::AbstractConverter &getConverter() { return converter; }
   fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); }

diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index f8db67093cb32c0aa01909368842999afa39052b..73d45d37c6cf8ffb2fe1003f6c028c4fc3809cc3 100644 (file)
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -144,7 +144,7 @@ hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
                   fir::FortranVariableFlagsAttr flags) {
 
   mlir::Value base = fir::getBase(exv);
-  assert(fir::isa_passbyref_type(base.getType()) &&
+  assert(fir::conformsWithPassByRef(base.getType()) &&
          "entity being declared must be in memory");
   mlir::Value shapeOrShift;
   llvm::SmallVector<mlir::Value> lenParams;

diff --git a/flang/test/Lower/HLFIR/calls-f77.f90 b/flang/test/Lower/HLFIR/calls-f77.f90
index b24c49abcce85a5916dd06b634a2bcd88c1d0e16..f4d10616aad16a83c1600bbbe1753123c066ab7a 100644 (file)
--- a/flang/test/Lower/HLFIR/calls-f77.f90
+++ b/flang/test/Lower/HLFIR/calls-f77.f90
@@ -164,7 +164,7 @@ end subroutine
 ! CHECK:  %[[VAL_11:.*]] = arith.select %[[VAL_10]], %[[VAL_8]], %[[VAL_9]] : index
 ! CHECK:  %[[VAL_13:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_11]] : index) {bindc_name = ".result"}
 ! CHECK:  %[[VAL_14:.*]] = fir.call @_QPc2foo(%[[VAL_13]], %[[VAL_11]]) fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK:  %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_13]] typeparams %[[VAL_11]] {uniq_name = "tmp.funcresult"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK:  %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_13]] typeparams %[[VAL_11]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
 
 ! -----------------------------------------------------------------------------
 !     Test calls with alternate returns