[flang] Add hlfir.concat operation definition

[jeanPerier]

Summary

This operation represents scalar character concatenation. This is
added as part of flang lowering update described in
https://github.com/llvm/llvm-project/blob/main/flang/docs/HighLevelFIR.md

A notable difference with Fortran concatenation is that hlfir.concat can
take two or more operands. This will be used to optimize concatenation
chains.

[clementval]

LGTM

flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h

 #define FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H
 
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "mlir/IR/Dialect.h"
 
 namespace hlfir {
 /// Is this a type that can be used for an HLFIR variable ?
 bool isFortranVariableType(mlir::Type);
+bool isFortranScalarCharacterType(mlir::Type);
+bool isFortranScalarCharacterExprType(mlir::Type);
 } // namespace hlfir
 
 #include "flang/Optimizer/HLFIR/HLFIRDialect.h.inc"
 
 #define GET_TYPEDEF_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIRTypes.h.inc"
 
 #define GET_ATTRDEF_CLASSES

flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td

let parameters = (ins
     ArrayRefParameter<"int64_t", "expression shape">:$shape,
     "mlir::Type":$elementType,
     "bool":$polymorphic
   );
 
   let extraClassDeclaration = [{
     using Shape = llvm::SmallVector<int64_t>;
     mlir::Type getEleTy() const {return getElementType();}
-    bool isArray() const { return !getShape().empty(); }
+    bool isScalar() const { return getShape().empty(); }
+    bool isArray() const { return !isScalar(); }
     bool isPolymorphic() const { return getPolymorphic(); }
   }];
 
   let hasCustomAssemblyFormat = 1;
 
 }
 
 def IsFortranVariablePred
         : CPred<"::hlfir::isFortranVariableType($_self)">;
 def AnyFortranVariable : Type<IsFortranVariablePred, "any HLFIR variable type">;
 
 
 def AnyFortranValue : TypeConstraint<Or<[AnyLogicalLike.predicate,
     AnyIntegerLike.predicate, AnyRealLike.predicate,
     fir_ComplexType.predicate, AnyComplex.predicate,
     hlfir_ExprType.predicate]>, "any Fortran value type">;
 
 
 def AnyFortranEntity : TypeConstraint<Or<[AnyFortranVariable.predicate,
     AnyFortranValue.predicate]>, "any Fortran value or variable type">;
 
+def IsFortranScalarCharacterPred
+        : CPred<"::hlfir::isFortranScalarCharacterType($_self)">;
+def AnyScalarCharacterEntity : Type<IsFortranScalarCharacterPred,
+    "any character scalar type">;
+
+def IsFortranScalarCharacterExprPred
+        : CPred<"::hlfir::isFortranScalarCharacterExprType($_self)">;
+def AnyScalarCharacterExpr : Type<IsFortranScalarCharacterExprPred,
+    "any character scalar expression type">;
 
 #endif // FORTRAN_DIALECT_HLFIR_OP_BASE

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

OpBuilder<(ins "mlir::Type":$result_type, "mlir::Value":$memref,
       CArg<"mlir::ValueRange", "{}">:$substring,
       CArg<"llvm::Optional<bool>", "{}">:$complex_part,
       CArg<"mlir::Value", "{}">:$shape, CArg<"mlir::ValueRange", "{}">:$typeparams,
       CArg<"fir::FortranVariableFlagsAttr", "{}">:$fortran_attrs)>];
 
   let hasVerifier = 1;
 }
 
+def hlfir_ConcatOp : hlfir_Op<"concat", []> {
+  let summary = "concatenate characters";
+  let description = [{
+    Concatenate two or more character strings of a same character kind.
+  }];
+
+  let arguments = (ins Variadic<AnyScalarCharacterEntity>:$strings,
+                   AnyIntegerType:$length);
+
+  let results = (outs AnyScalarCharacterExpr);
+
+  let assemblyFormat = [{
+    $strings `len` $length
+     attr-dict `:` functional-type(operands, results)
+  }];
+
+  let hasVerifier = 1;
+}
+
 #endif // FORTRAN_DIALECT_HLFIR_OPS

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

bool hlfir::isFortranVariableType(mlir::Type type) {
   return llvm::TypeSwitch<mlir::Type, bool>(type)
       .Case<fir::ReferenceType, fir::PointerType, fir::HeapType>([](auto p) {
         mlir::Type eleType = p.getEleTy();
         return eleType.isa<fir::BaseBoxType>() || !fir::hasDynamicSize(eleType);
       })
       .Case<fir::BaseBoxType, fir::BoxCharType>([](auto) { return true; })
       .Default([](mlir::Type) { return false; });
 }
