Merge pull request #984 from flang-compiler/jpr-elemental-char

Lower calls to elemental procedure with character arguments

Author: jeanPerier

flang/include/flang/Lower/CharacterExpr.h

@@ -62,6 +62,8 @@ class CharacterExprHelper {
   /// Take care of type conversions before emboxing.
   /// \p len is converted to the integer type for character lengths if needed.
   mlir::Value createEmboxChar(mlir::Value addr, mlir::Value len);
+  /// Create a fir.boxchar for \p str. If \p str is not in memory, a temp is
+  /// allocated to create the fir.boxchar.
   mlir::Value createEmbox(const fir::CharBoxValue &str);
   /// Embox a string array. Note that the size/shape of the array is not
   /// retrievable from the resulting mlir::Value.
@@ -82,6 +84,9 @@ class CharacterExprHelper {
   /// Returns related fir.ref<fir.array<len x fir.char<kind>>>.
   fir::CharBoxValue createCharacterTemp(mlir::Type type, int len);
 
+  /// Create a temporary with the same kind, length, and value as source.
+  fir::CharBoxValue createTempFrom(const fir::ExtendedValue &source);
+
   /// Return true if \p type is a character literal type (is
   /// `fir.array<len x fir.char<kind>>`).;
   static bool isCharacterLiteral(mlir::Type type);

flang/lib/Lower/CharacterExpr.cpp

@@ -180,13 +180,21 @@ static mlir::Type getSingletonCharType(mlir::MLIRContext *ctxt, int kind) {
 
 mlir::Value
 Fortran::lower::CharacterExprHelper::createEmbox(const fir::CharBoxValue &box) {
-  // BoxChar require a reference. Base CharBoxValue of CharArrayBoxValue
-  // are ok here (do not require a scalar type)
+  // Base CharBoxValue of CharArrayBoxValue are ok here (do not require a scalar
+  // type)
   auto charTy = recoverCharacterType(box.getBuffer().getType());
   auto boxCharType =
       fir::BoxCharType::get(builder.getContext(), charTy.getFKind());
   auto refType = fir::ReferenceType::get(boxCharType.getEleTy());
-  auto buff = builder.createConvert(loc, refType, box.getBuffer());
+  mlir::Value buff = box.getBuffer();
+  // fir.boxchar requires a memory reference. Allocate temp if the character is
+  // not in memory.
+  if (!fir::isa_ref_type(buff.getType())) {
+    auto temp = builder.createTemporary(loc, buff.getType());
+    builder.create<fir::StoreOp>(loc, buff, temp);
+    buff = temp;
+  }
+  buff = builder.createConvert(loc, refType, buff);
   // Convert in case the provided length is not of the integer type that must
   // be used in boxchar.
   auto len = builder.createConvert(loc, builder.getCharacterLengthType(),
@@ -398,6 +406,24 @@ Fortran::lower::CharacterExprHelper::createCharacterTemp(mlir::Type type,
   return {ref, len};
 }
 
+fir::CharBoxValue Fortran::lower::CharacterExprHelper::createTempFrom(
+    const fir::ExtendedValue &source) {
+  const auto *charBox = source.getCharBox();
+  if (!charBox)
+    fir::emitFatalError(loc, "source must be a fir::CharBoxValue");
+  auto len = charBox->getLen();
+  auto sourceTy = charBox->getBuffer().getType();
+  auto temp = createCharacterTemp(sourceTy, len);
+  if (fir::isa_ref_type(sourceTy)) {
+    createCopy(temp, *charBox, len);
+  } else {
+    auto ref = builder.createConvert(loc, builder.getRefType(sourceTy),
+                                     temp.getBuffer());
+    builder.create<fir::StoreOp>(loc, charBox->getBuffer(), ref);
+  }
+  return temp;
+}
+
 // Simple length one character assignment without loops.
 void Fortran::lower::CharacterExprHelper::createLengthOneAssign(
     const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {

flang/lib/Lower/ConvertExpr.cpp

@@ -3556,19 +3556,13 @@ class ArrayExprLowering {
       case PassBy::Value: {
         // True pass-by-value semantics.
         PushSemantics(ConstituentSemantics::RefTransparent);
-        auto lambda = genarr(*expr);
-        operands[arg.firArgument] = [=](IterSpace iters) {
-          return lambda(iters);
-        };
+        operands[arg.firArgument] = genarr(*expr);
       } break;
       case PassBy::BaseAddressValueAttribute: {
         // VALUE attribute or pass-by-reference to a copy semantics. (byval*)
         if (isArray(*expr)) {
           PushSemantics(ConstituentSemantics::ByValueArg);
-          auto lambda = genarr(*expr);
-          operands[arg.firArgument] = [=](IterSpace iters) {
-            return lambda(iters);
-          };
+          operands[arg.firArgument] = genarr(*expr);
         } else {
           // Store scalar value in a temp to fulfill VALUE attribute.
           auto val = fir::getBase(asScalar(*expr));
@@ -3582,25 +3576,39 @@ class ArrayExprLowering {
         }
       } break;
       case PassBy::BaseAddress: {
+        if (isArray(*expr)) {
+          PushSemantics(ConstituentSemantics::RefOpaque);
+          operands[arg.firArgument] = genarr(*expr);
+        } else {
+          auto exv = asScalarRef(*expr);
+          operands[arg.firArgument] = [=](IterSpace iters) { return exv; };
+        }
+      } break;
+      case PassBy::CharBoxValueAttribute: {
         if (isArray(*expr)) {
           PushSemantics(ConstituentSemantics::RefOpaque);
           auto lambda = genarr(*expr);
           operands[arg.firArgument] = [=](IterSpace iters) {
-            return lambda(iters);
+            return Fortran::lower::CharacterExprHelper{builder, loc}
+                .createTempFrom(lambda(iters));
           };
         } else {
-          auto exv = asScalarRef(*expr);
-          operands[arg.firArgument] = [=](IterSpace iters) { return exv; };
+          Fortran::lower::CharacterExprHelper helper(builder, loc);
+          auto argVal = helper.createTempFrom(asScalarRef(*expr));
+          operands[arg.firArgument] = [=](IterSpace iters) -> ExtValue {
+            return argVal;
+          };
         }
       } break;
-      case PassBy::CharBoxValueAttribute:
-        TODO(loc, "CHARACTER, VALUE");
-        break;
-      case PassBy::BoxChar:
-        TODO(loc, "CHARACTER");
-        break;
+      case PassBy::BoxChar: {
+        PushSemantics(ConstituentSemantics::RefOpaque);
+        operands[arg.firArgument] = genarr(*expr);
+      } break;
       case PassBy::AddressAndLength:
-        TODO(loc, "address and length argument");
+        // PassBy::AddressAndLength is only used for character results. Results
+        // are not handled here.
+        fir::emitFatalError(
+            loc, "unexpected PassBy::AddressAndLength in elemental call");
         break;
       case PassBy::Box:
       case PassBy::MutableBox:
@@ -3611,15 +3619,28 @@ class ArrayExprLowering {
 
     if (caller.getIfIndirectCallSymbol())
       fir::emitFatalError(loc, "cannot be indirect call");
+
+    // TODO: share logic with the scalar function calls when the result must be
+    // allocated on the caller side.
+    if (caller.callerAllocateResult())
+      TODO(loc, "elemental call requiring result allocation");
     auto funcSym = builder.getSymbolRefAttr(caller.getMangledName());
     auto resTys = caller.getFuncOp().getType().getResults();
     if (caller.getFuncOp().getType().getResults() !=
         caller.genFunctionType().getResults())
       fir::emitFatalError(loc, "type mismatch on declared function");
     return [=](IterSpace iters) -> ExtValue {
       llvm::SmallVector<mlir::Value> args;
-      for (const auto &cc : operands)
-        args.push_back(fir::getBase(cc(iters)));
+      for (const auto &cc : operands) {
+        auto exv = cc(iters);
+        auto arg = exv.match(
+            [&](const fir::CharBoxValue &cb) -> mlir::Value {
+              return Fortran::lower::CharacterExprHelper{builder, loc}
+                  .createEmbox(cb);
+            },
+            [&](const auto &) { return fir::getBase(exv); });
+        args.push_back(arg);
+      }
       auto call = builder.create<fir::CallOp>(loc, resTys, funcSym, args);
       return call.getResult(0);
     };