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

[vzakhari]

Summary

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

[jeanPerier]

Looks great

[tblah]

Looks good to me!

flang/include/flang/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);
+bool isFortranArrayCharacterExprType(mlir::Type);
 } // namespace hlfir
 
 #include "flang/Optimizer/HLFIR/HLFIRDialect.h.inc"
 
 #include "flang/Optimizer/HLFIR/HLFIREnums.h.inc"
 
 #define GET_TYPEDEF_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIRTypes.h.inc"

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

 def AnyScalarCharacterEntity : Type<IsFortranScalarCharacterPred,
     "any character scalar type">;
 
 def IsFortranScalarCharacterExprPred
         : CPred<"::hlfir::isFortranScalarCharacterExprType($_self)">;
 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,
     "any array-like object containing a numerical type">;
 
 def IsFortranNumericalOrLogicalArrayObjectPred
         : CPred<"::hlfir::isFortranNumericalOrLogicalArrayObject($_self)">;
 def AnyFortranNumericalOrLogicalArrayObject : Type<IsFortranNumericalOrLogicalArrayObjectPred,

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

def hlfir_SetLengthOp : hlfir_Op<"set_length", []> {
   let assemblyFormat = [{
     $string `len` $length
      attr-dict `:` functional-type(operands, results)
   }];
 
   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";
   let description = [{
     Sums the elements of an array, optionally along a particular dimension,
     optionally if a mask is true.
   }];
 

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

 
 bool hlfir::isFortranScalarCharacterExprType(mlir::Type type) {
   if (auto exprType = type.dyn_cast<hlfir::ExprType>())
     return exprType.isScalar() &&
            exprType.getElementType().isa<fir::CharacterType>();
   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);
 }
 
 bool hlfir::isFortranNumericalArrayObject(mlir::Type type) {
   if (isBoxAddressType(type))
     return false;

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

void hlfir::CharExtremumOp::build(mlir::OpBuilder &builder,
   auto resultType = hlfir::ExprType::get(
       builder.getContext(), hlfir::ExprType::Shape{},
       fir::CharacterType::get(builder.getContext(), kind, resultTypeLen),
       false);
 
   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"
 #include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"

flang/test/HLFIR/get_length.fir

+// 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

hlfir.where {
     hlfir.region_assign {
       hlfir.yield %y : !fir.box<!fir.array<?xf32>>
     } to {
       hlfir.yield %x : !fir.ref<!fir.array<10xf32>>
     }
   }
   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
+}