[flang] Lower concatenation to hlfir.concat

[jeanPerier]

Summary

Depends on D138650

[clementval]

LGTM

flang/include/flang/Optimizer/HLFIR/HLFIROps.td

def hlfir_ConcatOp : hlfir_Op<"concat", []> {
 
   let results = (outs AnyScalarCharacterExpr);
 
   let assemblyFormat = [{
     $strings `len` $length
      attr-dict `:` functional-type(operands, results)
   }];
 
+  let builders = [OpBuilder<(ins "mlir::ValueRange":$strings,"mlir::Value":$len)>];
+
   let hasVerifier = 1;
 }
 
 #endif // FORTRAN_DIALECT_HLFIR_OPS

flang/lib/Lower/ConvertExprToHLFIR.cpp

private:
   }
 
   template <typename D, typename R, typename LO, typename RO>
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::Operation<D, R, LO, RO> &op) {
     TODO(getLoc(), "lowering binary op to HLFIR");
   }
 
+  template <int KIND>
+  hlfir::EntityWithAttributes gen(const Fortran::evaluate::Concat<KIND> &op) {
+    auto lhs = gen(op.left());
+    auto rhs = gen(op.right());
+    llvm::SmallVector<mlir::Value> lengths;
+    auto &builder = getBuilder();
+    mlir::Location loc = getLoc();
+    hlfir::genLengthParameters(loc, builder, lhs, lengths);
+    hlfir::genLengthParameters(loc, builder, rhs, lengths);
+    assert(lengths.size() == 2 && "lacks rhs or lhs length");
+    mlir::Type idxType = builder.getIndexType();
+    mlir::Value lhsLen = builder.createConvert(loc, idxType, lengths[0]);
+    mlir::Value rhsLen = builder.createConvert(loc, idxType, lengths[1]);
+    mlir::Value len = builder.create<mlir::arith::AddIOp>(loc, lhsLen, rhsLen);
+    auto concat =
+        builder.create<hlfir::ConcatOp>(loc, mlir::ValueRange{lhs, rhs}, len);
+    return hlfir::EntityWithAttributes{concat.getResult()};
+  }
+
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &op) {
     return std::visit([&](const auto &x) { return gen(x); }, op.u);
   }
 
   hlfir::EntityWithAttributes gen(const Fortran::evaluate::TypeParamInquiry &) {
     TODO(getLoc(), "lowering type parameter inquiry to HLFIR");
   }

flang/lib/Optimizer/Builder/HLFIRTools.cpp

hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,
   return result;
 }
 
 void hlfir::genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
                                 Entity entity,
                                 llvm::SmallVectorImpl<mlir::Value> &result) {
   if (!entity.hasLengthParameters())
     return;
-  if (entity.getType().isa<hlfir::ExprType>())
+  if (entity.getType().isa<hlfir::ExprType>()) {
     // Going through fir::ExtendedValue would create a temp,
     // which is not desired for an inquiry.
+    // TODO: make this an interface when adding further character producing ops.
+    if (auto concat = entity.getDefiningOp<hlfir::ConcatOp>()) {
+      result.push_back(concat.getLength());
+      return;
+    }
     TODO(loc, "inquire type parameters of hlfir.expr");
+  }
 
   if (entity.isCharacter()) {
     auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
     assert(!cleanup && "translation of entity should not yield cleanup");
     result.push_back(fir::factory::readCharLen(builder, loc, exv));
     return;
   }
   TODO(loc, "inquire PDTs length parameters in HLFIR");

flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp

mlir::LogicalResult hlfir::DesignateOp::verify() {
   }
   return mlir::success();
 }
 
 //===----------------------------------------------------------------------===//
 // ConcatOp
 //===----------------------------------------------------------------------===//
 
+static unsigned getCharacterKind(mlir::Type t) {
+  return hlfir::getFortranElementType(t).cast<fir::CharacterType>().getFKind();
+}
+
+static llvm::Optional<fir::CharacterType::LenType>
+getCharacterLengthIfStatic(mlir::Type t) {
+  if (auto charType =
+          hlfir::getFortranElementType(t).dyn_cast<fir::CharacterType>())
+    if (charType.hasConstantLen())
+      return charType.getLen();
+  return llvm::None;
+}
+
 mlir::LogicalResult hlfir::ConcatOp::verify() {
   if (getStrings().size() < 2)
     return emitOpError("must be provided at least two string operands");
-  auto exprTy = getResult().getType().cast<hlfir::ExprType>();
-  unsigned kind = exprTy.getElementType().cast<fir::CharacterType>().getFKind();
+  unsigned kind = getCharacterKind(getResult().getType());
   for (auto string : getStrings())
-    if (kind != getFortranElementType(string.getType())
-                    .cast<fir::CharacterType>()
-                    .getFKind())
+    if (kind != getCharacterKind(string.getType()))
       return emitOpError("strings must have the same KIND as the result type");
   return mlir::success();
 }
 
