[flang][hlfir] Added hlfir.get_length to inquire char length from hlf…

…ir.expr.

We will use hlfir.get_length to lower inquiries of char length
applied to hlfir.expr character values.

Reviewed By: tblah, jeanPerier

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

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

@@ -22,6 +22,7 @@ namespace hlfir {
 bool isFortranVariableType(mlir::Type);
 bool isFortranScalarCharacterType(mlir::Type);
 bool isFortranScalarCharacterExprType(mlir::Type);
+bool isFortranArrayCharacterExprType(mlir::Type);
 } // namespace hlfir
 
 #include "flang/Optimizer/HLFIR/HLFIRDialect.h.inc"

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

@@ -109,6 +109,16 @@ def IsFortranScalarCharacterExprPred
 def AnyScalarCharacterExpr : Type<IsFortranScalarCharacterExprPred,
     "any character scalar expression type">;
 
+def isFortranArrayCharacterExprTypePred
+        : CPred<"::hlfir::isFortranArrayCharacterExprType($_self)">;
+def AnyArrayCharacterExpr : Type<isFortranArrayCharacterExprTypePred,
+    "any character array expression type">;
+
+def AnyScalarOrArrayCharacterExpr :
+    Type<Or<[AnyScalarCharacterExpr.predicate,
+             AnyArrayCharacterExpr.predicate]>,
+    "any character scalar or array expression type">;
+
 def IsFortranNumericalArrayObjectPred
         : CPred<"::hlfir::isFortranNumericalArrayObject($_self)">;
 def AnyFortranNumericalArrayObject : Type<IsFortranNumericalArrayObjectPred,

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

@@ -439,6 +439,24 @@ def hlfir_SetLengthOp : hlfir_Op<"set_length", []> {
   let builders = [OpBuilder<(ins "mlir::Value":$string,"mlir::Value":$len)>];
 }
 
