[flang-commits] [flang] [Flang][HLFIR] Lower PACK(array, .TRUE.) to hlfir.reshape (PR #213603)
via flang-commits
flang-commits at lists.llvm.org
Sun Aug 2 23:53:50 PDT 2026
llvmorg-github-actions[bot] wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-fir-hlfir
Author: ejose02
<details>
<summary>Changes</summary>
When the PACK mask is the compile-time scalar .TRUE., the result is equivalent to RESHAPE(array, [SIZE(array)]). Detect this case during HLFIR intrinsic lowering and emit hlfir.reshape, reusing the same operation as the RESHAPE intrinsic rather than calling _FortranAPack.
This allows later optimization passes to handle the operation as a reshape instead of going through the general PACK runtime. Variable or array masks, VECTOR, and non-trivial or polymorphic operands continue to use the existing runtime PACK path.
Assisted by: Claude
---
Full diff: https://github.com/llvm/llvm-project/pull/213603.diff
4 Files Affected:
- (modified) flang/include/flang/Lower/HlfirIntrinsics.h (+6)
- (modified) flang/lib/Lower/ConvertCall.cpp (+32)
- (modified) flang/lib/Lower/HlfirIntrinsics.cpp (+55)
- (added) flang/test/Lower/HLFIR/pack_scalar_true.f90 (+46)
``````````diff
diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h
index 930bbeb6fb452..4ec4cd5a46c51 100644
--- a/flang/include/flang/Lower/HlfirIntrinsics.h
+++ b/flang/include/flang/Lower/HlfirIntrinsics.h
@@ -160,5 +160,11 @@ std::optional<hlfir::EntityWithAttributes> lowerHlfirIntrinsic(
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType);
+std::optional<hlfir::EntityWithAttributes> lowerPackAsReshape(
+ fir::FirOpBuilder &builder, mlir::Location loc,
+ const PreparedActualArguments &loweredActuals,
+ const fir::IntrinsicArgumentLoweringRules *argLowering,
+ mlir::Type stmtResultType);
+
} // namespace Fortran::lower
#endif // FORTRAN_LOWER_HLFIRINTRINSICS_H
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 19678e429249b..59452b2b266f1 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -2372,6 +2372,30 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
/// Lower calls to intrinsic procedures with actual arguments that have been
/// pre-lowered but have not yet been prepared according to the interface.
+static bool isPackWithScalarTrueMask(
+ const Fortran::evaluate::ProcedureRef &procRef,
+ Fortran::lower::AbstractConverter &converter) {
+ if (procRef.arguments().size() < 2 || !procRef.arguments()[1])
+ return false;
+ if (procRef.arguments().size() >= 3 && procRef.arguments()[2])
+ return false;
+ const auto *maskExpr = procRef.UnwrapArgExpr(1);
+ if (!maskExpr)
+ return false;
+ const auto *logExpr =
+ Fortran::evaluate::UnwrapExpr<Fortran::evaluate::Expr<
+ Fortran::evaluate::SomeLogical>>(*maskExpr);
+ if (!logExpr || logExpr->Rank() != 0)
+ return false;
+ auto &ctx = converter.getFoldingContext();
+ auto asDefault = Fortran::evaluate::Fold(
+ ctx, Fortran::evaluate::ConvertToType<Fortran::evaluate::LogicalResult>(
+ Fortran::evaluate::Fold(
+ ctx, Fortran::evaluate::Expr<Fortran::evaluate::SomeLogical>(
+ *logExpr))));
+ return Fortran::evaluate::ToLogical(asDefault).value_or(false);
+}
+
static std::optional<hlfir::EntityWithAttributes> genHLFIRIntrinsicRefCore(
Fortran::lower::PreparedActualArguments &loweredActuals,
const Fortran::evaluate::SpecificIntrinsic *intrinsic,
@@ -2398,6 +2422,14 @@ static std::optional<hlfir::EntityWithAttributes> genHLFIRIntrinsicRefCore(
? hlfir::getFortranElementType(*callContext.resultType)
: *callContext.resultType;
+ if (intrinsicName == "pack" &&
+ isPackWithScalarTrueMask(callContext.procRef, callContext.converter)) {
+ if (std::optional<hlfir::EntityWithAttributes> res =
+ Fortran::lower::lowerPackAsReshape(builder, loc, loweredActuals,
+ argLowering, resultType))
+ return res;
+ }
+
std::optional<hlfir::EntityWithAttributes> res =
Fortran::lower::lowerHlfirIntrinsic(builder, loc, intrinsicName,
loweredActuals, argLowering,
diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp
index 9ee30e52af697..fbb517d251208 100644
--- a/flang/lib/Lower/HlfirIntrinsics.cpp
+++ b/flang/lib/Lower/HlfirIntrinsics.cpp
@@ -209,6 +209,45 @@ class HlfirReshapeLowering : public HlfirTransformationalIntrinsic {
mlir::Type stmtResultType) override;
};
+class HlfirPackAsReshapeLowering : public HlfirTransformationalIntrinsic {
+public:
+ using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
+
+protected:
+ mlir::Value
+ lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
+ const fir::IntrinsicArgumentLoweringRules *argLowering,
+ mlir::Type stmtResultType) override {
+ auto operands = getOperandVector(loweredActuals, argLowering);
+ assert(operands.size() >= 2);
+ mlir::Value array = operands[0];
+ mlir::Type resultType = computeResultType(array, stmtResultType);
+ mlir::Value sizeArray = array;
+ if (!fir::isa_box_type(array.getType())) {
+ hlfir::Entity arrayEntity = loweredActuals[0]->getActual(loc, builder);
+ auto [exv, cleanup] =
+ hlfir::translateToExtendedValue(loc, builder, arrayEntity);
+ addCleanup(cleanup);
+ sizeArray = builder.createBox(loc, exv);
+ }
+ mlir::Value totalSize = fir::runtime::genSize(builder, loc, sizeArray);
+ mlir::Type indexType = builder.getIndexType();
+ mlir::Type extentType = builder.getDefaultIntegerType();
+ mlir::Type shapeSeqType = fir::SequenceType::get({1}, extentType);
+ mlir::Value shapeStorage =
+ builder.createTemporary(loc, shapeSeqType, ".pack.shape");
+ totalSize = builder.createConvert(loc, extentType, totalSize);
+ mlir::Type shapeAddrType = builder.getRefType(extentType);
+ mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
+ mlir::Value shapeAddr = fir::CoordinateOp::create(
+ builder, loc, shapeAddrType, shapeStorage, zero);
+ fir::StoreOp::create(builder, loc, totalSize, shapeAddr);
+ return createOp<hlfir::ReshapeOp>(resultType, array, shapeStorage,
+ /*pad=*/mlir::Value{},
+ /*order=*/mlir::Value{});
+ }
+};
+
class HlfirIndexLowering : public HlfirTransformationalIntrinsic {
public:
using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
@@ -671,3 +710,19 @@ std::optional<hlfir::EntityWithAttributes> Fortran::lower::lowerHlfirIntrinsic(
}
return std::nullopt;
}
+
+std::optional<hlfir::EntityWithAttributes> Fortran::lower::lowerPackAsReshape(
+ fir::FirOpBuilder &builder, mlir::Location loc,
+ const Fortran::lower::PreparedActualArguments &loweredActuals,
+ const fir::IntrinsicArgumentLoweringRules *argLowering,
+ mlir::Type stmtResultType) {
+ if (!loweredActuals[0])
+ return std::nullopt;
+ hlfir::Entity array = loweredActuals[0]->getActual(loc, builder);
+ if (!fir::isa_trivial(array.getFortranElementType()) ||
+ array.isPolymorphic())
+ return std::nullopt;
+ return HlfirPackAsReshapeLowering{builder, loc}.lower(loweredActuals,
+ argLowering,
+ stmtResultType);
+}
diff --git a/flang/test/Lower/HLFIR/pack_scalar_true.f90 b/flang/test/Lower/HLFIR/pack_scalar_true.f90
new file mode 100644
index 0000000000000..bf5b29254acaf
--- /dev/null
+++ b/flang/test/Lower/HLFIR/pack_scalar_true.f90
@@ -0,0 +1,46 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+! RUN: %flang_fc1 %s -o %t.o
+
+! PACK with scalar .TRUE. mask lowers to hlfir.reshape (not _FortranAPack).
+subroutine pack_scalar_true(a, r)
+ integer :: a(:, :, :)
+ integer :: r(:)
+ r = pack(a(:, :, 1), .true.)
+end subroutine pack_scalar_true
+
+! CHECK-LABEL: func.func @_QPpack_scalar_true
+! CHECK-NOT: _FortranAPack
+! CHECK: hlfir.reshape
+
+! Static explicit-shape array (gfortran torture intrinsic_pack.f90 pattern).
+subroutine pack_static_scalar_true
+ integer, dimension(3, 3) :: a
+ integer, dimension(9) :: r
+ r = pack(a, .true.)
+end subroutine pack_static_scalar_true
+
+! CHECK-LABEL: func.func @_QPpack_static_scalar_true
+! CHECK-NOT: _FortranAPack
+! CHECK: hlfir.reshape
+
+! Scalar logical variable mask still uses runtime PACK.
+subroutine pack_scalar_var_mask(a, m, r)
+ integer :: a(:)
+ logical :: m
+ integer :: r(:)
+ r = pack(a, m)
+end subroutine pack_scalar_var_mask
+
+! CHECK-LABEL: func.func @_QPpack_scalar_var_mask
+! CHECK: fir.call @_FortranAPack
+
+! Array mask uses the runtime PACK path.
+subroutine pack_array_mask(a, m, r)
+ integer :: a(:)
+ logical :: m(:)
+ integer :: r(:)
+ r = pack(a, m)
+end subroutine pack_array_mask
+
+! CHECK-LABEL: func.func @_QPpack_array_mask
+! CHECK: fir.call @_FortranAPack
``````````
</details>
https://github.com/llvm/llvm-project/pull/213603
More information about the flang-commits
mailing list