From 4736bb1ee7ba7cdd6f30e3a7fe2562393788a8e3 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Mon, 8 Sep 2025 16:08:56 -0700 Subject: [PATCH 1/8] [flang] Define hlfir.index op to represent index intrinsic --- .../include/flang/Optimizer/HLFIR/HLFIROps.td | 21 ++++++++++++++++++ flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp | 22 +++++++++++++++++++ flang/test/HLFIR/invalid.fir | 6 +++++ 3 files changed, 49 insertions(+) diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td index 9a22b2dc2f58d..90512586a6520 100644 --- a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td +++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td @@ -394,6 +394,27 @@ def hlfir_CharTrimOp let builders = [OpBuilder<(ins "mlir::Value":$chr)>]; } +def hlfir_IndexOp + : hlfir_Op<"index", [DeclareOpInterfaceMethods]> { + let summary = "index transformational intrinsic"; + let description = [{ + Search for a substring position within a string, optionally backward + if back is set to true. + }]; + + let arguments = (ins AnyScalarCharacterEntity:$substr, + AnyScalarCharacterEntity:$str, + Optional>:$back); + + let results = (outs AnyIntegerType); + + let assemblyFormat = [{ + $substr `in` $str (`back` $back^)? attr-dict `:` functional-type(operands, results) + }]; + + let hasVerifier = 1; +} + def hlfir_AllOp : hlfir_Op<"all", [DeclareOpInterfaceMethods]> { let summary = "ALL transformational intrinsic"; let description = [{ diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp index ffec4ffbb3b80..1a63b1bea3177 100644 --- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp +++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp @@ -878,6 +878,28 @@ void hlfir::CharTrimOp::getEffects( getIntrinsicEffects(getOperation(), effects); } +//===----------------------------------------------------------------------===// +// IndexOp +//===----------------------------------------------------------------------===// + +llvm::LogicalResult hlfir::IndexOp::verify() { + mlir::Value substr = getSubstr(); + mlir::Value str = getStr(); + + unsigned charKind = getCharacterKind(substr.getType()); + if (charKind != getCharacterKind(str.getType())) + return emitOpError("character arguments must have the same KIND"); + + return mlir::success(); +} + +void hlfir::IndexOp::getEffects( + llvm::SmallVectorImpl< + mlir::SideEffects::EffectInstance> + &effects) { + getIntrinsicEffects(getOperation(), effects); +} + //===----------------------------------------------------------------------===// // NumericalReductionOp //===----------------------------------------------------------------------===// diff --git a/flang/test/HLFIR/invalid.fir b/flang/test/HLFIR/invalid.fir index ea0f3c6539c7d..887113959429c 100644 --- a/flang/test/HLFIR/invalid.fir +++ b/flang/test/HLFIR/invalid.fir @@ -307,6 +307,12 @@ func.func @bad_cmpchar_2(%arg0: !fir.ref>, %arg1: !fir.ref>, !fir.ref>) -> i1 } +// ----- +func.func @bad_index_1(%arg0: !fir.ref>, %arg1: !fir.ref>) { + // expected-error@+1 {{'hlfir.index' op character arguments must have the same KIND}} + %0 = hlfir.index %arg0 in %arg1 : (!fir.ref>, !fir.ref>) -> i32 +} + // ----- func.func @bad_any1(%arg0: !hlfir.expr>) { // expected-error@+1 {{'hlfir.any' op result must have the same element type as MASK argument}} From 10339d2e5f3d365749a66d752e27e56d3f4ddd93 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Mon, 8 Sep 2025 16:10:28 -0700 Subject: [PATCH 2/8] [flang] Lower index intrinsic call into hlfir.index op --- flang/lib/Lower/ConvertCall.cpp | 7 +- flang/lib/Lower/HlfirIntrinsics.cpp | 45 ++++++++++ flang/test/Lower/HLFIR/index.f90 | 120 +++++++++++++++++++++++++++ flang/test/Lower/volatile-string.f90 | 10 +-- 4 files changed, 173 insertions(+), 9 deletions(-) create mode 100644 flang/test/Lower/HLFIR/index.f90 diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index cf8458f716ae5..b20785d3609e6 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -2193,10 +2193,15 @@ static std::optional genHLFIRIntrinsicRefCore( const std::string intrinsicName = callContext.getProcedureName(); const fir::IntrinsicArgumentLoweringRules *argLowering = intrinsicEntry.getArgumentLoweringRules(); + mlir::Type resultType = + callContext.isElementalProcWithArrayArgs() + ? hlfir::getFortranElementType(*callContext.resultType) + : *callContext.resultType; + std::optional res = Fortran::lower::lowerHlfirIntrinsic(builder, loc, intrinsicName, loweredActuals, argLowering, - *callContext.resultType); + resultType); if (res) return res; } diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp index b9731e993db8f..d4c95ae539e40 100644 --- a/flang/lib/Lower/HlfirIntrinsics.cpp +++ b/flang/lib/Lower/HlfirIntrinsics.cpp @@ -204,6 +204,17 @@ class HlfirReshapeLowering : public HlfirTransformationalIntrinsic { mlir::Type stmtResultType) override; }; +class HlfirIndexLowering : public HlfirTransformationalIntrinsic { +public: + using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic; + +protected: + mlir::Value + lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals, + const fir::IntrinsicArgumentLoweringRules *argLowering, + mlir::Type stmtResultType) override; +}; + } // namespace mlir::Value HlfirTransformationalIntrinsic::loadBoxAddress( @@ -513,6 +524,36 @@ mlir::Value HlfirReshapeLowering::lowerImpl( operands[2], operands[3]); } +mlir::Value HlfirIndexLowering::lowerImpl( + const Fortran::lower::PreparedActualArguments &loweredActuals, + const fir::IntrinsicArgumentLoweringRules *argLowering, + mlir::Type stmtResultType) { + auto operands = getOperandVector(loweredActuals, argLowering); + assert(operands.size() == 4); + mlir::Value substr = operands[1]; + mlir::Value str = operands[0]; + mlir::Value back = operands[2]; + mlir::Value kind = operands[3]; + + mlir::Type resultType; + if (kind) { + auto kindCst = fir::getIntIfConstant(kind); + assert(kindCst && + "kind argument of index must be an integer constant expression"); + unsigned bits = builder.getKindMap().getIntegerBitsize(*kindCst); + assert(bits != 0 && "failed to convert kind to integer bitsize"); + resultType = builder.getIntegerType(bits); + } else { + resultType = builder.getDefaultIntegerType(); + } + mlir::Value result = + createOp(resultType, substr, str, back); + + if (resultType != stmtResultType) + return builder.createConvert(loc, stmtResultType, result); + return result; +} + std::optional Fortran::lower::lowerHlfirIntrinsic( fir::FirOpBuilder &builder, mlir::Location loc, const std::string &name, const Fortran::lower::PreparedActualArguments &loweredActuals, @@ -567,6 +608,10 @@ std::optional Fortran::lower::lowerHlfirIntrinsic( if (name == "reshape") return HlfirReshapeLowering{builder, loc}.lower(loweredActuals, argLowering, stmtResultType); + if (name == "index") + return HlfirIndexLowering{builder, loc}.lower(loweredActuals, argLowering, + stmtResultType); + if (mlir::isa(stmtResultType)) { if (name == "min") return HlfirCharExtremumLowering{builder, loc, diff --git a/flang/test/Lower/HLFIR/index.f90 b/flang/test/Lower/HLFIR/index.f90 new file mode 100644 index 0000000000000..a2c2e071f1432 --- /dev/null +++ b/flang/test/Lower/HLFIR/index.f90 @@ -0,0 +1,120 @@ +! Test lowering of index intrinsic to HLFIR +! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s + +subroutine t(s) + implicit none + character(len=*, kind=1):: s + integer :: n + n = index(s,'this') +end subroutine t +! CHECK-LABEL: func.func @_QPt( +! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFtEn"} +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtEn"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_3:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]]#0 typeparams %[[VAL_3]]#1 dummy_scope %[[VAL_0]] {uniq_name = "_QFtEs"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref>) +! CHECK: %[[VAL_5:.*]] = fir.address_of(@_QQclX74686973) : !fir.ref> +! CHECK: %[[VAL_6:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_5]] typeparams %[[VAL_6]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QQclX74686973"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_8:.*]] = hlfir.index %[[VAL_7]]#0 in %[[VAL_4]]#0 : (!fir.ref>, !fir.boxchar<1>) -> i32 +! CHECK: hlfir.assign %[[VAL_8]] to %[[VAL_2]]#0 : i32, !fir.ref + +subroutine t1(s, b) + implicit none + character(len=*, kind=1):: s + logical :: b + integer :: n + n = index(s,'this', back = b) +end subroutine t1 +! CHECK-LABEL: func.func @_QPt1( +! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "s"}, +! CHECK-SAME: %[[ARG1:.*]]: !fir.ref> {fir.bindc_name = "b"}) { +! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %[[VAL_0]] {uniq_name = "_QFt1Eb"} : (!fir.ref>, !fir.dscope) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFt1En"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QFt1En"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_4:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]]#0 typeparams %[[VAL_4]]#1 dummy_scope %[[VAL_0]] {uniq_name = "_QFt1Es"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref>) +! CHECK: %[[VAL_6:.*]] = fir.address_of(@_QQclX74686973) : !fir.ref> +! CHECK: %[[VAL_7:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_6]] typeparams %[[VAL_7]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QQclX74686973"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref> +! CHECK: %[[VAL_10:.*]] = hlfir.index %[[VAL_8]]#0 in %[[VAL_5]]#0 back %[[VAL_9]] : (!fir.ref>, !fir.boxchar<1>, !fir.logical<4>) -> i32 +! CHECK: hlfir.assign %[[VAL_10]] to %[[VAL_3]]#0 : i32, !fir.ref + + +subroutine t2(s, c) + implicit none + character(len=*, kind=2):: s, c + integer :: n + n = index(s,c,back=.false.) +end subroutine t2 +! CHECK-LABEL: func.func @_QPt2( +! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<2> {fir.bindc_name = "s"}, +! CHECK-SAME: %[[ARG1:.*]]: !fir.boxchar<2> {fir.bindc_name = "c"}) { +! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[ARG1]] : (!fir.boxchar<2>) -> (!fir.ref>, index) +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 dummy_scope %[[VAL_0]] {uniq_name = "_QFt2Ec"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<2>, !fir.ref>) +! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFt2En"} +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = "_QFt2En"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_5:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<2>) -> (!fir.ref>, index) +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]]#0 typeparams %[[VAL_5]]#1 dummy_scope %[[VAL_0]] {uniq_name = "_QFt2Es"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<2>, !fir.ref>) +! CHECK: %[[VAL_7:.*]] = arith.constant false +! CHECK: %[[VAL_8:.*]] = hlfir.index %[[VAL_2]]#0 in %[[VAL_6]]#0 back %[[VAL_7]] : (!fir.boxchar<2>, !fir.boxchar<2>, i1) -> i32 +! CHECK: hlfir.assign %[[VAL_8]] to %[[VAL_4]]#0 : i32, !fir.ref + +subroutine t3(s, c) + implicit none + character(len=*, kind=4):: s, c + integer :: n + n = index(s,c,back=.true., kind=1) +end subroutine t3 +! CHECK-LABEL: func.func @_QPt3( +! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<4> {fir.bindc_name = "s"}, +! CHECK-SAME: %[[ARG1:.*]]: !fir.boxchar<4> {fir.bindc_name = "c"}) { +! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[ARG1]] : (!fir.boxchar<4>) -> (!fir.ref>, index) +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 dummy_scope %[[VAL_0]] {uniq_name = "_QFt3Ec"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<4>, !fir.ref>) +! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFt3En"} +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = "_QFt3En"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_5:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<4>) -> (!fir.ref>, index) +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]]#0 typeparams %[[VAL_5]]#1 dummy_scope %[[VAL_0]] {uniq_name = "_QFt3Es"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<4>, !fir.ref>) +! CHECK: %[[VAL_7:.*]] = arith.constant true +! CHECK: %[[VAL_8:.*]] = hlfir.index %[[VAL_2]]#0 in %[[VAL_6]]#0 back %[[VAL_7]] : (!fir.boxchar<4>, !fir.boxchar<4>, i1) -> i8 +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i8) -> i32 +! CHECK: hlfir.assign %[[VAL_9]] to %[[VAL_4]]#0 : i32, !fir.ref + +subroutine t4(c1, c2) + implicit none + character(*) :: c1(3) + character(*) :: c2(3) + integer(kind=1) :: n(3) + n = index(c1, c2, kind=1) +end subroutine t4 +! CHECK-LABEL: func.func @_QPt4( +! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "c1"}, +! CHECK-SAME: %[[ARG1:.*]]: !fir.boxchar<1> {fir.bindc_name = "c2"}) { +! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_3:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_2]](%[[VAL_4]]) typeparams %[[VAL_1]]#1 dummy_scope %[[VAL_0]] {uniq_name = "_QFt4Ec1"} : (!fir.ref>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box>>, !fir.ref>>) +! CHECK: %[[VAL_6:.*]]:2 = fir.unboxchar %[[ARG1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]]#0 : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_8:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_7]](%[[VAL_9]]) typeparams %[[VAL_6]]#1 dummy_scope %[[VAL_0]] {uniq_name = "_QFt4Ec2"} : (!fir.ref>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box>>, !fir.ref>>) +! CHECK: %[[VAL_11:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_12:.*]] = fir.alloca !fir.array<3xi8> {bindc_name = "n", uniq_name = "_QFt4En"} +! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_12]](%[[VAL_13]]) {uniq_name = "_QFt4En"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_15:.*]] = hlfir.elemental %[[VAL_4]] unordered : (!fir.shape<1>) -> !hlfir.expr<3xi8> { +! CHECK: ^bb0(%[[VAL_16:.*]]: index): +! CHECK: %[[VAL_17:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_16]]) typeparams %[[VAL_1]]#1 : (!fir.box>>, index, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_18:.*]] = hlfir.designate %[[VAL_10]]#0 (%[[VAL_16]]) typeparams %[[VAL_6]]#1 : (!fir.box>>, index, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_19:.*]] = hlfir.index %[[VAL_18]] in %[[VAL_17]] : (!fir.boxchar<1>, !fir.boxchar<1>) -> i8 +! CHECK: hlfir.yield_element %[[VAL_19]] : i8 +! CHECK: } +! CHECK: hlfir.assign %[[VAL_15]] to %[[VAL_14]]#0 : !hlfir.expr<3xi8>, !fir.ref> diff --git a/flang/test/Lower/volatile-string.f90 b/flang/test/Lower/volatile-string.f90 index 38c29b477169c..54f22af5ca26b 100644 --- a/flang/test/Lower/volatile-string.f90 +++ b/flang/test/Lower/volatile-string.f90 @@ -25,7 +25,6 @@ subroutine assign_different_length(string) ! CHECK: %[[VAL_0:.*]] = arith.constant true ! CHECK: %[[VAL_1:.*]] = arith.constant 10 : i32 ! CHECK: %[[VAL_2:.*]] = arith.constant 3 : i32 -! CHECK: %[[VAL_3:.*]] = arith.constant false ! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index ! CHECK: %[[VAL_5:.*]] = arith.constant 3 : index ! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.box>> @@ -43,13 +42,8 @@ subroutine assign_different_length(string) ! CHECK: fir.call @_QFPassign_different_length(%[[VAL_16]]) fastmath : (!fir.boxchar<1>) -> () ! CHECK: %[[VAL_17:.*]] = fir.address_of(@_QQclX6F) : !fir.ref> ! CHECK: %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_17]] typeparams %[[VAL_4]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QQclX6F"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) -! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_15]] : (!fir.ref>) -> !fir.ref -! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_5]] : (index) -> i64 -! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_18]]#0 : (!fir.ref>) -> !fir.ref -! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_4]] : (index) -> i64 -! CHECK: %[[VAL_23:.*]] = fir.call @_FortranAIndex1(%[[VAL_19]], %[[VAL_20]], %[[VAL_21]], %[[VAL_22]], %[[VAL_3]]) fastmath : (!fir.ref, i64, !fir.ref, i64, i1) -> i64 -! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (i64) -> i32 -! CHECK: hlfir.assign %[[VAL_24]] to %[[VAL_9]]#0 : i32, !fir.ref +! CHECK: %[[VAL_21:.*]] = hlfir.index %[[VAL_18]]#0 in %[[VAL_14]]#0 : (!fir.ref>, !fir.ref, volatile>) -> i32 +! CHECK: hlfir.assign %[[VAL_21]] to %[[VAL_9]]#0 : i32, !fir.ref ! CHECK: hlfir.assign %[[VAL_2]] to %[[VAL_9]]#0 : i32, !fir.ref ! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_14]]#0 : (!fir.ref, volatile>) -> !fir.box, volatile> ! CHECK: %[[VAL_26:.*]] = fir.zero_bits !fir.heap> From 264f137e2351cf2b1c3219ae42e18ff236bf964b Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Mon, 8 Sep 2025 16:11:57 -0700 Subject: [PATCH 3/8] Additional fix for lowering arguments for a transformational intrinsic hlfir op. Lowering of 'index' just revealed a problem in a case when an intrinsic argument turns out coming from a dynamically optional subroutine argument. --- flang/include/flang/Lower/HlfirIntrinsics.h | 5 ++ flang/lib/Lower/ConvertCall.cpp | 32 ++++++++++ flang/lib/Lower/HlfirIntrinsics.cpp | 66 +++++++++------------ flang/test/Lower/HLFIR/index.f90 | 42 +++++++++++++ 4 files changed, 106 insertions(+), 39 deletions(-) diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h index f01f1c7dcd9bb..dd31b20a7fdf3 100644 --- a/flang/include/flang/Lower/HlfirIntrinsics.h +++ b/flang/include/flang/Lower/HlfirIntrinsics.h @@ -58,6 +58,11 @@ struct PreparedActualArgument { /// call, the current element value will be returned. hlfir::Entity getActual(mlir::Location loc, fir::FirOpBuilder &builder) const; + /// Lower the actual argument that needs to be handled as dynamically + /// optional Value. + mlir::Value getOptionalValue(mlir::Location loc, + fir::FirOpBuilder &builder) const; + void derefPointersAndAllocatables(mlir::Location loc, fir::FirOpBuilder &builder) { if (auto *actualEntity = std::get_if(&actual)) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index b20785d3609e6..ac41f63edbb49 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -3044,6 +3044,38 @@ hlfir::Entity Fortran::lower::PreparedActualArgument::getActual( return hlfir::Entity{addr}; } +mlir::Value Fortran::lower::PreparedActualArgument::getOptionalValue( + mlir::Location loc, fir::FirOpBuilder &builder) const { + mlir::Type eleType; + if (auto *actualEntity = std::get_if(&actual)) + eleType = hlfir::getFortranElementType(actualEntity->getType()); + else + TODO(loc, "compute element type from hlfir::ElementalAddrOp"); + + // For an elemental call, getActual() may produce + // a designator denoting the array element to be passed + // to the subprogram. If the actual array is dynamically + // optional the designator must be generated under + // isPresent check (see also genIntrinsicRefCore). + return builder + .genIfOp(loc, {eleType}, getIsPresent(), + /*withElseRegion=*/true) + .genThen([&]() { + hlfir::Entity actual = getActual(loc, builder); + assert(eleType == actual.getFortranElementType() && + "result type mismatch in genOptionalValue"); + assert(actual.isScalar() && fir::isa_trivial(eleType) && + "must be a numerical or logical scalar"); + hlfir::Entity val = hlfir::loadTrivialScalar(loc, builder, actual); + fir::ResultOp::create(builder, loc, val); + }) + .genElse([&]() { + mlir::Value zero = fir::factory::createZeroValue(builder, loc, eleType); + fir::ResultOp::create(builder, loc, zero); + }) + .getResults()[0]; +} + bool Fortran::lower::isIntrinsicModuleProcRef( const Fortran::evaluate::ProcedureRef &procRef) { const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol(); diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp index d4c95ae539e40..bda876b34e0f9 100644 --- a/flang/lib/Lower/HlfirIntrinsics.cpp +++ b/flang/lib/Lower/HlfirIntrinsics.cpp @@ -69,6 +69,9 @@ class HlfirTransformationalIntrinsic { mlir::Value loadBoxAddress( const std::optional &arg); + mlir::Value loadTrivialScalar( + const std::optional &arg); + void addCleanup(std::optional cleanup) { if (cleanup) cleanupFns.emplace_back(std::move(*cleanup)); @@ -250,29 +253,10 @@ mlir::Value HlfirTransformationalIntrinsic::loadBoxAddress( return boxOrAbsent; } -static mlir::Value loadOptionalValue( - mlir::Location loc, fir::FirOpBuilder &builder, - const std::optional &arg, - hlfir::Entity actual) { - if (!arg->handleDynamicOptional()) - return hlfir::loadTrivialScalar(loc, builder, actual); - - mlir::Value isPresent = arg->getIsPresent(); - mlir::Type eleType = hlfir::getFortranElementType(actual.getType()); - return builder - .genIfOp(loc, {eleType}, isPresent, - /*withElseRegion=*/true) - .genThen([&]() { - assert(actual.isScalar() && fir::isa_trivial(eleType) && - "must be a numerical or logical scalar"); - hlfir::Entity val = hlfir::loadTrivialScalar(loc, builder, actual); - fir::ResultOp::create(builder, loc, val); - }) - .genElse([&]() { - mlir::Value zero = fir::factory::createZeroValue(builder, loc, eleType); - fir::ResultOp::create(builder, loc, zero); - }) - .getResults()[0]; +mlir::Value HlfirTransformationalIntrinsic::loadTrivialScalar( + const std::optional &arg) { + hlfir::Entity actual = arg->getActual(loc, builder); + return hlfir::loadTrivialScalar(loc, builder, actual); } llvm::SmallVector HlfirTransformationalIntrinsic::getOperandVector( @@ -288,29 +272,33 @@ llvm::SmallVector HlfirTransformationalIntrinsic::getOperandVector( operands.emplace_back(); continue; } - hlfir::Entity actual = arg->getActual(loc, builder); mlir::Value valArg; - if (!argLowering) { - valArg = hlfir::loadTrivialScalar(loc, builder, actual); - } else { - fir::ArgLoweringRule argRules = - fir::lowerIntrinsicArgumentAs(*argLowering, i); - if (argRules.lowerAs == fir::LowerIntrinsicArgAs::Box) - valArg = loadBoxAddress(arg); - else if (!argRules.handleDynamicOptional && - argRules.lowerAs != fir::LowerIntrinsicArgAs::Inquired) - valArg = hlfir::derefPointersAndAllocatables(loc, builder, actual); - else if (argRules.handleDynamicOptional && - argRules.lowerAs == fir::LowerIntrinsicArgAs::Value) - valArg = loadOptionalValue(loc, builder, arg, actual); - else if (argRules.handleDynamicOptional) + valArg = loadTrivialScalar(arg); + operands.emplace_back(valArg); + continue; + } + fir::ArgLoweringRule argRules = + fir::lowerIntrinsicArgumentAs(*argLowering, i); + if (argRules.lowerAs == fir::LowerIntrinsicArgAs::Box) { + valArg = loadBoxAddress(arg); + } else if (argRules.handleDynamicOptional) { + if (argRules.lowerAs == fir::LowerIntrinsicArgAs::Value) { + if (arg->handleDynamicOptional()) + valArg = arg->getOptionalValue(loc, builder); + else + valArg = loadTrivialScalar(arg); + } else { TODO(loc, "hlfir transformational intrinsic dynamically optional " "argument without box lowering"); + } + } else { + hlfir::Entity actual = arg->getActual(loc, builder); + if (argRules.lowerAs != fir::LowerIntrinsicArgAs::Inquired) + valArg = hlfir::derefPointersAndAllocatables(loc, builder, actual); else valArg = actual.getBase(); } - operands.emplace_back(valArg); } return operands; diff --git a/flang/test/Lower/HLFIR/index.f90 b/flang/test/Lower/HLFIR/index.f90 index a2c2e071f1432..a36027f4cf06f 100644 --- a/flang/test/Lower/HLFIR/index.f90 +++ b/flang/test/Lower/HLFIR/index.f90 @@ -118,3 +118,45 @@ end subroutine t4 ! CHECK: hlfir.yield_element %[[VAL_19]] : i8 ! CHECK: } ! CHECK: hlfir.assign %[[VAL_15]] to %[[VAL_14]]#0 : !hlfir.expr<3xi8>, !fir.ref> + +! index is called as elemental with the 3d argument optional for 'sub' (^bb0 block) +! Make sure that the argument is actually accessed (hlfir.designate) only +! under fir.if that depends on fir.is_present check. +program test + call sub('abcdefgc',(/'c','c'/)) +contains + subroutine sub(a,b,c) + character(*) a,b(:) + logical,optional :: c(:) + print *,index(a,b,c) + end subroutine +end program test +! CHECK-LABEL: func.func private @_QFPsub( +! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[ARG1:.*]]: !fir.box>> {fir.bindc_name = "b"}, +! CHECK-SAME: %[[ARG2:.*]]: !fir.box>> {fir.bindc_name = "c", fir.optional}) attributes {fir.host_symbol = @_QQmain, llvm.linkage = #llvm.linkage} { +! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 dummy_scope %[[VAL_0]] {uniq_name = "_QFFsubEa"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref>) +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %[[VAL_0]] {uniq_name = "_QFFsubEb"} : (!fir.box>>, !fir.dscope) -> (!fir.box>>, !fir.box>>) +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[ARG2]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFFsubEc"} : (!fir.box>>, !fir.dscope) -> (!fir.box>>, !fir.box>>) +! CHECK: %[[VAL_10:.*]] = fir.is_present %[[VAL_4]]#0 : (!fir.box>>) -> i1 +! CHECK: %[[VAL_11:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_12:.*]]:3 = fir.box_dims %[[VAL_3]]#0, %[[VAL_11]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_12]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_14:.*]] = hlfir.elemental %[[VAL_13]] unordered : (!fir.shape<1>) -> !hlfir.expr { +! CHECK: ^bb0(%[[VAL_15:.*]]: index): +! CHECK: %[[VAL_16:.*]] = fir.box_elesize %[[VAL_3]]#1 : (!fir.box>>) -> index +! CHECK: %[[VAL_17:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_15]]) typeparams %[[VAL_16]] : (!fir.box>>, index, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_18:.*]] = fir.if %[[VAL_10]] -> (!fir.logical<4>) { +! CHECK: %[[VAL_19:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_15]]) : (!fir.box>>, index) -> !fir.ref> +! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_19]] : !fir.ref> +! CHECK: fir.result %[[VAL_20]] : !fir.logical<4> +! CHECK: } else { +! CHECK: %[[VAL_21:.*]] = arith.constant false +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i1) -> !fir.logical<4> +! CHECK: fir.result %[[VAL_22]] : !fir.logical<4> +! CHECK: } +! CHECK: %[[VAL_23:.*]] = hlfir.index %[[VAL_17]] in %[[VAL_2]]#0 back %[[VAL_18]] : (!fir.boxchar<1>, !fir.boxchar<1>, !fir.logical<4>) -> i32 +! CHECK: hlfir.yield_element %[[VAL_23]] : i32 +! CHECK: } From 031d800e757ef525c3dd6cbc94a3476748fda99e Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Mon, 8 Sep 2025 16:13:44 -0700 Subject: [PATCH 4/8] [flang] Implement naive lowering of hlfir.index into a runtime call --- .../Optimizer/Builder/Runtime/Character.h | 8 + .../Optimizer/Builder/Runtime/Character.cpp | 38 ++-- .../HLFIR/Transforms/LowerHLFIRIntrinsics.cpp | 41 +++- flang/test/HLFIR/index-lowering.fir | 198 ++++++++++++++++++ 4 files changed, 272 insertions(+), 13 deletions(-) create mode 100644 flang/test/HLFIR/index-lowering.fir diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Character.h b/flang/include/flang/Optimizer/Builder/Runtime/Character.h index d1c521de94438..261ac348a4024 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Character.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Character.h @@ -65,6 +65,14 @@ mlir::Value genIndex(fir::FirOpBuilder &builder, mlir::Location loc, int kind, mlir::Value substringBase, mlir::Value substringLen, mlir::Value back); +/// Generate call to INDEX runtime. +/// This calls the simple runtime entry points based on the KIND of the string. +/// A version of interface taking a `boxchar` for string and substring. +/// Uses no-descriptors flow. +mlir::Value genIndex(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &str, + const fir::ExtendedValue &substr, mlir::Value back); + /// Generate call to INDEX runtime. /// This calls the descriptor based runtime call implementation for the index /// intrinsic. diff --git a/flang/lib/Optimizer/Builder/Runtime/Character.cpp b/flang/lib/Optimizer/Builder/Runtime/Character.cpp index 57fb0cccf6863..540ecba299dc3 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Character.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Character.cpp @@ -119,23 +119,23 @@ fir::runtime::genCharCompare(fir::FirOpBuilder &builder, mlir::Location loc, return mlir::arith::CmpIOp::create(builder, loc, cmp, tri, zero); } +static mlir::Value allocateIfNotInMemory(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value base) { + if (fir::isa_ref_type(base.getType())) + return base; + auto mem = + fir::AllocaOp::create(builder, loc, base.getType(), /*pinned=*/false); + fir::StoreOp::create(builder, loc, base, mem); + return mem; +} + mlir::Value fir::runtime::genCharCompare(fir::FirOpBuilder &builder, mlir::Location loc, mlir::arith::CmpIPredicate cmp, const fir::ExtendedValue &lhs, const fir::ExtendedValue &rhs) { - if (lhs.getBoxOf() || rhs.getBoxOf()) - TODO(loc, "character compare from descriptors"); - auto allocateIfNotInMemory = [&](mlir::Value base) -> mlir::Value { - if (fir::isa_ref_type(base.getType())) - return base; - auto mem = - fir::AllocaOp::create(builder, loc, base.getType(), /*pinned=*/false); - fir::StoreOp::create(builder, loc, base, mem); - return mem; - }; - auto lhsBuffer = allocateIfNotInMemory(fir::getBase(lhs)); - auto rhsBuffer = allocateIfNotInMemory(fir::getBase(rhs)); + auto lhsBuffer = allocateIfNotInMemory(builder, loc, fir::getBase(lhs)); + auto rhsBuffer = allocateIfNotInMemory(builder, loc, fir::getBase(rhs)); return genCharCompare(builder, loc, cmp, lhsBuffer, fir::getLen(lhs), rhsBuffer, fir::getLen(rhs)); } @@ -168,6 +168,20 @@ mlir::Value fir::runtime::genIndex(fir::FirOpBuilder &builder, return fir::CallOp::create(builder, loc, indexFunc, args).getResult(0); } +mlir::Value fir::runtime::genIndex(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &str, + const fir::ExtendedValue &substr, + mlir::Value back) { + assert(!substr.getBoxOf() && !str.getBoxOf() && + "shall use genIndexDescriptor version"); + auto strBuffer = allocateIfNotInMemory(builder, loc, fir::getBase(str)); + auto substrBuffer = allocateIfNotInMemory(builder, loc, fir::getBase(substr)); + int kind = discoverKind(strBuffer.getType()); + return genIndex(builder, loc, kind, strBuffer, fir::getLen(str), substrBuffer, + fir::getLen(substr), back); +} + void fir::runtime::genIndexDescriptor(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value resultBox, mlir::Value stringBox, diff --git a/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp b/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp index a913cfadcefc2..4239e579ae70b 100644 --- a/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp +++ b/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp @@ -613,6 +613,45 @@ class CharTrimOpConversion } }; +class IndexOpConversion : public HlfirIntrinsicConversion { + using HlfirIntrinsicConversion::HlfirIntrinsicConversion; + + llvm::LogicalResult + matchAndRewrite(hlfir::IndexOp op, + mlir::PatternRewriter &rewriter) const override { + fir::FirOpBuilder builder{rewriter, op.getOperation()}; + const mlir::Location &loc = op->getLoc(); + hlfir::Entity substr{op.getSubstr()}; + hlfir::Entity str{op.getStr()}; + + auto [substrExv, substrCleanUp] = + hlfir::translateToExtendedValue(loc, builder, substr); + auto [strExv, strCleanUp] = + hlfir::translateToExtendedValue(loc, builder, str); + + mlir::Value back = op.getBack(); + if (!back) + back = builder.createBool(loc, false); + + mlir::Value result = + fir::runtime::genIndex(builder, loc, strExv, substrExv, back); + result = builder.createConvert(loc, op.getType(), result); + if (strCleanUp || substrCleanUp) { + mlir::OpBuilder::InsertionGuard guard(builder); + builder.setInsertionPointAfter(op); + if (strCleanUp) + (*strCleanUp)(); + if (substrCleanUp) + (*substrCleanUp)(); + } + auto resultEntity = hlfir::EntityWithAttributes{result}; + + processReturnValue(op, resultEntity, /*mustBeFreed=*/false, builder, + rewriter); + return mlir::success(); + } +}; + class LowerHLFIRIntrinsics : public hlfir::impl::LowerHLFIRIntrinsicsBase { public: @@ -627,7 +666,7 @@ class LowerHLFIRIntrinsics MaxvalOpConversion, MinvalOpConversion, MinlocOpConversion, MaxlocOpConversion, ArrayShiftOpConversion, ArrayShiftOpConversion, ReshapeOpConversion, - CmpCharOpConversion, CharTrimOpConversion>(context); + CmpCharOpConversion, CharTrimOpConversion, IndexOpConversion>(context); // While conceptually this pass is performing dialect conversion, we use // pattern rewrites here instead of dialect conversion because this pass diff --git a/flang/test/HLFIR/index-lowering.fir b/flang/test/HLFIR/index-lowering.fir new file mode 100644 index 0000000000000..3857324563372 --- /dev/null +++ b/flang/test/HLFIR/index-lowering.fir @@ -0,0 +1,198 @@ +// Test hlfir.cmpchar operation lowering to a fir runtime call +// RUN: fir-opt %s -lower-hlfir-intrinsics | FileCheck %s + +func.func @_QPt(%arg0: !fir.boxchar<1> {fir.bindc_name = "s"}) { +// CHECK-LABEL: func.func @_QPt( +// CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "s"}) { +// CHECK: %[[VAL_0:.*]] = arith.constant false +// CHECK: %[[VAL_1:.*]] = arith.constant 4 : index +// CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +// CHECK: %[[VAL_3:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFtEn"} +// CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = "_QFtEn"} : (!fir.ref) -> (!fir.ref, !fir.ref) +// CHECK: %[[VAL_5:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +// CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]]#0 typeparams %[[VAL_5]]#1 dummy_scope %[[VAL_2]] {uniq_name = "_QFtEs"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref>) +// CHECK: %[[VAL_7:.*]] = fir.address_of(@_QQclX74686973) : !fir.ref> +// CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7]] typeparams %[[VAL_1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QQclX74686973"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %0 = fir.dummy_scope : !fir.dscope + %1 = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFtEn"} + %2:2 = hlfir.declare %1 {uniq_name = "_QFtEn"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %3:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) + %4:2 = hlfir.declare %3#0 typeparams %3#1 dummy_scope %0 {uniq_name = "_QFtEs"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref>) + %5 = fir.address_of(@_QQclX74686973) : !fir.ref> + %c4 = arith.constant 4 : index + %6:2 = hlfir.declare %5 typeparams %c4 {fortran_attrs = #fir.var_attrs, uniq_name = "_QQclX74686973"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %7 = hlfir.index %6#0 in %4#0 : (!fir.ref>, !fir.boxchar<1>) -> i32 +// CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_6]]#1 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_5]]#1 : (index) -> i64 +// CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_8]]#0 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_1]] : (index) -> i64 +// CHECK: %[[VAL_13:.*]] = fir.call @_FortranAIndex1(%[[VAL_9]], %[[VAL_10]], %[[VAL_11]], %[[VAL_12]], %[[VAL_0]]) : (!fir.ref, i64, !fir.ref, i64, i1) -> i64 +// CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i64) -> i32 +// CHECK: hlfir.assign %[[VAL_14]] to %[[VAL_4]]#0 : i32, !fir.ref + hlfir.assign %7 to %2#0 : i32, !fir.ref + return +} + +func.func @_QPt1(%arg0: !fir.boxchar<1> {fir.bindc_name = "s"}, %arg1: !fir.ref> {fir.bindc_name = "b"}) { +// CHECK-LABEL: func.func @_QPt1( +// CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "s"}, +// CHECK-SAME: %[[ARG1:.*]]: !fir.ref> {fir.bindc_name = "b"}) { +// CHECK: %[[VAL_0:.*]] = arith.constant 4 : index +// CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope +// CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %[[VAL_1]] {uniq_name = "_QFt1Eb"} : (!fir.ref>, !fir.dscope) -> (!fir.ref>, !fir.ref>) +// CHECK: %[[VAL_3:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFt1En"} +// CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = "_QFt1En"} : (!fir.ref) -> (!fir.ref, !fir.ref) +// CHECK: %[[VAL_5:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +// CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]]#0 typeparams %[[VAL_5]]#1 dummy_scope %[[VAL_1]] {uniq_name = "_QFt1Es"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref>) +// CHECK: %[[VAL_7:.*]] = fir.address_of(@_QQclX74686973) : !fir.ref> +// CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7]] typeparams %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QQclX74686973"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +// CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref> + %0 = fir.dummy_scope : !fir.dscope + %1:2 = hlfir.declare %arg1 dummy_scope %0 {uniq_name = "_QFt1Eb"} : (!fir.ref>, !fir.dscope) -> (!fir.ref>, !fir.ref>) + %2 = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFt1En"} + %3:2 = hlfir.declare %2 {uniq_name = "_QFt1En"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %4:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) + %5:2 = hlfir.declare %4#0 typeparams %4#1 dummy_scope %0 {uniq_name = "_QFt1Es"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref>) + %6 = fir.address_of(@_QQclX74686973) : !fir.ref> + %c4 = arith.constant 4 : index + %7:2 = hlfir.declare %6 typeparams %c4 {fortran_attrs = #fir.var_attrs, uniq_name = "_QQclX74686973"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %8 = fir.load %1#0 : !fir.ref> + %9 = hlfir.index %7#0 in %5#0 back %8 : (!fir.ref>, !fir.boxchar<1>, !fir.logical<4>) -> i32 +// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_6]]#1 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_5]]#1 : (index) -> i64 +// CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_8]]#0 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_0]] : (index) -> i64 +// CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_9]] : (!fir.logical<4>) -> i1 +// CHECK: %[[VAL_15:.*]] = fir.call @_FortranAIndex1(%[[VAL_10]], %[[VAL_11]], %[[VAL_12]], %[[VAL_13]], %[[VAL_14]]) : (!fir.ref, i64, !fir.ref, i64, i1) -> i64 +// CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> i32 +// CHECK: hlfir.assign %[[VAL_16]] to %[[VAL_4]]#0 : i32, !fir.ref + hlfir.assign %9 to %3#0 : i32, !fir.ref + return +} + +func.func @_QPt2(%arg0: !fir.boxchar<2> {fir.bindc_name = "s"}, %arg1: !fir.boxchar<2> {fir.bindc_name = "c"}) { +// CHECK-LABEL: func.func @_QPt2( +// CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<2> {fir.bindc_name = "s"}, +// CHECK-SAME: %[[ARG1:.*]]: !fir.boxchar<2> {fir.bindc_name = "c"}) { +// CHECK: %[[VAL_0:.*]] = arith.constant false +// CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope +// CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[ARG1]] : (!fir.boxchar<2>) -> (!fir.ref>, index) +// CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]]#0 typeparams %[[VAL_2]]#1 dummy_scope %[[VAL_1]] {uniq_name = "_QFt2Ec"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<2>, !fir.ref>) +// CHECK: %[[VAL_4:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFt2En"} +// CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {uniq_name = "_QFt2En"} : (!fir.ref) -> (!fir.ref, !fir.ref) +// CHECK: %[[VAL_6:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<2>) -> (!fir.ref>, index) +// CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]]#0 typeparams %[[VAL_6]]#1 dummy_scope %[[VAL_1]] {uniq_name = "_QFt2Es"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<2>, !fir.ref>) + %0 = fir.dummy_scope : !fir.dscope + %1:2 = fir.unboxchar %arg1 : (!fir.boxchar<2>) -> (!fir.ref>, index) + %2:2 = hlfir.declare %1#0 typeparams %1#1 dummy_scope %0 {uniq_name = "_QFt2Ec"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<2>, !fir.ref>) + %3 = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFt2En"} + %4:2 = hlfir.declare %3 {uniq_name = "_QFt2En"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %5:2 = fir.unboxchar %arg0 : (!fir.boxchar<2>) -> (!fir.ref>, index) + %6:2 = hlfir.declare %5#0 typeparams %5#1 dummy_scope %0 {uniq_name = "_QFt2Es"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<2>, !fir.ref>) + %false = arith.constant false + %7 = hlfir.index %2#0 in %6#0 back %false : (!fir.boxchar<2>, !fir.boxchar<2>, i1) -> i32 +// CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]]#1 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_6]]#1 : (index) -> i64 +// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_2]]#1 : (index) -> i64 +// CHECK: %[[VAL_12:.*]] = fir.call @_FortranAIndex2(%[[VAL_8]], %[[VAL_9]], %[[VAL_10]], %[[VAL_11]], %[[VAL_0]]) : (!fir.ref, i64, !fir.ref, i64, i1) -> i64 +// CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i64) -> i32 +// CHECK: hlfir.assign %[[VAL_13]] to %[[VAL_5]]#0 : i32, !fir.ref + hlfir.assign %7 to %4#0 : i32, !fir.ref + return +} + +func.func @_QPt3(%arg0: !fir.boxchar<4> {fir.bindc_name = "s"}, %arg1: !fir.boxchar<4> {fir.bindc_name = "c"}) { +// CHECK-LABEL: func.func @_QPt3( +// CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<4> {fir.bindc_name = "s"}, +// CHECK-SAME: %[[ARG1:.*]]: !fir.boxchar<4> {fir.bindc_name = "c"}) { +// CHECK: %[[VAL_0:.*]] = arith.constant true +// CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope +// CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[ARG1]] : (!fir.boxchar<4>) -> (!fir.ref>, index) +// CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]]#0 typeparams %[[VAL_2]]#1 dummy_scope %[[VAL_1]] {uniq_name = "_QFt3Ec"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<4>, !fir.ref>) +// CHECK: %[[VAL_4:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFt3En"} +// CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {uniq_name = "_QFt3En"} : (!fir.ref) -> (!fir.ref, !fir.ref) +// CHECK: %[[VAL_6:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<4>) -> (!fir.ref>, index) +// CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]]#0 typeparams %[[VAL_6]]#1 dummy_scope %[[VAL_1]] {uniq_name = "_QFt3Es"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<4>, !fir.ref>) + %0 = fir.dummy_scope : !fir.dscope + %1:2 = fir.unboxchar %arg1 : (!fir.boxchar<4>) -> (!fir.ref>, index) + %2:2 = hlfir.declare %1#0 typeparams %1#1 dummy_scope %0 {uniq_name = "_QFt3Ec"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<4>, !fir.ref>) + %3 = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFt3En"} + %4:2 = hlfir.declare %3 {uniq_name = "_QFt3En"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %5:2 = fir.unboxchar %arg0 : (!fir.boxchar<4>) -> (!fir.ref>, index) + %6:2 = hlfir.declare %5#0 typeparams %5#1 dummy_scope %0 {uniq_name = "_QFt3Es"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<4>, !fir.ref>) + %true = arith.constant true + %7 = hlfir.index %2#0 in %6#0 back %true : (!fir.boxchar<4>, !fir.boxchar<4>, i1) -> i8 +// CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]]#1 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_6]]#1 : (index) -> i64 +// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_2]]#1 : (index) -> i64 +// CHECK: %[[VAL_12:.*]] = fir.call @_FortranAIndex4(%[[VAL_8]], %[[VAL_9]], %[[VAL_10]], %[[VAL_11]], %[[VAL_0]]) : (!fir.ref, i64, !fir.ref, i64, i1) -> i64 +// CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i64) -> i8 +// CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i8) -> i32 +// CHECK: hlfir.assign %[[VAL_14]] to %[[VAL_5]]#0 : i32, !fir.ref + %8 = fir.convert %7 : (i8) -> i32 + hlfir.assign %8 to %4#0 : i32, !fir.ref + return +} + +func.func @_QPt4(%arg0: !fir.boxchar<1> {fir.bindc_name = "c1"}, %arg1: !fir.boxchar<1> {fir.bindc_name = "c2"}) { +// CHECK-LABEL: func.func @_QPt4( +// CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "c1"}, +// CHECK-SAME: %[[ARG1:.*]]: !fir.boxchar<1> {fir.bindc_name = "c2"}) { +// CHECK: %[[VAL_0:.*]] = arith.constant false +// CHECK: %[[VAL_1:.*]] = arith.constant 3 : index +// CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +// CHECK: %[[VAL_3:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +// CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#0 : (!fir.ref>) -> !fir.ref>> +// CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +// CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_5]]) typeparams %[[VAL_3]]#1 dummy_scope %[[VAL_2]] {uniq_name = "_QFt4Ec1"} : (!fir.ref>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box>>, !fir.ref>>) +// CHECK: %[[VAL_7:.*]]:2 = fir.unboxchar %[[ARG1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +// CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref>) -> !fir.ref>> +// CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +// CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_8]](%[[VAL_9]]) typeparams %[[VAL_7]]#1 dummy_scope %[[VAL_2]] {uniq_name = "_QFt4Ec2"} : (!fir.ref>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box>>, !fir.ref>>) +// CHECK: %[[VAL_11:.*]] = fir.alloca !fir.array<3xi8> {bindc_name = "n", uniq_name = "_QFt4En"} +// CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +// CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_11]](%[[VAL_12]]) {uniq_name = "_QFt4En"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) +// CHECK: %[[VAL_14:.*]] = hlfir.elemental %[[VAL_5]] unordered : (!fir.shape<1>) -> !hlfir.expr<3xi8> { +// CHECK: ^bb0(%[[VAL_15:.*]]: index): +// CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_15]]) typeparams %[[VAL_3]]#1 : (!fir.box>>, index, index) -> !fir.boxchar<1> +// CHECK: %[[VAL_17:.*]] = hlfir.designate %[[VAL_10]]#0 (%[[VAL_15]]) typeparams %[[VAL_7]]#1 : (!fir.box>>, index, index) -> !fir.boxchar<1> +// CHECK: %[[VAL_18:.*]]:2 = fir.unboxchar %[[VAL_17]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +// CHECK: %[[VAL_19:.*]]:2 = fir.unboxchar %[[VAL_16]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + %0 = fir.dummy_scope : !fir.dscope + %1:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) + %2 = fir.convert %1#0 : (!fir.ref>) -> !fir.ref>> + %c3 = arith.constant 3 : index + %3 = fir.shape %c3 : (index) -> !fir.shape<1> + %4:2 = hlfir.declare %2(%3) typeparams %1#1 dummy_scope %0 {uniq_name = "_QFt4Ec1"} : (!fir.ref>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box>>, !fir.ref>>) + %5:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref>, index) + %6 = fir.convert %5#0 : (!fir.ref>) -> !fir.ref>> + %c3_0 = arith.constant 3 : index + %7 = fir.shape %c3_0 : (index) -> !fir.shape<1> + %8:2 = hlfir.declare %6(%7) typeparams %5#1 dummy_scope %0 {uniq_name = "_QFt4Ec2"} : (!fir.ref>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box>>, !fir.ref>>) + %c3_1 = arith.constant 3 : index + %9 = fir.alloca !fir.array<3xi8> {bindc_name = "n", uniq_name = "_QFt4En"} + %10 = fir.shape %c3_1 : (index) -> !fir.shape<1> + %11:2 = hlfir.declare %9(%10) {uniq_name = "_QFt4En"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) + %12 = hlfir.elemental %3 unordered : (!fir.shape<1>) -> !hlfir.expr<3xi8> { + ^bb0(%arg2: index): + %13 = hlfir.designate %4#0 (%arg2) typeparams %1#1 : (!fir.box>>, index, index) -> !fir.boxchar<1> + %14 = hlfir.designate %8#0 (%arg2) typeparams %5#1 : (!fir.box>>, index, index) -> !fir.boxchar<1> + %15 = hlfir.index %14 in %13 : (!fir.boxchar<1>, !fir.boxchar<1>) -> i8 +// CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_19]]#0 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_3]]#1 : (index) -> i64 +// CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_18]]#0 : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_7]]#1 : (index) -> i64 +// CHECK: %[[VAL_24:.*]] = fir.call @_FortranAIndex1(%[[VAL_20]], %[[VAL_21]], %[[VAL_22]], %[[VAL_23]], %[[VAL_0]]) : (!fir.ref, i64, !fir.ref, i64, i1) -> i64 +// CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i64) -> i8 +// CHECK: hlfir.yield_element %[[VAL_25]] : i8 +// CHECK: } +// CHECK: hlfir.assign %[[VAL_14]] to %[[VAL_13]]#0 : !hlfir.expr<3xi8>, !fir.ref> +// CHECK: hlfir.destroy %[[VAL_14]] : !hlfir.expr<3xi8> + hlfir.yield_element %15 : i8 + } + hlfir.assign %12 to %11#0 : !hlfir.expr<3xi8>, !fir.ref> + hlfir.destroy %12 : !hlfir.expr<3xi8> + return +} From 8de0b13f7d84a0a577f78d4cb4936a0a751b9338 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Mon, 8 Sep 2025 16:35:45 -0700 Subject: [PATCH 5/8] fix formatting --- flang/lib/Lower/HlfirIntrinsics.cpp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp index bda876b34e0f9..11971b92770a1 100644 --- a/flang/lib/Lower/HlfirIntrinsics.cpp +++ b/flang/lib/Lower/HlfirIntrinsics.cpp @@ -534,8 +534,7 @@ mlir::Value HlfirIndexLowering::lowerImpl( } else { resultType = builder.getDefaultIntegerType(); } - mlir::Value result = - createOp(resultType, substr, str, back); + mlir::Value result = createOp(resultType, substr, str, back); if (resultType != stmtResultType) return builder.createConvert(loc, stmtResultType, result); From 9b2d7af5850e264234843d08d1b55255d40660b8 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Tue, 9 Sep 2025 10:12:37 -0700 Subject: [PATCH 6/8] Adress review comments -part1 --- flang/include/flang/Lower/HlfirIntrinsics.h | 11 ++++-- flang/lib/Lower/ConvertCall.cpp | 32 --------------- flang/lib/Lower/HlfirIntrinsics.cpp | 44 +++++++++++++++++---- 3 files changed, 44 insertions(+), 43 deletions(-) diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h index dd31b20a7fdf3..930bbeb6fb452 100644 --- a/flang/include/flang/Lower/HlfirIntrinsics.h +++ b/flang/include/flang/Lower/HlfirIntrinsics.h @@ -58,10 +58,13 @@ struct PreparedActualArgument { /// call, the current element value will be returned. hlfir::Entity getActual(mlir::Location loc, fir::FirOpBuilder &builder) const; - /// Lower the actual argument that needs to be handled as dynamically - /// optional Value. - mlir::Value getOptionalValue(mlir::Location loc, - fir::FirOpBuilder &builder) const; + mlir::Type getFortranElementType() { + if (auto *actualEntity = std::get_if(&actual)) + return hlfir::getFortranElementType(actualEntity->getType()); + mlir::Value entity = + std::get(actual).getElementEntity(); + return hlfir::getFortranElementType(entity.getType()); + } void derefPointersAndAllocatables(mlir::Location loc, fir::FirOpBuilder &builder) { diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index ac41f63edbb49..b20785d3609e6 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -3044,38 +3044,6 @@ hlfir::Entity Fortran::lower::PreparedActualArgument::getActual( return hlfir::Entity{addr}; } -mlir::Value Fortran::lower::PreparedActualArgument::getOptionalValue( - mlir::Location loc, fir::FirOpBuilder &builder) const { - mlir::Type eleType; - if (auto *actualEntity = std::get_if(&actual)) - eleType = hlfir::getFortranElementType(actualEntity->getType()); - else - TODO(loc, "compute element type from hlfir::ElementalAddrOp"); - - // For an elemental call, getActual() may produce - // a designator denoting the array element to be passed - // to the subprogram. If the actual array is dynamically - // optional the designator must be generated under - // isPresent check (see also genIntrinsicRefCore). - return builder - .genIfOp(loc, {eleType}, getIsPresent(), - /*withElseRegion=*/true) - .genThen([&]() { - hlfir::Entity actual = getActual(loc, builder); - assert(eleType == actual.getFortranElementType() && - "result type mismatch in genOptionalValue"); - assert(actual.isScalar() && fir::isa_trivial(eleType) && - "must be a numerical or logical scalar"); - hlfir::Entity val = hlfir::loadTrivialScalar(loc, builder, actual); - fir::ResultOp::create(builder, loc, val); - }) - .genElse([&]() { - mlir::Value zero = fir::factory::createZeroValue(builder, loc, eleType); - fir::ResultOp::create(builder, loc, zero); - }) - .getResults()[0]; -} - bool Fortran::lower::isIntrinsicModuleProcRef( const Fortran::evaluate::ProcedureRef &procRef) { const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol(); diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp index 11971b92770a1..b63aa38c06a16 100644 --- a/flang/lib/Lower/HlfirIntrinsics.cpp +++ b/flang/lib/Lower/HlfirIntrinsics.cpp @@ -69,8 +69,10 @@ class HlfirTransformationalIntrinsic { mlir::Value loadBoxAddress( const std::optional &arg); - mlir::Value loadTrivialScalar( - const std::optional &arg); + mlir::Value + loadTrivialScalar(const Fortran::lower::PreparedActualArgument &arg); + + mlir::Value loadOptionalValue(Fortran::lower::PreparedActualArgument &arg); void addCleanup(std::optional cleanup) { if (cleanup) @@ -253,9 +255,37 @@ mlir::Value HlfirTransformationalIntrinsic::loadBoxAddress( return boxOrAbsent; } +mlir::Value HlfirTransformationalIntrinsic::loadOptionalValue( + Fortran::lower::PreparedActualArgument &arg) { + mlir::Type eleType = arg.getFortranElementType(); + + // For an elemental call, getActual() may produce + // a designator denoting the array element to be passed + // to the subprogram. If the actual array is dynamically + // optional the designator must be generated under + // isPresent check (see also genIntrinsicRefCore). + return builder + .genIfOp(loc, {eleType}, arg.getIsPresent(), + /*withElseRegion=*/true) + .genThen([&]() { + hlfir::Entity actual = arg.getActual(loc, builder); + assert(eleType == actual.getFortranElementType() && + "result type mismatch in genOptionalValue"); + assert(actual.isScalar() && fir::isa_trivial(eleType) && + "must be a numerical or logical scalar"); + hlfir::Entity val = hlfir::loadTrivialScalar(loc, builder, actual); + fir::ResultOp::create(builder, loc, val); + }) + .genElse([&]() { + mlir::Value zero = fir::factory::createZeroValue(builder, loc, eleType); + fir::ResultOp::create(builder, loc, zero); + }) + .getResults()[0]; +} + mlir::Value HlfirTransformationalIntrinsic::loadTrivialScalar( - const std::optional &arg) { - hlfir::Entity actual = arg->getActual(loc, builder); + const Fortran::lower::PreparedActualArgument &arg) { + hlfir::Entity actual = arg.getActual(loc, builder); return hlfir::loadTrivialScalar(loc, builder, actual); } @@ -274,7 +304,7 @@ llvm::SmallVector HlfirTransformationalIntrinsic::getOperandVector( } mlir::Value valArg; if (!argLowering) { - valArg = loadTrivialScalar(arg); + valArg = loadTrivialScalar(*arg); operands.emplace_back(valArg); continue; } @@ -285,9 +315,9 @@ llvm::SmallVector HlfirTransformationalIntrinsic::getOperandVector( } else if (argRules.handleDynamicOptional) { if (argRules.lowerAs == fir::LowerIntrinsicArgAs::Value) { if (arg->handleDynamicOptional()) - valArg = arg->getOptionalValue(loc, builder); + valArg = loadOptionalValue(*arg); else - valArg = loadTrivialScalar(arg); + valArg = loadTrivialScalar(*arg); } else { TODO(loc, "hlfir transformational intrinsic dynamically optional " "argument without box lowering"); From f397dcbcfe6b9c219169e337bc48b5ed0acc2835 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Tue, 9 Sep 2025 10:26:34 -0700 Subject: [PATCH 7/8] address review comments - part2 - delete unnecessary code --- flang/lib/Lower/HlfirIntrinsics.cpp | 21 ++++----------------- 1 file changed, 4 insertions(+), 17 deletions(-) diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp index b63aa38c06a16..27c8bb87f7542 100644 --- a/flang/lib/Lower/HlfirIntrinsics.cpp +++ b/flang/lib/Lower/HlfirIntrinsics.cpp @@ -547,27 +547,14 @@ mlir::Value HlfirIndexLowering::lowerImpl( const fir::IntrinsicArgumentLoweringRules *argLowering, mlir::Type stmtResultType) { auto operands = getOperandVector(loweredActuals, argLowering); + // 'kind' optional operand is unused here as it has already been + // translated into result type. assert(operands.size() == 4); mlir::Value substr = operands[1]; mlir::Value str = operands[0]; mlir::Value back = operands[2]; - mlir::Value kind = operands[3]; - - mlir::Type resultType; - if (kind) { - auto kindCst = fir::getIntIfConstant(kind); - assert(kindCst && - "kind argument of index must be an integer constant expression"); - unsigned bits = builder.getKindMap().getIntegerBitsize(*kindCst); - assert(bits != 0 && "failed to convert kind to integer bitsize"); - resultType = builder.getIntegerType(bits); - } else { - resultType = builder.getDefaultIntegerType(); - } - mlir::Value result = createOp(resultType, substr, str, back); - - if (resultType != stmtResultType) - return builder.createConvert(loc, stmtResultType, result); + mlir::Value result = + createOp(stmtResultType, substr, str, back); return result; } From 18b143965eecf1bb675d6886c0fceb53cc6ea150 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Tue, 9 Sep 2025 16:10:40 -0700 Subject: [PATCH 8/8] fix pasto in test comment --- flang/test/HLFIR/index-lowering.fir | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/test/HLFIR/index-lowering.fir b/flang/test/HLFIR/index-lowering.fir index 3857324563372..7266513d054aa 100644 --- a/flang/test/HLFIR/index-lowering.fir +++ b/flang/test/HLFIR/index-lowering.fir @@ -1,4 +1,4 @@ -// Test hlfir.cmpchar operation lowering to a fir runtime call +// Test hlfir.index operation lowering to a fir runtime call // RUN: fir-opt %s -lower-hlfir-intrinsics | FileCheck %s func.func @_QPt(%arg0: !fir.boxchar<1> {fir.bindc_name = "s"}) {