+def hlfir_GetLengthOp : hlfir_Op<"get_length", [Pure]> {
+  let summary = "get the length of a character entity";
+  let description = [{
+    Get the length of character entity represented as hlfir.expr.
+  }];
+
+  let arguments = (ins AnyScalarOrArrayCharacterExpr:$expr);
+  let results = (outs Index);
+
+  let assemblyFormat = [{
+    $expr attr-dict `:` functional-type(operands, results)
+  }];
+
+  // If character length is know via the type, then the operation
+  // may be immediately canonicalized into arith::ConstantOp.
+  let hasCanonicalizeMethod = 1;
+}
+
 def hlfir_SumOp : hlfir_Op<"sum", [AttrSizedOperandSegments,
     DeclareOpInterfaceMethods<ArithFastMathInterface>]> {
   let summary = "SUM transformational intrinsic";

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

@@ -104,6 +104,14 @@ bool hlfir::isFortranScalarCharacterExprType(mlir::Type type) {
   return false;
 }
 
+bool hlfir::isFortranArrayCharacterExprType(mlir::Type type) {
+  if (auto exprType = mlir::dyn_cast<hlfir::ExprType>(type))
+    return exprType.isArray() &&
+           mlir::isa<fir::CharacterType>(exprType.getElementType());
+
+  return false;
+}
+
 bool hlfir::isFortranScalarNumericalType(mlir::Type type) {
   return fir::isa_integer(type) || fir::isa_real(type) ||
          fir::isa_complex(type);

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

@@ -1501,6 +1501,26 @@ void hlfir::CharExtremumOp::build(mlir::OpBuilder &builder,
   build(builder, result, resultType, predicate, strings);
 }
 
+//===----------------------------------------------------------------------===//
+// GetLength
+//===----------------------------------------------------------------------===//
+
+mlir::LogicalResult
+hlfir::GetLengthOp::canonicalize(GetLengthOp getLength,
+                                 mlir::PatternRewriter &rewriter) {
+  mlir::Location loc = getLength.getLoc();
+  auto exprTy = mlir::cast<hlfir::ExprType>(getLength.getExpr().getType());
+  auto charTy = mlir::cast<fir::CharacterType>(exprTy.getElementType());
+  if (!charTy.hasConstantLen())
+    return mlir::failure();
+
+  mlir::Type indexTy = rewriter.getIndexType();
+  auto cstLen = rewriter.create<mlir::arith::ConstantOp>(
+      loc, indexTy, mlir::IntegerAttr::get(indexTy, charTy.getLen()));
+  rewriter.replaceOp(getLength, cstLen);
+  return mlir::success();
+}
+
 #include "flang/Optimizer/HLFIR/HLFIROpInterfaces.cpp.inc"
 #define GET_OP_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIREnums.cpp.inc"

flang/test/HLFIR/get_length.fir

@@ -0,0 +1,48 @@
+// Test hlfir.get_length operation parse, verify (no errors), and unparse.
+
+// RUN: fir-opt %s | fir-opt | FileCheck %s --check-prefix CHECK --check-prefix CHECK-ALL
+
+// Test canonicalization.
+// RUN: fir-opt %s --canonicalize | FileCheck %s --check-prefix CHECK-CANON --check-prefix CHECK-ALL
+
+func.func @fixed_len_scalar(%arg0: !hlfir.expr<!fir.char<1,10>>) -> index {
+  %1 = hlfir.get_length %arg0 : (!hlfir.expr<!fir.char<1,10>>) -> index
+  return %1 : index
+}
+// CHECK-ALL-LABEL:   func.func @fixed_len_scalar(
+// CHECK-ALL-SAME:      %[[VAL_0:.*]]: !hlfir.expr<!fir.char<1,10>>) -> index {
+// CHECK:               %[[VAL_1:.*]] = hlfir.get_length %[[VAL_0]] : (!hlfir.expr<!fir.char<1,10>>) -> index
+// CHECK-CANON:         %[[VAL_1:.*]] = arith.constant 10 : index
+// CHECK-ALL:           return %[[VAL_1]] : index
+// CHECK-ALL:         }
+
+func.func @assumed_len_scalar(%arg0: !hlfir.expr<!fir.char<1,?>>) -> index {
+  %1 = hlfir.get_length %arg0 : (!hlfir.expr<!fir.char<1,?>>) -> index
+  return %1 : index
+}
+// CHECK-ALL-LABEL:   func.func @assumed_len_scalar(
+// CHECK-ALL-SAME:      %[[VAL_0:.*]]: !hlfir.expr<!fir.char<1,?>>) -> index {
+// CHECK-ALL:           %[[VAL_1:.*]] = hlfir.get_length %[[VAL_0]] : (!hlfir.expr<!fir.char<1,?>>) -> index
+// CHECK-ALL:           return %[[VAL_1]] : index
+// CHECK-ALL:         }
+
+func.func @fixed_len_array(%arg0: !hlfir.expr<?x!fir.char<1,10>>) -> index {
+  %1 = hlfir.get_length %arg0 : (!hlfir.expr<?x!fir.char<1,10>>) -> index
+  return %1 : index
+}
+// CHECK-ALL-LABEL:   func.func @fixed_len_array(
+// CHECK-ALL-SAME:      %[[VAL_0:.*]]: !hlfir.expr<?x!fir.char<1,10>>) -> index {
+// CHECK:               %[[VAL_1:.*]] = hlfir.get_length %[[VAL_0]] : (!hlfir.expr<?x!fir.char<1,10>>) -> index
+// CHECK-CANON:         %[[VAL_1:.*]] = arith.constant 10 : index
+// CHECK-ALL:           return %[[VAL_1]] : index
+// CHECK-ALL:         }
+
+func.func @assumed_len_array(%arg0: !hlfir.expr<?x!fir.char<1,?>>) -> index {
+  %1 = hlfir.get_length %arg0 : (!hlfir.expr<?x!fir.char<1,?>>) -> index
+  return %1 : index
+}
+// CHECK-ALL-LABEL:   func.func @assumed_len_array(
+// CHECK-ALL-SAME:      %[[VAL_0:.*]]: !hlfir.expr<?x!fir.char<1,?>>) -> index {
+// CHECK-ALL:           %[[VAL_1:.*]] = hlfir.get_length %[[VAL_0]] : (!hlfir.expr<?x!fir.char<1,?>>) -> index
+// CHECK-ALL:           return %[[VAL_1]] : index
+// CHECK-ALL:         }

flang/test/HLFIR/invalid.fir

@@ -947,3 +947,24 @@ func.func @bad_elsewhere_3(%mask: !fir.ref<!fir.array<10x!fir.logical<4>>>, %x:
   }
   return
 }
+
+// -----
+func.func @bad_get_length_1(%arg0: !hlfir.expr<i32>) {
+  // expected-error@+1 {{'hlfir.get_length' op operand #0 must be any character scalar or array expression type, but got '!hlfir.expr<i32>'}}
+  %1 = hlfir.get_length %arg0 : (!hlfir.expr<i32>) -> index
+  return
+}
+
+// -----
+func.func @bad_get_length_2(%arg0: !hlfir.expr<?xi32>) {
+  // expected-error@+1 {{'hlfir.get_length' op operand #0 must be any character scalar or array expression type, but got '!hlfir.expr<?xi32>'}}
+  %1 = hlfir.get_length %arg0 : (!hlfir.expr<?xi32>) -> index
+  return
+}
+
+// -----
+func.func @bad_get_length_3(%arg0: !hlfir.expr<!fir.boxchar<1>>) {
+  // expected-error@+1 {{'hlfir.get_length' op operand #0 must be any character scalar or array expression type, but got '!hlfir.expr<!fir.boxchar<1>>'}}
+  %1 = hlfir.get_length %arg0 : (!hlfir.expr<!fir.boxchar<1>>) -> index
+  return
+}