+
+bool hlfir::isFortranScalarCharacterType(mlir::Type type) {
+  return isFortranScalarCharacterExprType(type) ||
+         type.isa<fir::BoxCharType>() ||
+         fir::unwrapPassByRefType(fir::unwrapRefType(type))
+             .isa<fir::CharacterType>();
+}
+
+bool hlfir::isFortranScalarCharacterExprType(mlir::Type type) {
+  if (auto exprType = type.dyn_cast<hlfir::ExprType>())
+    return exprType.isScalar() &&
+           exprType.getElementType().isa<fir::CharacterType>();
+  return false;
+}

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

if (isBoxAddressType(getResult().getType())) {
     } else if (numLenParam != 0) {
       return emitOpError("must not be provided length parameters if the result "
                          "type does not have length parameters");
     }
   }
   return mlir::success();
 }
 
+//===----------------------------------------------------------------------===//
+// ConcatOp
+//===----------------------------------------------------------------------===//
+
+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();
+  for (auto string : getStrings())
+    if (kind != getFortranElementType(string.getType())
+                    .cast<fir::CharacterType>()
+                    .getFKind())
+      return emitOpError("strings must have the same KIND as the result type");
+  return mlir::success();
+}
+
 #define GET_OP_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"

flang/test/HLFIR/concat.fir

+// Test hlfir.concat operation parse, verify (no errors), and unparse.
+
+// RUN: fir-opt %s | fir-opt | FileCheck %s
+
+func.func @concat_var(%arg0: !fir.ref<!fir.char<1,10>>, %arg1: !fir.ref<!fir.char<1,20>>) {
+  %c30 = arith.constant 30 : index
+  %0 = hlfir.concat %arg0, %arg1 len %c30 : (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,20>>, index) -> (!hlfir.expr<!fir.char<1,30>>)
+  return
+}
+// CHECK-LABEL:   func.func @concat_var(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.char<1,10>>,
+// CHECK-SAME:    %[[VAL_1:.*]]: !fir.ref<!fir.char<1,20>>) {
+// CHECK:  %[[VAL_2:.*]] = arith.constant 30 : index
+// CHECK:  %[[VAL_3:.*]] = hlfir.concat %[[VAL_0]], %[[VAL_1]] len %[[VAL_2]] : (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,20>>, index) -> !hlfir.expr<!fir.char<1,30>>
+
+
+func.func @concat_boxchar(%arg0: !fir.boxchar<1>, %arg1: !fir.boxchar<1>) {
+  %c30 = arith.constant 30 : index
+  %0 = hlfir.concat %arg0, %arg1 len %c30 : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> (!hlfir.expr<!fir.char<1,?>>)
+  return
+}
+// CHECK-LABEL:   func.func @concat_boxchar(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>,
+// CHECK-SAME:    %[[VAL_1:.*]]: !fir.boxchar<1>) {
+// CHECK:  %[[VAL_2:.*]] = arith.constant 30 : index
+// CHECK:  %[[VAL_3:.*]] = hlfir.concat %[[VAL_0]], %[[VAL_1]] len %[[VAL_2]] : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>
+
+
+func.func @concat_boxchar_kind2(%arg0: !fir.boxchar<2>, %arg1: !fir.boxchar<2>) {
+  %c30 = arith.constant 30 : index
+  %0 = hlfir.concat %arg0, %arg1 len %c30 : (!fir.boxchar<2>, !fir.boxchar<2>, index) -> (!hlfir.expr<!fir.char<2,?>>)
+  return
+}
+// CHECK-LABEL:   func.func @concat_boxchar_kind2(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<2>,
+// CHECK-SAME:    %[[VAL_1:.*]]: !fir.boxchar<2>) {
+// CHECK:  %[[VAL_2:.*]] = arith.constant 30 : index
+// CHECK:  %[[VAL_3:.*]] = hlfir.concat %[[VAL_0]], %[[VAL_1]] len %[[VAL_2]] : (!fir.boxchar<2>, !fir.boxchar<2>, index) -> !hlfir.expr<!fir.char<2,?>>
+
+
+func.func @concat_expr(%arg0: !hlfir.expr<!fir.char<1,10>>, %arg1: !hlfir.expr<!fir.char<1,20>>) {
+  %c30 = arith.constant 30 : index
+  %0 = hlfir.concat %arg0, %arg1 len %c30 : (!hlfir.expr<!fir.char<1,10>>, !hlfir.expr<!fir.char<1,20>>, index) -> (!hlfir.expr<!fir.char<1,30>>)
+  return
+}
+// CHECK-LABEL:   func.func @concat_expr(
+// CHECK-SAME:    %[[VAL_0:.*]]: !hlfir.expr<!fir.char<1,10>>,
+// CHECK-SAME:    %[[VAL_1:.*]]: !hlfir.expr<!fir.char<1,20>>) {
+// CHECK:  %[[VAL_2:.*]] = arith.constant 30 : index
+// CHECK:  %[[VAL_3:.*]] = hlfir.concat %[[VAL_0]], %[[VAL_1]] len %[[VAL_2]] : (!hlfir.expr<!fir.char<1,10>>, !hlfir.expr<!fir.char<1,20>>, index) -> !hlfir.expr<!fir.char<1,30>>
+
+
+func.func @concat_several_args(%arg0: !fir.boxchar<1>, %arg1: !fir.boxchar<1>) {
+  %c30 = arith.constant 30 : index
+  %0 = hlfir.concat %arg0, %arg1, %arg1 len %c30 : (!fir.boxchar<1>, !fir.boxchar<1>, !fir.boxchar<1>, index) -> (!hlfir.expr<!fir.char<1,?>>)
+  return
+}
+// CHECK-LABEL:   func.func @concat_several_args(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>,
+// CHECK-SAME:    %[[VAL_1:.*]]: !fir.boxchar<1>) {
+// CHECK:  %[[VAL_2:.*]] = arith.constant 30 : index
+// CHECK:  %[[VAL_3:.*]] = hlfir.concat %[[VAL_0]], %[[VAL_1]], %[[VAL_1]] len %[[VAL_2]] : (!fir.boxchar<1>, !fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>

