diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp index 310b62697f710..9d3cd3a5c8fa1 100644 --- a/flang/lib/Lower/HlfirIntrinsics.cpp +++ b/flang/lib/Lower/HlfirIntrinsics.cpp @@ -159,6 +159,17 @@ class HlfirCharExtremumLowering : public HlfirTransformationalIntrinsic { hlfir::CharExtremumPredicate pred; }; +class HlfirCShiftLowering : 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( @@ -270,11 +281,12 @@ HlfirTransformationalIntrinsic::computeResultType(mlir::Value argArray, hlfir::ExprType::Shape{array.getShape()}; mlir::Type elementType = array.getEleTy(); return hlfir::ExprType::get(builder.getContext(), resultShape, elementType, - /*polymorphic=*/false); + fir::isPolymorphicType(stmtResultType)); } else if (auto resCharType = mlir::dyn_cast(stmtResultType)) { normalisedResult = hlfir::ExprType::get( - builder.getContext(), hlfir::ExprType::Shape{}, resCharType, false); + builder.getContext(), hlfir::ExprType::Shape{}, resCharType, + /*polymorphic=*/false); } return normalisedResult; } @@ -387,6 +399,26 @@ mlir::Value HlfirCharExtremumLowering::lowerImpl( return createOp(pred, mlir::ValueRange{operands}); } +mlir::Value HlfirCShiftLowering::lowerImpl( + const Fortran::lower::PreparedActualArguments &loweredActuals, + const fir::IntrinsicArgumentLoweringRules *argLowering, + mlir::Type stmtResultType) { + auto operands = getOperandVector(loweredActuals, argLowering); + assert(operands.size() == 3); + mlir::Value dim = operands[2]; + if (!dim) { + // If DIM is not present, drop the last element which is a null Value. + operands.truncate(2); + } else { + // If DIM is present, then dereference it if it is a ref. + dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim}); + operands[2] = dim; + } + + mlir::Type resultType = computeResultType(operands[0], stmtResultType); + return createOp(resultType, operands); +} + std::optional Fortran::lower::lowerHlfirIntrinsic( fir::FirOpBuilder &builder, mlir::Location loc, const std::string &name, const Fortran::lower::PreparedActualArguments &loweredActuals, @@ -432,6 +464,9 @@ std::optional Fortran::lower::lowerHlfirIntrinsic( if (name == "maxloc") return HlfirMaxlocLowering{builder, loc}.lower(loweredActuals, argLowering, stmtResultType); + if (name == "cshift") + return HlfirCShiftLowering{builder, loc}.lower(loweredActuals, argLowering, + stmtResultType); if (mlir::isa(stmtResultType)) { if (name == "min") return HlfirCharExtremumLowering{builder, loc, diff --git a/flang/test/Lower/HLFIR/cshift.f90 b/flang/test/Lower/HLFIR/cshift.f90 new file mode 100644 index 0000000000000..c3743068da4d7 --- /dev/null +++ b/flang/test/Lower/HLFIR/cshift.f90 @@ -0,0 +1,218 @@ +! Test lowering of CSHIFT intrinsic to HLFIR +! RUN: bbc -emit-hlfir -o - -I nowhere %s 2>&1 | FileCheck %s + +module types + type t + end type t +end module types + +! 1d shift by scalar +subroutine cshift1(a, s) + integer :: a(:), s + a = CSHIFT(a, 2) +end subroutine +! CHECK-LABEL: func.func @_QPcshift1( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_5:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_6:.*]] = hlfir.cshift %[[VAL_3]]#0 %[[VAL_5]] : (!fir.box>, i32) -> !hlfir.expr +! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_3]]#0 : !hlfir.expr, !fir.box> +! CHECK: hlfir.destroy %[[VAL_6]] : !hlfir.expr +! CHECK: return +! CHECK: } + +! 1d shift by scalar with dim +subroutine cshift2(a, s) + integer :: a(:), s + a = CSHIFT(a, 2, 1) +end subroutine +! CHECK-LABEL: func.func @_QPcshift2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_5:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_6:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_7:.*]] = hlfir.cshift %[[VAL_3]]#0 %[[VAL_5]] dim %[[VAL_6]] : (!fir.box>, i32, i32) -> !hlfir.expr +! CHECK: hlfir.assign %[[VAL_7]] to %[[VAL_3]]#0 : !hlfir.expr, !fir.box> +! CHECK: hlfir.destroy %[[VAL_7]] : !hlfir.expr +! CHECK: return +! CHECK: } + +! 2d shift by scalar +subroutine cshift3(a, s) + integer :: a(:,:), s + a = CSHIFT(a, 2) +end subroutine +! CHECK-LABEL: func.func @_QPcshift3( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_5:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_6:.*]] = hlfir.cshift %[[VAL_3]]#0 %[[VAL_5]] : (!fir.box>, i32) -> !hlfir.expr +! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_3]]#0 : !hlfir.expr, !fir.box> +! CHECK: hlfir.destroy %[[VAL_6]] : !hlfir.expr +! CHECK: return +! CHECK: } + +! 2d shift by scalar with dim +subroutine cshift4(a, s) + integer :: a(:,:), s + a = CSHIFT(a, 2, 2) +end subroutine +! CHECK-LABEL: func.func @_QPcshift4( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_5:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_6:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_7:.*]] = hlfir.cshift %[[VAL_3]]#0 %[[VAL_5]] dim %[[VAL_6]] : (!fir.box>, i32, i32) -> !hlfir.expr +! CHECK: hlfir.assign %[[VAL_7]] to %[[VAL_3]]#0 : !hlfir.expr, !fir.box> +! CHECK: hlfir.destroy %[[VAL_7]] : !hlfir.expr +! CHECK: return +! CHECK: } + +! 2d shift by array +subroutine cshift5(a, s) + integer :: a(:,:), s(:) + a = CSHIFT(a, s) +end subroutine +! CHECK-LABEL: func.func @_QPcshift5( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box> {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_5:.*]] = hlfir.cshift %[[VAL_3]]#0 %[[VAL_4]]#0 : (!fir.box>, !fir.box>) -> !hlfir.expr +! CHECK: hlfir.assign %[[VAL_5]] to %[[VAL_3]]#0 : !hlfir.expr, !fir.box> +! CHECK: hlfir.destroy %[[VAL_5]] : !hlfir.expr +! CHECK: return +! CHECK: } + +! 2d shift by array expr +subroutine cshift6(a, s) + integer :: a(:,:), s(:) + a = CSHIFT(a, s + 1) +end subroutine +! CHECK-LABEL: func.func @_QPcshift6( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box> {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_5:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_6:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_4]]#0, %[[VAL_6]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_7]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_9:.*]] = hlfir.elemental %[[VAL_8]] unordered : (!fir.shape<1>) -> !hlfir.expr +! CHECK: %[[VAL_14:.*]] = hlfir.cshift %[[VAL_3]]#0 %[[VAL_9]] : (!fir.box>, !hlfir.expr) -> !hlfir.expr +! CHECK: hlfir.assign %[[VAL_14]] to %[[VAL_3]]#0 : !hlfir.expr, !fir.box> +! CHECK: hlfir.destroy %[[VAL_14]] : !hlfir.expr +! CHECK: hlfir.destroy %[[VAL_9]] : !hlfir.expr +! CHECK: return +! CHECK: } + +! 1d character(10,2) shift by scalar +subroutine cshift7(a, s) + character(10,2) :: a(:) + a = CSHIFT(a, 2) +end subroutine +! CHECK-LABEL: func.func @_QPcshift7( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_6:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_7:.*]] = hlfir.cshift %[[VAL_4]]#0 %[[VAL_6]] : (!fir.box>>, i32) -> !hlfir.expr> +! CHECK: hlfir.assign %[[VAL_7]] to %[[VAL_4]]#0 : !hlfir.expr>, !fir.box>> +! CHECK: hlfir.destroy %[[VAL_7]] : !hlfir.expr> +! CHECK: return +! CHECK: } + +! 1d character(*) shift by scalar +subroutine cshift8(a, s) + character(*) :: a(:) + a = CSHIFT(a, 2) +end subroutine +! CHECK-LABEL: func.func @_QPcshift8( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_5:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_6:.*]] = hlfir.cshift %[[VAL_3]]#0 %[[VAL_5]] : (!fir.box>>, i32) -> !hlfir.expr> +! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_3]]#0 : !hlfir.expr>, !fir.box>> +! CHECK: hlfir.destroy %[[VAL_6]] : !hlfir.expr> +! CHECK: return +! CHECK: } + +! 1d type(t) shift by scalar +subroutine cshift9(a, s) + use types + type(t) :: a(:) + a = CSHIFT(a, 2) +end subroutine +! CHECK-LABEL: func.func @_QPcshift9( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_5:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_6:.*]] = hlfir.cshift %[[VAL_3]]#0 %[[VAL_5]] : (!fir.box>>, i32) -> !hlfir.expr> +! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_3]]#0 : !hlfir.expr>, !fir.box>> +! CHECK: hlfir.destroy %[[VAL_6]] : !hlfir.expr> +! CHECK: return +! CHECK: } + +! 1d class(t) shift by scalar +subroutine cshift10(a, s) + use types + class(t), allocatable :: a(:) + a = CSHIFT(a, 2) +end subroutine +! CHECK-LABEL: func.func @_QPcshift10( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "s"}) { +! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] +! CHECK: %[[VAL_5:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref>>>> +! CHECK: %[[VAL_7:.*]] = hlfir.cshift %[[VAL_6]] %[[VAL_5]] : (!fir.class>>>, i32) -> !hlfir.expr?> +! CHECK: hlfir.assign %[[VAL_7]] to %[[VAL_3]]#0 realloc : !hlfir.expr?>, !fir.ref>>>> +! CHECK: hlfir.destroy %[[VAL_7]] : !hlfir.expr?> +! CHECK: return +! CHECK: } + +! 1d shift by scalar with variable dim +subroutine cshift11(a, s, d) + integer :: a(:), s, d + a = CSHIFT(a, 2, d) +end subroutine +! CHECK-LABEL: func.func @_QPcshift11( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "s"}, +! CHECK-SAME: %[[VAL_2:.*]]: !fir.ref {fir.bindc_name = "d"}) { +! CHECK: %[[VAL_3:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_3]] {uniq_name = "_QFcshift11Ea"} : (!fir.box>, !fir.dscope) -> (!fir.box>, !fir.box>) +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_2]] dummy_scope %[[VAL_3]] {uniq_name = "_QFcshift11Ed"} : (!fir.ref, !fir.dscope) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_1]] dummy_scope %[[VAL_3]] {uniq_name = "_QFcshift11Es"} : (!fir.ref, !fir.dscope) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_7:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref +! CHECK: %[[VAL_9:.*]] = hlfir.cshift %[[VAL_4]]#0 %[[VAL_7]] dim %[[VAL_8]] : (!fir.box>, i32, i32) -> !hlfir.expr +! CHECK: hlfir.assign %[[VAL_9]] to %[[VAL_4]]#0 : !hlfir.expr, !fir.box> +! CHECK: hlfir.destroy %[[VAL_9]] : !hlfir.expr +! CHECK: return +! CHECK: } diff --git a/flang/test/Lower/HLFIR/poly_expr_for_nonpoly_dummy.f90 b/flang/test/Lower/HLFIR/poly_expr_for_nonpoly_dummy.f90 index 3f97a9f848d43..26d19c308feae 100644 --- a/flang/test/Lower/HLFIR/poly_expr_for_nonpoly_dummy.f90 +++ b/flang/test/Lower/HLFIR/poly_expr_for_nonpoly_dummy.f90 @@ -17,12 +17,9 @@ subroutine test1(x) call callee(cshift(x, 1)) end subroutine test1 ! CHECK-LABEL: func.func @_QPtest1( -! CHECK: %[[VAL_21:.*]]:2 = hlfir.declare %{{.*}}(%{{.*}}) {uniq_name = ".tmp.intrinsic_result"} : (!fir.class>>>, !fir.shift<1>) -> (!fir.class>>>, !fir.class>>>) -! CHECK: %[[VAL_22:.*]] = arith.constant true -! CHECK: %[[VAL_23:.*]] = hlfir.as_expr %[[VAL_21]]#0 move %[[VAL_22]] : (!fir.class>>>, i1) -> !hlfir.expr?> -! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index -! CHECK: %[[VAL_25:.*]]:3 = fir.box_dims %[[VAL_21]]#0, %[[VAL_24]] : (!fir.class>>>, index) -> (index, index, index) -! CHECK: %[[VAL_26:.*]] = fir.shape %[[VAL_25]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_23:.*]] = hlfir.cshift %{{.*}} %[[VAL_4]] : (!fir.class>>, i32) -> !hlfir.expr?> +! CHECK: %[[VAL_26:.*]] = hlfir.shape_of %[[VAL_23]] : (!hlfir.expr?>) -> !fir.shape<1> ! CHECK: %[[VAL_27:.*]]:3 = hlfir.associate %[[VAL_23]](%[[VAL_26]]) {adapt.valuebyref} : (!hlfir.expr?>, !fir.shape<1>) -> (!fir.class>>>, !fir.class>>>, i1) ! CHECK: %[[VAL_28:.*]] = fir.rebox %[[VAL_27]]#0 : (!fir.class>>>) -> !fir.box>> ! CHECK: %[[VAL_29:.*]]:2 = hlfir.copy_in %[[VAL_28]] to %[[TMP_BOX:.*]] : (!fir.box>>, !fir.ref>>>>) -> (!fir.box>>, i1)