[flang] Add hlfir.char_trim operation

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

@@ -368,6 +368,23 @@ def hlfir_CmpCharOp : hlfir_Op<"cmpchar",
   let hasVerifier = 1;
 }
 
+def hlfir_CharTrimOp
+    : hlfir_Op<
+          "char_trim", [DeclareOpInterfaceMethods<MemoryEffectsOpInterface>]> {
+  let summary = "trim character";
+  let description = [{ Trim a character string. }];
+
+  let arguments = (ins AnyScalarCharacterEntity:$chr);
+
+  let results = (outs AnyScalarCharacterExpr);
+
+  let assemblyFormat = [{
+      $chr attr-dict `:` functional-type(operands, results)
+  }];
+
+  let builders = [OpBuilder<(ins "mlir::Value":$chr)>];
+}
+
 def hlfir_AllOp : hlfir_Op<"all", [DeclareOpInterfaceMethods<MemoryEffectsOpInterface>]> {
   let summary = "ALL transformational intrinsic";
   let description = [{

flang/lib/Lower/HlfirIntrinsics.cpp

@@ -159,6 +159,18 @@ class HlfirCharExtremumLowering : public HlfirTransformationalIntrinsic {
   hlfir::CharExtremumPredicate pred;
 };
 
+class HlfirCharTrimLowering : public HlfirTransformationalIntrinsic {
+public:
+  HlfirCharTrimLowering(fir::FirOpBuilder &builder, mlir::Location loc)
+      : HlfirTransformationalIntrinsic(builder, loc) {}
+
+protected:
+  mlir::Value
+  lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
+            const fir::IntrinsicArgumentLoweringRules *argLowering,
+            mlir::Type stmtResultType) override;
+};
+
 class HlfirCShiftLowering : public HlfirTransformationalIntrinsic {
 public:
   using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
@@ -421,6 +433,15 @@ mlir::Value HlfirCharExtremumLowering::lowerImpl(
   return createOp<hlfir::CharExtremumOp>(pred, mlir::ValueRange{operands});
 }
 
+mlir::Value HlfirCharTrimLowering::lowerImpl(
+    const Fortran::lower::PreparedActualArguments &loweredActuals,
+    const fir::IntrinsicArgumentLoweringRules *argLowering,
+    mlir::Type stmtResultType) {
+  auto operands = getOperandVector(loweredActuals, argLowering);
+  assert(operands.size() == 1);
+  return createOp<hlfir::CharTrimOp>(operands[0]);
+}
+
 mlir::Value HlfirCShiftLowering::lowerImpl(
     const Fortran::lower::PreparedActualArguments &loweredActuals,
     const fir::IntrinsicArgumentLoweringRules *argLowering,
@@ -555,6 +576,9 @@ std::optional<hlfir::EntityWithAttributes> Fortran::lower::lowerHlfirIntrinsic(
       return HlfirCharExtremumLowering{builder, loc,
                                        hlfir::CharExtremumPredicate::max}
           .lower(loweredActuals, argLowering, stmtResultType);
+    if (name == "trim")
+      return HlfirCharTrimLowering{builder, loc}.lower(
+          loweredActuals, argLowering, stmtResultType);
   }
   return std::nullopt;
 }

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

@@ -854,6 +854,28 @@ void hlfir::CmpCharOp::getEffects(
   getIntrinsicEffects(getOperation(), effects);
 }
 
+//===----------------------------------------------------------------------===//
+// CharTrimOp
+//===----------------------------------------------------------------------===//
+
+void hlfir::CharTrimOp::build(mlir::OpBuilder &builder,
+                              mlir::OperationState &result, mlir::Value chr) {
+  unsigned kind = getCharacterKind(chr.getType());
+  auto resultType = hlfir::ExprType::get(
+      builder.getContext(), hlfir::ExprType::Shape{},
+      fir::CharacterType::get(builder.getContext(), kind,
+                              fir::CharacterType::unknownLen()),
+      /*polymorphic=*/false);
+  build(builder, result, resultType, chr);
+}
+
+void hlfir::CharTrimOp::getEffects(
+    llvm::SmallVectorImpl<
+        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
+        &effects) {
+  getIntrinsicEffects(getOperation(), effects);
+}
+
 //===----------------------------------------------------------------------===//
 // NumericalReductionOp
 //===----------------------------------------------------------------------===//

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

@@ -585,21 +585,49 @@ class CmpCharOpConversion : public HlfirIntrinsicConversion<hlfir::CmpCharOp> {
   }
 };
 
+class CharTrimOpConversion
+    : public HlfirIntrinsicConversion<hlfir::CharTrimOp> {
+  using HlfirIntrinsicConversion<hlfir::CharTrimOp>::HlfirIntrinsicConversion;
+
+  llvm::LogicalResult
+  matchAndRewrite(hlfir::CharTrimOp trim,
+                  mlir::PatternRewriter &rewriter) const override {
+    fir::FirOpBuilder builder{rewriter, trim.getOperation()};
+    const mlir::Location &loc = trim->getLoc();
+
+    llvm::SmallVector<IntrinsicArgument, 1> inArgs;
+    mlir::Value chr = trim.getChr();
+    inArgs.push_back({chr, chr.getType()});
+
+    auto *argLowering = fir::getIntrinsicArgumentLowering("trim");
+    llvm::SmallVector<fir::ExtendedValue, 1> args =
+        lowerArguments(trim, inArgs, rewriter, argLowering);
+
+    mlir::Type resultType = hlfir::getFortranElementType(trim.getType());
+
+    auto [resultExv, mustBeFreed] =
+        fir::genIntrinsicCall(builder, loc, "trim", resultType, args);
+
+    processReturnValue(trim, resultExv, mustBeFreed, builder, rewriter);
+    return mlir::success();
+  }
+};
+
 class LowerHLFIRIntrinsics
     : public hlfir::impl::LowerHLFIRIntrinsicsBase<LowerHLFIRIntrinsics> {
 public:
   void runOnOperation() override {
     mlir::ModuleOp module = this->getOperation();
     mlir::MLIRContext *context = &getContext();
     mlir::RewritePatternSet patterns(context);
-    patterns.insert<MatmulOpConversion, MatmulTransposeOpConversion,
-                    AllOpConversion, AnyOpConversion, SumOpConversion,
-                    ProductOpConversion, TransposeOpConversion,
-                    CountOpConversion, DotProductOpConversion,
-                    MaxvalOpConversion, MinvalOpConversion, MinlocOpConversion,
-                    MaxlocOpConversion, ArrayShiftOpConversion<hlfir::CShiftOp>,
-                    ArrayShiftOpConversion<hlfir::EOShiftOp>,
-                    ReshapeOpConversion, CmpCharOpConversion>(context);
+    patterns.insert<
+        MatmulOpConversion, MatmulTransposeOpConversion, AllOpConversion,
+        AnyOpConversion, SumOpConversion, ProductOpConversion,
+        TransposeOpConversion, CountOpConversion, DotProductOpConversion,
+        MaxvalOpConversion, MinvalOpConversion, MinlocOpConversion,
+        MaxlocOpConversion, ArrayShiftOpConversion<hlfir::CShiftOp>,
+        ArrayShiftOpConversion<hlfir::EOShiftOp>, ReshapeOpConversion,
+        CmpCharOpConversion, CharTrimOpConversion>(context);
 
     // While conceptually this pass is performing dialect conversion, we use
     // pattern rewrites here instead of dialect conversion because this pass

flang/test/HLFIR/trim.fir

@@ -0,0 +1,42 @@
+// RUN: fir-opt --lower-hlfir-intrinsics %s | FileCheck %s
+
+// CHECK-LABEL:   func.func @_QPtrim_test(
+// CHECK-SAME:      %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "c"}) {
+// CHECK:           %[[VAL_0:.*]] = arith.constant true
+// CHECK:           %[[VAL_2:.*]] = arith.constant 0 : index
+// CHECK:           %[[VAL_3:.*]] = arith.constant 8 : index
+// CHECK:           %[[VAL_4:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
+// CHECK:           %[[VAL_5:.*]] = fir.dummy_scope : !fir.dscope
+// CHECK:           %[[VAL_6:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+// CHECK:           %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]]#0 typeparams %[[VAL_6]]#1 dummy_scope %[[VAL_5]] {uniq_name = "_QFtrim_testEc"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+// CHECK:           %[[VAL_8:.*]] = fir.alloca !fir.char<1,8> {bindc_name = "tc", uniq_name = "_QFtrim_testEtc"}
+// CHECK:           %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] typeparams %[[VAL_3]] {uniq_name = "_QFtrim_testEtc"} : (!fir.ref<!fir.char<1,8>>, index) -> (!fir.ref<!fir.char<1,8>>, !fir.ref<!fir.char<1,8>>)
+// CHECK:           %[[VAL_10:.*]] = fir.embox %[[VAL_7]]#1 typeparams %[[VAL_6]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+// CHECK:           %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.char<1,?>>
+// CHECK:           %[[VAL_12:.*]] = fir.embox %[[VAL_11]] typeparams %[[VAL_2]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.box<!fir.heap<!fir.char<1,?>>>
+// CHECK:           fir.store %[[VAL_12]] to %[[VAL_4]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+// CHECK:           %[[VAL_14:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+// CHECK:           %[[VAL_15:.*]] = fir.convert %[[VAL_10]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+// CHECK:           fir.call @_FortranATrim(%[[VAL_14]], %[[VAL_15]], %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
+// CHECK:           %[[VAL_17:.*]] = fir.load %[[VAL_4]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+// CHECK:           %[[VAL_18:.*]] = fir.box_elesize %[[VAL_17]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index
+// CHECK:           %[[VAL_19:.*]] = fir.box_addr %[[VAL_17]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+// CHECK:           %[[VAL_20:.*]]:2 = hlfir.declare %[[VAL_19]] typeparams %[[VAL_18]] {uniq_name = ".tmp.intrinsic_result"} : (!fir.heap<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.heap<!fir.char<1,?>>)
+// CHECK:           %[[VAL_21:.*]] = hlfir.as_expr %[[VAL_20]]#0 move %[[VAL_0]] : (!fir.boxchar<1>, i1) -> !hlfir.expr<!fir.char<1,?>>
+// CHECK:           hlfir.assign %[[VAL_21]] to %[[VAL_9]]#0 : !hlfir.expr<!fir.char<1,?>>, !fir.ref<!fir.char<1,8>>
+// CHECK:           hlfir.destroy %[[VAL_21]] : !hlfir.expr<!fir.char<1,?>>
+// CHECK:           return
+// CHECK:         }
+
+func.func @_QPtrim_test(%arg0: !fir.boxchar<1> {fir.bindc_name = "c"}) {
+  %0 = fir.dummy_scope : !fir.dscope
+  %1:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+  %2:2 = hlfir.declare %1#0 typeparams %1#1 dummy_scope %0 {uniq_name = "_QFtrim_testEc"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+  %c8 = arith.constant 8 : index
+  %3 = fir.alloca !fir.char<1,8> {bindc_name = "tc", uniq_name = "_QFtrim_testEtc"}
+  %4:2 = hlfir.declare %3 typeparams %c8 {uniq_name = "_QFtrim_testEtc"} : (!fir.ref<!fir.char<1,8>>, index) -> (!fir.ref<!fir.char<1,8>>, !fir.ref<!fir.char<1,8>>)
+  %5 = hlfir.char_trim %2#0 : (!fir.boxchar<1>) -> !hlfir.expr<!fir.char<1,?>>
+  hlfir.assign %5 to %4#0 : !hlfir.expr<!fir.char<1,?>>, !fir.ref<!fir.char<1,8>>
+  hlfir.destroy %5 : !hlfir.expr<!fir.char<1,?>>
+  return
+}

flang/test/Lower/HLFIR/trim.f90

@@ -0,0 +1,32 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+! CHECK-LABEL:  func.func @_QPtrim_test(
+! CHECK-SAME:     %[[VAL_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "c"}) {
+! CHECK:          %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK-NEXT:     %[[VAL_2:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT:     %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]]#0 typeparams %[[VAL_2]]#1 dummy_scope %[[VAL_1]] {uniq_name = "_QFtrim_testEc"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK-NEXT:     %[[VAL_4:.*]] = arith.constant 8 : index
+! CHECK-NEXT:     %[[VAL_5:.*]] = fir.alloca !fir.char<1,8> {bindc_name = "tc", uniq_name = "_QFtrim_testEtc"}
+! CHECK-NEXT:     %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] typeparams %[[VAL_4]] {uniq_name = "_QFtrim_testEtc"} : (!fir.ref<!fir.char<1,8>>, index) -> (!fir.ref<!fir.char<1,8>>, !fir.ref<!fir.char<1,8>>)
+! CHECK-NEXT:     %[[VAL_7:.*]] = hlfir.char_trim %[[VAL_3]]#0 : (!fir.boxchar<1>) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK-NEXT:     hlfir.assign %[[VAL_7]] to %[[VAL_6]]#0 : !hlfir.expr<!fir.char<1,?>>, !fir.ref<!fir.char<1,8>>
+! CHECK-NEXT:     hlfir.destroy %[[VAL_7]] : !hlfir.expr<!fir.char<1,?>>
+! CHECK-NEXT:     return
+! CHECK-NEXT:   }
+subroutine trim_test(c)
+  character(*) :: c
+  character(8) :: tc
+
+  tc = trim(c)
+end subroutine
+
+! Test trim with fixed length character.
+! The length of the returned character type must be unknown.
+! CHECK-LABEL:  func.func @_QPtrim_test2(
+! CHECK:          hlfir.char_trim %{{.*}}#0 : (!fir.ref<!fir.char<1,8>>) -> !hlfir.expr<!fir.char<1,?>>
+subroutine trim_test2(c)
+  character(8) :: c
+  character(8) :: tc
+
+  tc = trim(c)
+end subroutine