[flang] Lower statement function references in HLFIR

Enable lowering of statement function references in HLFIR.  This follows
the same principle as statement function lowering with the current
lowering:
- Actual arguments are lowered and mapped to the statement function
  dummy symbols.
- "HostAssociated" symbols are mapped to their host values (these are
  the symbols referred to inside the statement function expressions that
  are not statement function dummies. e.g: `x` in `stmt_func(i) =
  x(i)`).
- The statement function expression is evaluated.

evaluate::SetLength has to be lowered to deal with statement functions
returning characters since the front-end is generating one to ensure the
statement function expression value is trimmed/padded to match the statement
function declared type.

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

Author: jeanPerier

flang/include/flang/Lower/ConvertVariable.h

@@ -70,6 +70,9 @@ void defineCommonBlocks(
 /// instantiateVariable cannot be called.
 void mapSymbolAttributes(AbstractConverter &, const pft::Variable &, SymMap &,
                          StatementContext &, mlir::Value preAlloc = {});
+void mapSymbolAttributes(AbstractConverter &, const semantics::SymbolRef &,
+                         SymMap &, StatementContext &,
+                         mlir::Value preAlloc = {});
 
 /// Instantiate the variables that appear in the specification expressions
 /// of the result of a function call. The instantiated variables are added

flang/lib/Lower/Bridge.cpp

@@ -449,7 +449,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
 
   void copySymbolBinding(Fortran::lower::SymbolRef src,
                          Fortran::lower::SymbolRef target) override final {
-    localSymbols.addSymbol(target, lookupSymbol(src).toExtendedValue());
+    if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
+      localSymbols.addVariableDefinition(
+          target, localSymbols.lookupVariableDefinition(src).value());
+    else
+      localSymbols.addSymbol(target, lookupSymbol(src).toExtendedValue());
   }
 
   /// Add the symbol binding to the inner-most level of the symbol map and

flang/lib/Lower/ConvertCall.cpp

@@ -406,6 +406,82 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   return callResult;
 }
 
