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 @@ -1407,22 +1407,38 @@ return builder.create(loc, resultTy, array, dim, mask); }; + auto buildAnyOperation = [](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); + }; + + auto buildAllOperation = [](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); + }; + auto buildReductionIntrinsic = [&](PreparedActualArguments &loweredActuals, mlir::Location loc, fir::FirOpBuilder &builder, CallContext &callContext, std::function - buildFunc) -> std::optional { + buildFunc, + bool hasMask) -> 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::Value mask; + if (hasMask) + mask = operands[2]; + mlir::Type resultTy = computeResultType(array, *callContext.resultType); auto *intrinsicOp = buildFunc(builder, loc, resultTy, array, dim, mask); return {hlfir::EntityWithAttributes{intrinsicOp->getResult(0)}}; @@ -1431,11 +1447,11 @@ const std::string intrinsicName = callContext.getProcedureName(); if (intrinsicName == "sum") { return buildReductionIntrinsic(loweredActuals, loc, builder, callContext, - buildSumOperation); + buildSumOperation, true); } if (intrinsicName == "product") { return buildReductionIntrinsic(loweredActuals, loc, builder, callContext, - buildProductOperation); + buildProductOperation, true); } if (intrinsicName == "matmul") { llvm::SmallVector operands = getOperandVector(loweredActuals); @@ -1465,17 +1481,12 @@ return {hlfir::EntityWithAttributes{transposeOp.getResult()}}; } if (intrinsicName == "any") { - llvm::SmallVector operands = getOperandVector(loweredActuals); - assert(operands.size() == 2); - // dim argument can be NULL if not given - mlir::Value mask = operands[0]; - mlir::Value dim = operands[1]; - if (dim) - dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim}); - mlir::Type resultTy = computeResultType(mask, *callContext.resultType); - hlfir::AnyOp anyOp = builder.create(loc, resultTy, mask, dim); - - return {hlfir::EntityWithAttributes{anyOp.getResult()}}; + return buildReductionIntrinsic(loweredActuals, loc, builder, callContext, + buildAnyOperation, false); + } + if (intrinsicName == "all") { + return buildReductionIntrinsic(loweredActuals, loc, builder, callContext, + buildAllOperation, false); } // TODO add hlfir operations for other transformational intrinsics here diff --git a/flang/test/Lower/HLFIR/all.f90 b/flang/test/Lower/HLFIR/all.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/all.f90 @@ -0,0 +1,80 @@ +! Test lowering of ALL intrinsic to HLFIR +! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s + +! simple 1 argument ALL +subroutine all1(a, s) + logical :: a(:), s + s = ALL(a) +end subroutine +! CHECK-LABEL: func.func @_QPall1( +! CHECK: %[[ARG0:.*]]: !fir.box>> +! CHECK: %[[ARG1:.*]]: !fir.ref> +! CHECK-DAG: %[[MASK:.*]]:2 = hlfir.declare %[[ARG0]] +! CHECK-DAG: %[[OUT:.*]]:2 = hlfir.declare %[[ARG1]] +! CHECK-NEXT: %[[EXPR:.*]] = hlfir.all %[[MASK]]#0 : (!fir.box>>) -> !fir.logical<4> +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !fir.logical<4>, !fir.ref> +! CHECK-NEXT: return +! CHECK-NEXT: } + +! all with by-ref DIM argument +subroutine all2(a, s, d) + logical :: a(:,:), s(:) + integer :: d +s = ALL(a, d) +end subroutine +! CHECK-LABEL: func.func @_QPall2( +! CHECK: %[[ARG0:.*]]: !fir.box>> {fir.bindc_name = "a"} +! CHECK: %[[ARG1:.*]]: !fir.box>> {fir.bindc_name = "s"} +! CHECK: %[[ARG2:.*]]: !fir.ref {fir.bindc_name = "d"} +! CHECK-DAG: %[[MASK:.*]]:2 = hlfir.declare %[[ARG0]] +! CHECK-DAG: %[[DIM_REF:.*]]:2 = hlfir.declare %[[ARG2]] +! CHECK-DAG: %[[OUT:.*]]:2 = hlfir.declare %[[ARG1]] +! CHECK-NEXT: %[[DIM:.*]] = fir.load %[[DIM_REF]]#0 : !fir.ref +! CHECK-NEXT: %[[EXPR:.*]] = hlfir.all %[[MASK]]#0 dim %[[DIM]] : (!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: } + +! all with DIM argument by-val, mask isn't boxed +subroutine all3(s) + logical :: s(2) + logical :: a(2,2) = reshape((/.true.,.false.,.true.,.false./), shape(a)) +s = ALL(a, 1) +end subroutine +! CHECK-LABEL: func.func @_QPall3( +! CHECK: %[[ARG0:.*]]: !fir.ref>> {fir.bindc_name = "s"} +! CHECK-DAG: %[[ADDR:.*]] = fir.address_of{{.*}} : !fir.ref>> +! CHECK-DAG: %[[MASK_SHAPE:.*]] = fir.shape {{.*}} -> !fir.shape<2> +! CHECK-DAG: %[[MASK:.*]]:2 = hlfir.declare %[[ADDR]](%[[MASK_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: %[[EXPR:.*]] = hlfir.all %[[MASK]]#0 dim %[[C1]] : (!fir.ref>>, i32) -> !hlfir.expr<2x!fir.logical<4>> +! CHECK-DAG: hlfir.assign %[[EXPR]] to %[[OUT]] +! CHECK-NEXT: hlfir.destroy %[[EXPR]] : !hlfir.expr<2x!fir.logical<4>> +! CHECK-NEXT: return +! CHECK-NEXT: } + +! all with DIM from pointer +subroutine all4(a, s, d) + integer, pointer :: d + logical :: a(:,:), s(:) + s = ALL(a, (d)) +end subroutine +! CHECK-LABEL: func.func @_QPall4( +! CHECK: %[[ARG0:.*]]: !fir.box>> {fir.bindc_name = "a"} +! CHECK: %[[ARG1:.*]]: !fir.box>> {fir.bindc_name = "s"} +! CHECK: %[[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.all %[[ARRAY]]#0 dim %[[DIM1]] : (!fir.box>>, i32) -> !hlfir.expr> +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr>, !fir.box>> +! CHECK-NEXT: hlfir.destroy %[[EXPR]] : !hlfir.expr> +! CHECK-NEXT: return +! CHECK-NEXT: }