+void hlfir::ConcatOp::build(mlir::OpBuilder &builder,
+                            mlir::OperationState &result,
+                            mlir::ValueRange strings, mlir::Value len) {
+  fir::CharacterType::LenType resultTypeLen = 0;
+  assert(!strings.empty() && "must contain operands");
+  unsigned kind = getCharacterKind(strings[0].getType());
+  for (auto string : strings)
+    if (auto cstLen = getCharacterLengthIfStatic(string.getType())) {
+      resultTypeLen += *cstLen;
+    } else {
+      resultTypeLen = fir::CharacterType::unknownLen();
+      break;
+    }
+  auto resultType = hlfir::ExprType::get(
+      builder.getContext(), hlfir::ExprType::Shape{},
+      fir::CharacterType::get(builder.getContext(), kind, resultTypeLen),
+      false);
+  build(builder, result, resultType, strings, len);
+}
+
 #define GET_OP_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"

flang/test/Lower/HLFIR/concat.f90

+! Test lowering of character concatenation to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+
+subroutine concat(c1, c2, c3)
+  character(*) :: c1, c2, c3
+  c1 = c2 // c3
+end subroutine
+! CHECK-LABEL: func.func @_QPconcat
+! CHECK:  hlfir.declare {{.*}}c1
+! CHECK:  %[[VAL_5:.*]]:2 = fir.unboxchar %{{.*}} : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare {{.*}}c2
+! CHECK:  %[[VAL_7:.*]]:2 = fir.unboxchar %{{.*}} : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:  %[[VAL_8:.*]]:2 = hlfir.declare {{.*}}c3
+! CHECK:  %[[VAL_9:.*]] = arith.addi %[[VAL_5]]#1, %[[VAL_7]]#1 : index
+! CHECK:  %[[VAL_10:.*]] = hlfir.concat %[[VAL_6]]#0, %[[VAL_8]]#0 len %[[VAL_9]] : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>
+
+subroutine concat_2(c1, c2, c3)
+  character(*) :: c1(100)
+  character :: c2(100)*10, c3(100)*20
+  c1(1) = c2(1) // c3(1)
+end subroutine
+! CHECK-LABEL: func.func @_QPconcat_2
+! CHECK:  %[[VAL_9:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_13:.*]]:2 = hlfir.declare %{{.*}}c2
+! CHECK:  %[[VAL_15:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_19:.*]]:2 = hlfir.declare {{.*}}c3
+! CHECK:  %[[VAL_21:.*]] = hlfir.designate %[[VAL_13]]#0 (%{{.*}})  typeparams %[[VAL_9]] : (!fir.ref<!fir.array<100x!fir.char<1,10>>>, index, index) -> !fir.ref<!fir.char<1,10>>
+! CHECK:  %[[VAL_23:.*]] = hlfir.designate %[[VAL_19]]#0 (%{{.*}})  typeparams %[[VAL_15]] : (!fir.ref<!fir.array<100x!fir.char<1,20>>>, index, index) -> !fir.ref<!fir.char<1,20>>
+! CHECK:  %[[VAL_24:.*]] = arith.addi %[[VAL_9]], %[[VAL_15]] : index
+! CHECK:  %[[VAL_25:.*]] = hlfir.concat %[[VAL_21]], %[[VAL_23]] len %[[VAL_24]] : (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,20>>, index) -> !hlfir.expr<!fir.char<1,30>>
+
+subroutine concat3(c1, c2, c3, c4)
+  character(*) :: c1, c2, c3, c4
+  c1 = c2 // c3 // c4
+end subroutine
+! CHECK-LABEL: func.func @_QPconcat3
+! CHECK:  hlfir.declare {{.*}}c1
+! CHECK:  %[[VAL_5:.*]]:2 = fir.unboxchar %{{.*}}
+! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare {{.*}}c2
+! CHECK:  %[[VAL_7:.*]]:2 = fir.unboxchar %{{.*}}
+! CHECK:  %[[VAL_8:.*]]:2 = hlfir.declare {{.*}}c3
+! CHECK:  %[[VAL_9:.*]]:2 = fir.unboxchar %{{.*}}
+! CHECK:  %[[VAL_10:.*]]:2 = hlfir.declare {{.*}}c4
+! CHECK:  %[[VAL_11:.*]] = arith.addi %[[VAL_5]]#1, %[[VAL_7]]#1 : index
+! CHECK:  %[[VAL_12:.*]] = hlfir.concat %[[VAL_6]]#0, %[[VAL_8]]#0 len %[[VAL_11]] : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK:  %[[VAL_13:.*]] = arith.addi %[[VAL_11]], %[[VAL_9]]#1 : index
+! CHECK:  %[[VAL_14:.*]] = hlfir.concat %[[VAL_12]], %[[VAL_10]]#0 len %[[VAL_13]] : (!hlfir.expr<!fir.char<1,?>>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>