+static hlfir::EntityWithAttributes genStmtFunctionRef(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
+    const Fortran::evaluate::ProcedureRef &procRef) {
+  const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
+  assert(symbol && "expected symbol in ProcedureRef of statement functions");
+  const auto &details = symbol->get<Fortran::semantics::SubprogramDetails>();
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+
+  // Statement functions have their own scope, we just need to associate
+  // the dummy symbols to argument expressions. There are no
+  // optional/alternate return arguments. Statement functions cannot be
+  // recursive (directly or indirectly) so it is safe to add dummy symbols to
+  // the local map here.
+  symMap.pushScope();
+  llvm::SmallVector<hlfir::AssociateOp> exprAssociations;
+  for (auto [arg, bind] : llvm::zip(details.dummyArgs(), procRef.arguments())) {
+    assert(arg && "alternate return in statement function");
+    assert(bind && "optional argument in statement function");
+    const auto *expr = bind->UnwrapExpr();
+    // TODO: assumed type in statement function, that surprisingly seems
+    // allowed, probably because nobody thought of restricting this usage.
+    // gfortran/ifort compiles this.
+    assert(expr && "assumed type used as statement function argument");
+    // As per Fortran 2018 C1580, statement function arguments can only be
+    // scalars.
+    // The only care is to use the dummy character explicit length if any
+    // instead of the actual argument length (that can be bigger).
+    hlfir::EntityWithAttributes loweredArg = Fortran::lower::convertExprToHLFIR(
+        loc, converter, *expr, symMap, stmtCtx);
+    fir::FortranVariableOpInterface variableIface = loweredArg.getIfVariable();
+    if (!variableIface) {
+      // So far only FortranVariableOpInterface can be mapped to symbols.
+      // Create an hlfir.associate to create a variable from a potential
+      // value argument.
+      mlir::Type argType = converter.genType(*arg);
+      auto associate = hlfir::genAssociateExpr(
+          loc, builder, loweredArg, argType, toStringRef(arg->name()));
+      exprAssociations.push_back(associate);
+      variableIface = associate;
+    }
+    const Fortran::semantics::DeclTypeSpec *type = arg->GetType();
+    if (type &&
+        type->category() == Fortran::semantics::DeclTypeSpec::Character) {
+      // Instantiate character as if it was a normal dummy argument so that the
+      // statement function dummy character length is applied and dealt with
+      // correctly.
+      symMap.addSymbol(*arg, variableIface.getBase());
+      Fortran::lower::mapSymbolAttributes(converter, *arg, symMap, stmtCtx);
+    } else {
+      // No need to create an extra hlfir.declare otherwise for
+      // numerical and logical scalar dummies.
+      symMap.addVariableDefinition(*arg, variableIface);
+    }
+  }
+
+  // Explicitly map statement function host associated symbols to their
+  // parent scope lowered symbol box.
+  for (const Fortran::semantics::SymbolRef &sym :
+       Fortran::evaluate::CollectSymbols(*details.stmtFunction()))
+    if (const auto *details =
+            sym->detailsIf<Fortran::semantics::HostAssocDetails>())
+      converter.copySymbolBinding(details->symbol(), sym);
+
+  hlfir::Entity result = Fortran::lower::convertExprToHLFIR(
+      loc, converter, details.stmtFunction().value(), symMap, stmtCtx);
+  symMap.popScope();
+  // The result must not be a variable.
+  result = hlfir::loadTrivialScalar(loc, builder, result);
+  if (result.isVariable())
+    result = hlfir::Entity{builder.create<hlfir::AsExprOp>(loc, result)};
+  for (auto associate : exprAssociations)
+    builder.create<hlfir::EndAssociateOp>(loc, associate);
+  return hlfir::EntityWithAttributes{result};
+}
+
 /// Is this a call to an elemental procedure with at least one array argument?
 static bool
 isElementalProcWithArrayArgs(const Fortran::evaluate::ProcedureRef &procRef) {
@@ -454,7 +530,7 @@ class CallBuilder {
       return genIntrinsicRef(procRef, resultType, *specific);
     }
     if (isStatementFunctionCall(procRef))
-      TODO(loc, "lowering Statement function call to HLFIR");
+      return genStmtFunctionRef(loc, converter, symMap, stmtCtx, procRef);
 
     Fortran::lower::CallerInterface caller(procRef, converter);
     mlir::FunctionType callSiteType = caller.genFunctionType();

flang/lib/Lower/ConvertExprToHLFIR.cpp

@@ -511,13 +511,15 @@ template <int KIND>
 struct BinaryOp<Fortran::evaluate::SetLength<KIND>> {
   using Op = Fortran::evaluate::SetLength<KIND>;
   static hlfir::EntityWithAttributes gen(mlir::Location loc,
-                                         fir::FirOpBuilder &, const Op &,
-                                         hlfir::Entity, hlfir::Entity) {
-    TODO(loc, "SetLength lowering to HLFIR");
+                                         fir::FirOpBuilder &builder, const Op &,
+                                         hlfir::Entity string,
+                                         hlfir::Entity length) {
+    return hlfir::EntityWithAttributes{
+        builder.create<hlfir::SetLengthOp>(loc, string, length)};
   }
   static void
-  genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
-                      hlfir::Entity lhs, hlfir::Entity rhs,
+  genResultTypeParams(mlir::Location, fir::FirOpBuilder &, hlfir::Entity,
+                      hlfir::Entity rhs,
                       llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
     resultTypeParams.push_back(rhs);
   }

flang/lib/Lower/ConvertVariable.cpp

@@ -1890,6 +1890,14 @@ void Fortran::lower::mapCallInterfaceSymbols(
   }
 }
 
+void Fortran::lower::mapSymbolAttributes(
+    AbstractConverter &converter, const Fortran::semantics::SymbolRef &symbol,
+    Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
+    mlir::Value preAlloc) {
+  mapSymbolAttributes(converter, pft::Variable{symbol}, symMap, stmtCtx,
+                      preAlloc);
+}
+
 void Fortran::lower::createRuntimeTypeInfoGlobal(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     const Fortran::semantics::Symbol &typeInfoSym) {

flang/lib/Lower/SymbolMap.cpp

@@ -92,7 +92,8 @@ Fortran::lower::SymMap::lookupImpliedDo(Fortran::lower::SymMap::AcDoVar var) {
 }
 
 llvm::Optional<fir::FortranVariableOpInterface>
-Fortran::lower::SymMap::lookupVariableDefinition(semantics::SymbolRef sym) {
+Fortran::lower::SymMap::lookupVariableDefinition(semantics::SymbolRef symRef) {
+  Fortran::semantics::SymbolRef sym = symRef.get().GetUltimate();
   for (auto jmap = symbolMapStack.rbegin(), jend = symbolMapStack.rend();
        jmap != jend; ++jmap) {
     auto iter = jmap->find(&*sym);

flang/test/Lower/HLFIR/statement-functions.f90

@@ -0,0 +1,35 @@
+! Test lowering of statement functions to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+
+subroutine numeric_test(x)
+  integer :: x(:), i, stmt_func
+  stmt_func(i) = x(i)
+  call bar(stmt_func(42))
+end subroutine
+! CHECK-LABEL: func.func @_QPnumeric_test(
+! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0:[^)]*]] {{.*}}x"
+! CHECK:  %[[VAL_6:.*]] = arith.constant 42 : i32
+! CHECK:  %[[VAL_7:.*]]:3 = hlfir.associate %[[VAL_6]] {uniq_name = "i"} : (i32) -> (!fir.ref<i32>, !fir.ref<i32>, i1)
+! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<i32>
+! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> i64
+! CHECK:  %[[VAL_10:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_9]])  : (!fir.box<!fir.array<?xi32>>, i64) -> !fir.ref<i32>
+! CHECK:  %[[VAL_11:.*]] = fir.load %[[VAL_10]] : !fir.ref<i32>
+
+subroutine char_test(c, n)
+  character(*) :: c
+  character(n) :: char_stmt_func_dummy_arg
+  character(10) :: stmt_func
+  stmt_func(char_stmt_func_dummy_arg) = char_stmt_func_dummy_arg
+  call bar2(stmt_func(c))
+end subroutine
+! CHECK-LABEL: func.func @_QPchar_test(
+! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3:.*]]#0 typeparams %[[VAL_3]]#1 {{.*}}c"
+! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_2:[^ ]*]] {{.*}}n"
+! CHECK:  %[[VAL_13:.*]]:2 = fir.unboxchar %[[VAL_4]]#0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:  %[[VAL_14:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref<i32>
+! CHECK:  %[[VAL_15:.*]] = arith.constant 0 : i32
+! CHECK:  %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_14]], %[[VAL_15]] : i32
+! CHECK:  %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_14]], %[[VAL_15]] : i32
+! CHECK:  %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_13]]#0 typeparams %[[VAL_17]] {uniq_name = "_QFstmt_funcEchar_stmt_func_dummy_arg"} : (!fir.ref<!fir.char<1,?>>, i32) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK:  %[[VAL_19:.*]] = arith.constant 10 : i64
+! CHECK:  %[[VAL_20:.*]] = hlfir.set_length %[[VAL_18]]#0 len %[[VAL_19]] : (!fir.boxchar<1>, i64) -> !hlfir.expr<!fir.char<1,10>>