diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1338,20 +1338,49 @@ return hlfir::ExprType::get(builder.getContext(), resultShape, elementType, /*polymorphic=*/false); }; - const std::string intrinsicName = callContext.getProcedureName(); - if (intrinsicName == "sum") { + + auto buildSumOperation = [](fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Type resultTy, mlir::Value array, + mlir::Value dim, mlir::Value mask) { + return builder.create(loc, resultTy, array, dim, mask); + }; + + auto buildProductOperation = [](fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type resultTy, + mlir::Value array, mlir::Value dim, + mlir::Value mask) { + return builder.create(loc, resultTy, array, dim, mask); + }; + + auto buildReductionIntrinsic = + [&](PreparedActualArguments &loweredActuals, mlir::Location loc, + fir::FirOpBuilder &builder, CallContext &callContext, + std::function + buildFunc) -> std::optional { + // shared logic for building the product and sum operations llvm::SmallVector operands = getOperandVector(loweredActuals); assert(operands.size() == 3); + // dim, mask can be NULL if these arguments were not given mlir::Value array = operands[0]; mlir::Value dim = operands[1]; if (dim) dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim}); mlir::Value mask = operands[2]; mlir::Type resultTy = computeResultType(array, *callContext.resultType); - // dim, mask can be NULL if these arguments were not given - hlfir::SumOp sumOp = - builder.create(loc, resultTy, array, dim, mask); - return {hlfir::EntityWithAttributes{sumOp.getResult()}}; + auto *intrinsicOp = buildFunc(builder, loc, resultTy, array, dim, mask); + return {hlfir::EntityWithAttributes{intrinsicOp->getResult(0)}}; + }; + + const std::string intrinsicName = callContext.getProcedureName(); + if (intrinsicName == "sum") { + return buildReductionIntrinsic(loweredActuals, loc, builder, callContext, + buildSumOperation); + } + if (intrinsicName == "product") { + return buildReductionIntrinsic(loweredActuals, loc, builder, callContext, + buildProductOperation); } if (intrinsicName == "matmul") { llvm::SmallVector operands = getOperandVector(loweredActuals); diff --git a/flang/test/Lower/HLFIR/expr-box.f90 b/flang/test/Lower/HLFIR/expr-box.f90 --- a/flang/test/Lower/HLFIR/expr-box.f90 +++ b/flang/test/Lower/HLFIR/expr-box.f90 @@ -1,5 +1,5 @@ ! Test lowering of of expressions as fir.box -! RUN: bbc -hlfir -o - %s 2>&1 | FileCheck %s +! RUN: bbc -hlfir -o - %s 2>&1 --use-hlfir-intrinsic-ops=false | FileCheck %s ! CHECK-LABEL: func.func @_QPfoo( ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> diff --git a/flang/test/Lower/HLFIR/product.f90 b/flang/test/Lower/HLFIR/product.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/product.f90 @@ -0,0 +1,113 @@ +! Test lowering of PRODUCT intrinsic to HLFIR +! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s + +! simple 1 argument PRODUCT +subroutine product1(a, s) + integer :: a(:), s + s = PRODUCT(a) +end subroutine +! CHECK-LABEL: func.func @_QPproduct1( +! CHECK: %[[ARG0:.*]]: !fir.box> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.ref +! CHECK-DAG: %[[ARRAY:.*]]:2 = hlfir.declare %[[ARG0]] +! CHECK-DAG: %[[OUT:.*]]:2 = hlfir.declare %[[ARG1]] +! CHECK-NEXT: %[[EXPR:.*]] = hlfir.product %[[ARRAY]]#0 {fastmath = #arith.fastmath} : (!fir.box>) -> !hlfir.expr +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr, !fir.ref +! CHECK-NEXT: hlfir.destroy %[[EXPR]] +! CHECK-NEXT: return +! CHECK-NEXT: } + +! product with by-ref DIM argument +subroutine product2(a, s, d) + integer :: a(:,:), s(:), d + s = PRODUCT(a, d) +end subroutine +! CHECK-LABEL: func.func @_QPproduct2( +! CHECK: %[[ARG0:.*]]: !fir.box> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.box> {fir.bindc_name = "s"}, %[[ARG2:.*]]: !fir.ref +! CHECK-DAG: %[[ARRAY:.*]]:2 = hlfir.declare %[[ARG0]] +! CHECK-DAG: %[[OUT:.*]]:2 = hlfir.declare %[[ARG1]] +! CHECK-DAG: %[[DIM_REF:.*]]:2 = hlfir.declare %[[ARG2]] +! CHECK-NEXT: %[[DIM:.*]] = fir.load %[[DIM_REF]]#0 : !fir.ref +! CHECK-NEXT: %[[EXPR:.*]] = hlfir.product %[[ARRAY]]#0 dim %[[DIM]] {fastmath = #arith.fastmath} : (!fir.box>, i32) -> !hlfir.expr +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr, !fir.box> +! CHECK-NEXT: hlfir.destroy %[[EXPR]] +! CHECK-NEXT: return +! CHECK-NEXT: } + +! product with scalar mask argument +subroutine product3(a, s, m) + integer :: a(:), s + logical :: m + s = PRODUCT(a, m) +end subroutine +! CHECK-LABEL: func.func @_QPproduct3( +! CHECK: %[[ARG0:.*]]: !fir.box> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.ref {fir.bindc_name = "s"}, %[[ARG2:.*]]: !fir.ref> {fir.bindc_name = "m"}) +! CHECK-DAG: %[[ARRAY:.*]]:2 = hlfir.declare %[[ARG0]] +! CHECK-DAG: %[[OUT:.*]]:2 = hlfir.declare %[[ARG1]] +! CHECK-DAG: %[[MASK:.*]]:2 = hlfir.declare %[[ARG2]] +! CHECK-NEXT: %[[EXPR:.*]] = hlfir.product %[[ARRAY]]#0 mask %[[MASK]]#0 {fastmath = #arith.fastmath} : (!fir.box>, !fir.ref>) -> !hlfir.expr +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr, !fir.ref +! CHECK-NEXT: hlfir.destroy %[[EXPR]] +! CHECK-NEXT: return +! CHECK-NEXT: } + +! product with array mask argument +subroutine product4(a, s, m) + integer :: a(:), s + logical :: m(:) + s = PRODUCT(a, m) +end subroutine + +! CHECK-LABEL: func.func @_QPproduct4( +! CHECK: %[[ARG0:.*]]: !fir.box> {fir.bindc_name = "a"}, %arg1: !fir.ref {fir.bindc_name = "s"}, %arg2: !fir.box>> {fir.bindc_name = "m"}) +! CHECK-DAG: %[[ARRAY:.*]]:2 = hlfir.declare %[[ARG0]] +! CHECK-DAG: %[[OUT:.*]]:2 = hlfir.declare %[[ARG1]] +! CHECK-DAG: %[[MASK:.*]]:2 = hlfir.declare %[[ARG2]] +! CHECK-NEXT: %[[EXPR:.*]] = hlfir.product %[[ARRAY]]#0 mask %[[MASK]]#0 {fastmath = #arith.fastmath} : (!fir.box>, !fir.box>>) -> !hlfir.expr +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr, !fir.ref +! CHECK-NEXT: hlfir.destroy %[[EXPR]] +! CHECK-NEXT: return +! CHECK-NEXT: } + +! product with all 3 arguments, dim is by-val, array isn't boxed +subroutine product5(s) + integer :: s(2) + integer :: a(2,2) = reshape((/1, 2, 3, 4/), [2,2]) + s = PRODUCT(a, 1, .true.) +end subroutine + +! CHECK-LABEL: func.func @_QPproduct5( +! CHECK: %[[ARG0:.*]]: !fir.ref> +! CHECK-DAG: %[[ADDR:.*]] = fir.address_of({{.*}}) : !fir.ref> +! CHECK-DAG: %[[ARRAY_SHAPE:.*]] = fir.shape {{.*}} -> !fir.shape<2> +! CHECK-DAG: %[[ARRAY:.*]]:2 = hlfir.declare %[[ADDR]](%[[ARRAY_SHAPE]]) +! CHECK-DAG: %[[OUT_SHAPE:.*]] = fir.shape {{.*}} -> !fir.shape<1> +! CHECK-DAG: %[[OUT:.*]]:2 = hlfir.declare %[[ARG0]](%[[OUT_SHAPE]]) +! CHECK-DAG: %[[C1:.*]] = arith.constant 1 : i32 +! CHECK-DAG: %[[TRUE:.*]] = arith.constant true +! CHECK-NEXT: %[[EXPR:.*]] = hlfir.product %[[ARRAY]]#0 dim %[[C1]] mask %[[TRUE]] {fastmath = #arith.fastmath} : (!fir.ref>, i32, i1) -> !hlfir.expr<2xi32> +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr<2xi32>, !fir.ref> +! CHECK-NEXT: hlfir.destroy %[[EXPR]] : !hlfir.expr<2xi32> +! CHECK-NEXT: return +! CHECK-NEXT: } + +! product with dimesnsion from pointer +subroutine product6(a, s, d) + integer, pointer :: d + real :: a(:,:), s(:) + s = PRODUCT(a, (d)) +end subroutine + +! CHECK-LABEL: func.func @_QPproduct6( +! CHECK: %[[ARG0:.*]]: !fir.box> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.box> {fir.bindc_name = "s"}, %[[ARG2:.*]]: !fir.ref>> {fir.bindc_name = "d"}) +! CHECK-DAG: %[[ARRAY:.*]]:2 = hlfir.declare %[[ARG0]] +! CHECK-DAG: %[[OUT:.*]]:2 = hlfir.declare %[[ARG1]] +! CHECK-DAG: %[[DIM:.*]]:2 = hlfir.declare %[[ARG2]] +! CHECK-NEXT: %[[DIM_BOX:.*]] = fir.load %[[DIM]]#0 : !fir.ref>> +! CHECK-NEXT: %[[DIM_ADDR:.*]] = fir.box_addr %[[DIM_BOX]] : (!fir.box>) -> !fir.ptr +! CHECK-NEXT: %[[DIM0:.*]] = fir.load %[[DIM_ADDR]] : !fir.ptr +! CHECK-NEXT: %[[DIM1:.*]] = hlfir.no_reassoc %[[DIM0]] : i32 +! CHECK-NEXT: %[[EXPR:.*]] = hlfir.product %[[ARRAY]]#0 dim %[[DIM1]] {fastmath = #arith.fastmath} : (!fir.box>, i32) -> !hlfir.expr +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr, !fir.box> +! CHECK-NEXT: hlfir.destroy %[[EXPR]] +! CHECK-NEXT: return +! CHECK-NEXT: }