flang/test/HLFIR/invalid.fir

 
 // -----
 func.func @bad_designate_len_params_3(%arg0 : !fir.box<!fir.array<?xi32>>) {
   %c1 = arith.constant 1 : index
   // expected-error@+1 {{'hlfir.designate' op must not be provided length parameters if the result type does not have length parameters}}
   %0 = hlfir.designate %arg0(%c1) typeparams %c1 :  (!fir.box<!fir.array<?xi32>>, index, index) -> !fir.ref<i32>
   return
 }
+
+// -----
+func.func @bad_concat(%arg0: !fir.ref<!fir.char<1,10>>, %arg1: !fir.ref<!fir.char<1,20>>) {
+  %c30 = arith.constant 30 : index
+  // expected-error@+1 {{'hlfir.concat' op result #0 must be any character scalar expression type, but got '!fir.ref<!fir.char<1,30>>'}}
+  %0 = hlfir.concat %arg0, %arg1 len %c30 : (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,20>>, index) -> (!fir.ref<!fir.char<1,30>>)
+  return
+}
+
+// -----
+func.func @bad_concat_2(%arg0: !fir.ref<!fir.array<100x!fir.char<1,10>>>, %arg1: !fir.ref<!fir.array<100x!fir.char<1,20>>>) {
+  %c30 = arith.constant 30 : index
+  // expected-error@+1 {{'hlfir.concat' op operand #0 must be any character scalar type, but got '!fir.ref<!fir.array<100x!fir.char<1,10>>>'}}
+  %0 = hlfir.concat %arg0, %arg1 len %c30 : (!fir.ref<!fir.array<100x!fir.char<1,10>>>, !fir.ref<!fir.array<100x!fir.char<1,20>>>, index) -> (!hlfir.expr<100x!fir.char<1,30>>)
+  return
+}
+
+// -----
+func.func @bad_concat_3(%arg0: !fir.ref<!fir.char<1,10>>, %arg1: !fir.ref<i32>) {
+  %c30 = arith.constant 30 : index
+  // expected-error@+1 {{'hlfir.concat' op operand #1 must be any character scalar type, but got '!fir.ref<i32>'}}
+  %0 = hlfir.concat %arg0, %arg1 len %c30 : (!fir.ref<!fir.char<1,10>>, !fir.ref<i32>, index) -> (!hlfir.expr<!fir.char<1,30>>)
+  return
+}
+
+// -----
+func.func @bad_concat_4(%arg0: !fir.ref<!fir.char<1,10>>, %arg1: !fir.ref<!fir.char<2,20>>) {
+  %c30 = arith.constant 30 : index
+  // expected-error@+1 {{'hlfir.concat' op strings must have the same KIND as the result type}}
+  %0 = hlfir.concat %arg0, %arg1 len %c30 : (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<2,20>>, index) -> (!hlfir.expr<!fir.char<1,30>>)
+  return
+}
+
+// -----
+func.func @bad_concat_4(%arg0: !fir.ref<!fir.char<1,30>>) {
+  %c30 = arith.constant 30 : index
+  // expected-error@+1 {{'hlfir.concat' op must be provided at least two string operands}}
+  %0 = hlfir.concat %arg0 len %c30 : (!fir.ref<!fir.char<1,30>>, index) -> (!hlfir.expr<!fir.char<1,30>>)
+  return
+}