[flang] Add hlfir.set_length operation

[jeanPerier]

Summary

This will implement evaluate::SetLength where the length of
a character entity is changed (with trimming and padding).

Depends on D140214

[PeteSteinfeld]

All builds and tests correctly and looks good. You should get @clementval to approve, though.

[clementval]

LGTM

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

let assemblyFormat = [{
      attr-dict `:` functional-type(operands, results)
   }];
 
   let builders = [OpBuilder<(ins "mlir::ValueRange":$strings,"mlir::Value":$len)>];
 
   let hasVerifier = 1;
 }
 
+def hlfir_SetLengthOp : hlfir_Op<"set_length", []> {
+  let summary = "change the length of a character entity";
+  let description = [{
+    Change the length of character entity. This trims or pads the
+    character argument according to the new length.
+  }];
+
+  let arguments = (ins AnyScalarCharacterEntity:$string,
+                   AnyIntegerType:$length);
+
+  let results = (outs AnyScalarCharacterExpr);
+
+  let assemblyFormat = [{
+    $string `len` $length
+     attr-dict `:` functional-type(operands, results)
+  }];
+
+  let builders = [OpBuilder<(ins "mlir::Value":$string,"mlir::Value":$len)>];
+}
+
 def hlfir_AssociateOp : hlfir_Op<"associate", [AttrSizedOperandSegments,
     DeclareOpInterfaceMethods<fir_FortranVariableOpInterface>]> {
   let summary = "Create a variable from an expression value";
   let description = [{
     Create a variable from an expression value.
     For expressions, this operation is an incentive to re-use the expression
     storage, if any, after the bufferization pass when possible (if the
     expression is not used afterwards).

flang/lib/Optimizer/Builder/HLFIRTools.cpp

if (entity.getType().isa<hlfir::ExprType>()) {
     if (auto reassoc = expr.getDefiningOp<hlfir::NoReassocOp>())
       expr = reassoc.getVal();
     // 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 = expr.getDefiningOp<hlfir::ConcatOp>()) {
       result.push_back(concat.getLength());
       return;
+    } else if (auto concat = expr.getDefiningOp<hlfir::SetLengthOp>()) {
+      result.push_back(concat.getLength());
+      return;
     } else if (auto asExpr = expr.getDefiningOp<hlfir::AsExprOp>()) {
       hlfir::genLengthParameters(loc, builder, hlfir::Entity{asExpr.getVar()},
                                  result);
       return;
     } else if (auto elemental = expr.getDefiningOp<hlfir::ElementalOp>()) {
       result.append(elemental.getTypeparams().begin(),
                     elemental.getTypeparams().end());
       return;

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

 //===-- HLFIROps.cpp ------------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
+#include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinTypes.h"
 #include "mlir/IR/DialectImplementation.h"
 #include "mlir/IR/Matchers.h"
 #include "mlir/IR/OpImplementation.h"
 #include "llvm/ADT/TypeSwitch.h"
 #include <tuple>
 
void hlfir::ConcatOp::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, strings, len);
 }
 
 //===----------------------------------------------------------------------===//
+// SetLengthOp
+//===----------------------------------------------------------------------===//
+
+void hlfir::SetLengthOp::build(mlir::OpBuilder &builder,
+                               mlir::OperationState &result, mlir::Value string,
+                               mlir::Value len) {
+  fir::CharacterType::LenType resultTypeLen = fir::CharacterType::unknownLen();
+  if (auto cstLen = fir::getIntIfConstant(len))
+    resultTypeLen = *cstLen;
+  unsigned kind = getCharacterKind(string.getType());
+  auto resultType = hlfir::ExprType::get(
+      builder.getContext(), hlfir::ExprType::Shape{},
+      fir::CharacterType::get(builder.getContext(), kind, resultTypeLen),
+      false);
+  build(builder, result, resultType, string, len);
+}
+
+//===----------------------------------------------------------------------===//
 // AssociateOp
 //===----------------------------------------------------------------------===//
 
 void hlfir::AssociateOp::build(mlir::OpBuilder &builder,
                                mlir::OperationState &result, mlir::Value source,
                                llvm::StringRef uniq_name, mlir::Value shape,
                                mlir::ValueRange typeparams,
                                fir::FortranVariableFlagsAttr fortran_attrs) {

flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp

auto hlfirTempRes = hlfir::genDeclare(loc, builder, res, "tmp",
                                           fir::FortranVariableFlagsAttr{});
     mlir::Value bufferizedExpr =
         packageBufferizedExpr(loc, builder, hlfirTempRes, false);
     rewriter.replaceOp(concat, bufferizedExpr);
     return mlir::success();
   }
 };
 
+struct SetLengthOpConversion
+    : public mlir::OpConversionPattern<hlfir::SetLengthOp> {
+  using mlir::OpConversionPattern<hlfir::SetLengthOp>::OpConversionPattern;
+  explicit SetLengthOpConversion(mlir::MLIRContext *ctx)
+      : mlir::OpConversionPattern<hlfir::SetLengthOp>{ctx} {}
+  mlir::LogicalResult
+  matchAndRewrite(hlfir::SetLengthOp setLength, OpAdaptor adaptor,
+                  mlir::ConversionPatternRewriter &rewriter) const override {
+    mlir::Location loc = setLength->getLoc();
+    auto module = setLength->getParentOfType<mlir::ModuleOp>();
+    fir::FirOpBuilder builder(rewriter, fir::getKindMapping(module));
+    // Create a temp with the new length.
+    hlfir::Entity string{getBufferizedExprStorage(adaptor.getString())};
+    auto charType = hlfir::getFortranElementType(setLength.getType());
+    llvm::StringRef tmpName{".tmp"};
+    llvm::SmallVector<mlir::Value, 1> lenParams{adaptor.getLength()};
+    auto alloca = builder.createTemporary(loc, charType, tmpName,
+                                          /*shape=*/std::nullopt, lenParams);
+    auto declareOp = builder.create<hlfir::DeclareOp>(
+        loc, alloca, tmpName, /*shape=*/mlir::Value{}, lenParams,
+        fir::FortranVariableFlagsAttr{});
+    // Assign string value to the created temp.
+    builder.create<hlfir::AssignOp>(loc, string, declareOp.getBase());
+    mlir::Value bufferizedExpr =
+        packageBufferizedExpr(loc, builder, alloca, false);
+    rewriter.replaceOp(setLength, bufferizedExpr);
+    return mlir::success();
+  }
+};
+
 struct AssociateOpConversion
     : public mlir::OpConversionPattern<hlfir::AssociateOp> {
   using mlir::OpConversionPattern<hlfir::AssociateOp>::OpConversionPattern;
   explicit AssociateOpConversion(mlir::MLIRContext *ctx)
       : mlir::OpConversionPattern<hlfir::AssociateOp>{ctx} {}
   mlir::LogicalResult
   matchAndRewrite(hlfir::AssociateOp associate, OpAdaptor adaptor,
                   mlir::ConversionPatternRewriter &rewriter) const override {
void runOnOperation() override {
     // creation, but this needs a bit more thinking, so at this point the pass
     // is scheduled on the moduleOp.
     auto module = this->getOperation();
     auto *context = &getContext();
     mlir::RewritePatternSet patterns(context);
     patterns.insert<ApplyOpConversion, AsExprOpConversion, AssignOpConversion,
                     AssociateOpConversion, ConcatOpConversion,
                     ElementalOpConversion, EndAssociateOpConversion,
-                    NoReassocOpConversion>(context);
+                    NoReassocOpConversion, SetLengthOpConversion>(context);
     mlir::ConversionTarget target(*context);
     target.addIllegalOp<hlfir::ApplyOp, hlfir::AssociateOp, hlfir::ElementalOp,
-                        hlfir::EndAssociateOp, hlfir::YieldElementOp>();
+                        hlfir::EndAssociateOp, hlfir::SetLengthOp,
+                        hlfir::YieldElementOp>();
     target.markUnknownOpDynamicallyLegal([](mlir::Operation *op) {
       return llvm::all_of(
                  op->getResultTypes(),
                  [](mlir::Type ty) { return !ty.isa<hlfir::ExprType>(); }) &&
              llvm::all_of(op->getOperandTypes(), [](mlir::Type ty) {
                return !ty.isa<hlfir::ExprType>();
              });
     });

flang/test/HLFIR/set_length-codegen.fir

+// Test hlfir.set_length operation lowering to operations operating on memory.
+// RUN: fir-opt %s -bufferize-hlfir | FileCheck %s
+
+func.func @test_cst_len(%str : !fir.boxchar<1>) {
+  %c10 = arith.constant 10 : index
+  %0 = hlfir.set_length %str len %c10 : (!fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,10>>
+  return
+}
+// CHECK-LABEL:   func.func @test_cst_len(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>) {
+// CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".tmp"}
+// CHECK:  %[[VAL_2:.*]] = arith.constant 10 : index
+// CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] typeparams %[[VAL_2]] {uniq_name = ".tmp"} : (!fir.ref<!fir.char<1,10>>, index) -> (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,10>>)
+// CHECK:  hlfir.assign %[[VAL_0]] to %[[VAL_3]]#0 : !fir.boxchar<1>, !fir.ref<!fir.char<1,10>>
+// CHECK:  %[[VAL_4:.*]] = arith.constant false
+// CHECK:  %[[VAL_5:.*]] = fir.undefined tuple<!fir.ref<!fir.char<1,10>>, i1>
+// CHECK:  %[[VAL_6:.*]] = fir.insert_value %[[VAL_5]], %[[VAL_4]], [1 : index] : (tuple<!fir.ref<!fir.char<1,10>>, i1>, i1) -> tuple<!fir.ref<!fir.char<1,10>>, i1>
+// CHECK:  %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_1]], [0 : index] : (tuple<!fir.ref<!fir.char<1,10>>, i1>, !fir.ref<!fir.char<1,10>>) -> tuple<!fir.ref<!fir.char<1,10>>, i1>
+
+func.func @test_dyn_len(%str : !fir.ref<!fir.char<1,10>>, %len : index) {
+  %0 = hlfir.set_length %str len %len : (!fir.ref<!fir.char<1,10>>, index) -> !hlfir.expr<!fir.char<1,?>>
+  return
+}
+// CHECK-LABEL:   func.func @test_dyn_len(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.char<1,10>>,
+// CHECK-SAME:    %[[VAL_1:.*]]: index) {
+// CHECK:  %[[VAL_2:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_1]] : index) {bindc_name = ".tmp"}
+// CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[VAL_1]] {uniq_name = ".tmp"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+// CHECK:  hlfir.assign %[[VAL_0]] to %[[VAL_3]]#0 : !fir.ref<!fir.char<1,10>>, !fir.boxchar<1>
+// CHECK:  %[[VAL_4:.*]] = arith.constant false
+// CHECK:  %[[VAL_5:.*]] = fir.undefined tuple<!fir.ref<!fir.char<1,?>>, i1>
+// CHECK:  %[[VAL_6:.*]] = fir.insert_value %[[VAL_5]], %[[VAL_4]], [1 : index] : (tuple<!fir.ref<!fir.char<1,?>>, i1>, i1) -> tuple<!fir.ref<!fir.char<1,?>>, i1>
+// CHECK:  %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_2]], [0 : index] : (tuple<!fir.ref<!fir.char<1,?>>, i1>, !fir.ref<!fir.char<1,?>>) -> tuple<!fir.ref<!fir.char<1,?>>, i1>

flang/test/HLFIR/set_length.fir

+// Test hlfir.set_length operation parse, verify (no errors), and unparse.
+// RUN: fir-opt %s | fir-opt | FileCheck %s
+
+func.func @test_cst_len(%str : !fir.boxchar<1>) {
+  %c10 = arith.constant 10 : index
+  %0 = hlfir.set_length %str len %c10 : (!fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,10>>
+  return
+}
+// CHECK-LABEL:   func.func @test_cst_len(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 10 : index
+// CHECK:  %[[VAL_2:.*]] = hlfir.set_length %[[VAL_0]] len %[[VAL_1]] : (!fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,10>>
+
+func.func @test_dyn_len(%str : !fir.ref<!fir.char<1,10>>, %len : index) {
+  %0 = hlfir.set_length %str len %len : (!fir.ref<!fir.char<1,10>>, index) -> !hlfir.expr<!fir.char<1,?>>
+  return
+}
+// CHECK-LABEL:   func.func @test_dyn_len(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.char<1,10>>,
+// CHECK-SAME:    %[[VAL_1:.*]]: index) {
+// CHECK:  %[[VAL_2:.*]] = hlfir.set_length %[[VAL_0]] len %[[VAL_1]] : (!fir.ref<!fir.char<1,10>>, index) -> !hlfir.expr<!fir.char<1,?>>
+
+func.func @test_from_expr(%str : !hlfir.expr<!fir.char<1,?>>, %len : index) {
+  %0 = hlfir.set_length %str len %len : (!hlfir.expr<!fir.char<1,?>>, index) -> !hlfir.expr<!fir.char<1,?>>
+  return
+}
+// CHECK-LABEL:   func.func @test_from_expr(
+// CHECK-SAME:    %[[VAL_0:.*]]: !hlfir.expr<!fir.char<1,?>>,
+// CHECK-SAME:    %[[VAL_1:.*]]: index) {
+// CHECK:  %[[VAL_2:.*]] = hlfir.set_length %[[VAL_0]] len %[[VAL_1]] : (!hlfir.expr<!fir.char<1,?>>, index) -> !hlfir.expr<!fir.char<1,?>>