[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

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(); }

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;

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