[flang-commits] [flang] [Flang][HLFIR] Lower PACK(array, .TRUE.) to hlfir.reshape (PR #213603)
via flang-commits
flang-commits at lists.llvm.org
Mon Aug 10 01:25:57 PDT 2026
https://github.com/ejose02 updated https://github.com/llvm/llvm-project/pull/213603
>From 66cb398f78412156bce5fdde9dbde64eed0eb7b2 Mon Sep 17 00:00:00 2001
From: ejose <ejose at amd.com>
Date: Mon, 3 Aug 2026 06:36:01 +0000
Subject: [PATCH 1/3] [Flang][HLFIR] Lower PACK(array, .TRUE.) to hlfir.reshape
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.
---
flang/include/flang/Lower/HlfirIntrinsics.h | 6 +++
flang/lib/Lower/ConvertCall.cpp | 31 ++++++++++++
flang/lib/Lower/HlfirIntrinsics.cpp | 54 +++++++++++++++++++++
flang/test/Lower/HLFIR/pack_scalar_true.f90 | 46 ++++++++++++++++++
4 files changed, 137 insertions(+)
create mode 100644 flang/test/Lower/HLFIR/pack_scalar_true.f90
diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h
index 930bbeb6fb452..98e088afc4051 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..2466844e81c9b 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -2372,6 +2372,29 @@ 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 +2421,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..c1dbc7f24747a 100644
--- a/flang/lib/Lower/HlfirIntrinsics.cpp
+++ b/flang/lib/Lower/HlfirIntrinsics.cpp
@@ -17,6 +17,7 @@
#include "flang/Optimizer/Builder/HLFIRTools.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Builder/MutableBox.h"
+#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIRType.h"
#include "flang/Optimizer/HLFIR/HLFIRDialect.h"
@@ -209,6 +210,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 +711,17 @@ 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
>From e51d447518e8a2e45dc4be178c4472d20cb91f1b Mon Sep 17 00:00:00 2001
From: ejose <ejose at amd.com>
Date: Fri, 7 Aug 2026 11:25:42 +0000
Subject: [PATCH 2/3] Route all PACK through hlfir.pack with runtime fallback;
rewrite pack(array, .true.) to reshape in SimplifyHLFIRIntrinsics so the fast
path can apply after constprop. Build SHAPE from extent product as default
INTEGER. Added tests for the .true. case of PACK.
---
flang/include/flang/Lower/HlfirIntrinsics.h | 6 --
.../include/flang/Optimizer/HLFIR/HLFIROps.td | 21 ++++++
flang/lib/Lower/ConvertCall.cpp | 33 --------
flang/lib/Lower/HlfirIntrinsics.cpp | 61 ++++-----------
flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp | 28 +++++++
.../HLFIR/Transforms/LowerHLFIRIntrinsics.cpp | 49 ++++++++++--
.../Transforms/SimplifyHLFIRIntrinsics.cpp | 75 ++++++++++++++++---
.../HLFIR/simplify-hlfir-intrinsics-pack.fir | 30 ++++++++
flang/test/Lower/HLFIR/pack_scalar_true.f90 | 22 +++---
flang/test/Lower/Intrinsics/pack.f90 | 21 +-----
flang/test/Lower/polymorphic-temp.f90 | 11 +--
11 files changed, 217 insertions(+), 140 deletions(-)
create mode 100644 flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir
diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h
index 98e088afc4051..930bbeb6fb452 100644
--- a/flang/include/flang/Lower/HlfirIntrinsics.h
+++ b/flang/include/flang/Lower/HlfirIntrinsics.h
@@ -160,11 +160,5 @@ 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/include/flang/Optimizer/HLFIR/HLFIROps.td b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
index f05554079816c..bc65a8f4a7998 100644
--- a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
@@ -831,6 +831,27 @@ def hlfir_EOShiftOp
let hasVerifier = 1;
}
+def hlfir_PackOp
+ : hlfir_Op<
+ "pack", [DeclareOpInterfaceMethods<MemoryEffectsOpInterface>]> {
+ let summary = "PACK transformational intrinsic";
+ let description = [{
+ Selects elements from an array according to a mask.
+ }];
+
+ let arguments = (ins AnyFortranArrayObject:$array,
+ AnyFortranLogicalOrI1ArrayObject:$mask,
+ Optional<AnyFortranArrayObject>:$vector);
+
+ let results = (outs hlfir_ExprType);
+
+ let assemblyFormat = [{
+ $array $mask (`vector` $vector^)? attr-dict `:` functional-type(operands, results)
+ }];
+
+ let hasVerifier = 1;
+}
+
def hlfir_ReshapeOp
: hlfir_Op<
"reshape", [AttrSizedOperandSegments,
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 2466844e81c9b..de50660479f81 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -2370,31 +2370,6 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
return resultEntity;
}
-/// 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,
@@ -2421,14 +2396,6 @@ 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 c1dbc7f24747a..f839c869d236b 100644
--- a/flang/lib/Lower/HlfirIntrinsics.cpp
+++ b/flang/lib/Lower/HlfirIntrinsics.cpp
@@ -17,7 +17,6 @@
#include "flang/Optimizer/Builder/HLFIRTools.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Builder/MutableBox.h"
-#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIRType.h"
#include "flang/Optimizer/HLFIR/HLFIRDialect.h"
@@ -210,7 +209,7 @@ class HlfirReshapeLowering : public HlfirTransformationalIntrinsic {
mlir::Type stmtResultType) override;
};
-class HlfirPackAsReshapeLowering : public HlfirTransformationalIntrinsic {
+class HlfirPackLowering : public HlfirTransformationalIntrinsic {
public:
using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
@@ -218,35 +217,7 @@ class HlfirPackAsReshapeLowering : public HlfirTransformationalIntrinsic {
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{});
- }
+ mlir::Type stmtResultType) override;
};
class HlfirIndexLowering : public HlfirTransformationalIntrinsic {
@@ -606,6 +577,17 @@ mlir::Value HlfirReshapeLowering::lowerImpl(
operands[2], operands[3]);
}
+mlir::Value HlfirPackLowering::lowerImpl(
+ const Fortran::lower::PreparedActualArguments &loweredActuals,
+ const fir::IntrinsicArgumentLoweringRules *argLowering,
+ mlir::Type stmtResultType) {
+ auto operands = getOperandVector(loweredActuals, argLowering);
+ assert(operands.size() >= 2);
+ mlir::Type resultType = computeResultType(operands[0], stmtResultType);
+ mlir::Value vector = operands.size() >= 3 ? operands[2] : mlir::Value{};
+ return createOp<hlfir::PackOp>(resultType, operands[0], operands[1], vector);
+}
+
mlir::Value HlfirIndexLowering::lowerImpl(
const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
@@ -689,6 +671,9 @@ std::optional<hlfir::EntityWithAttributes> Fortran::lower::lowerHlfirIntrinsic(
if (name == "reshape")
return HlfirReshapeLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
+ if (name == "pack")
+ return HlfirPackLowering{builder, loc}.lower(loweredActuals, argLowering,
+ stmtResultType);
if (name == "index")
return HlfirIndexLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
@@ -711,17 +696,3 @@ 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/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
index 53c9b6f500d05..f13edcf8aadc9 100644
--- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
+++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
@@ -1682,6 +1682,34 @@ void hlfir::EOShiftOp::getEffects(
getIntrinsicEffects(getOperation(), effects);
}
+//===----------------------------------------------------------------------===//
+// PackOp
+//===----------------------------------------------------------------------===//
+
+llvm::LogicalResult hlfir::PackOp::verify() {
+ hlfir::ExprType resultType = mlir::cast<hlfir::ExprType>(getType());
+ mlir::Value array = getArray();
+ if (auto match = areMatchingTypes(
+ *this, hlfir::getFortranElementType(resultType),
+ hlfir::getFortranElementType(array.getType()),
+ /*allowCharacterLenMismatch=*/!useStrictIntrinsicVerifier);
+ match.failed())
+ return emitOpError("ARRAY and the result must have the same element type");
+ if (hlfir::isPolymorphicType(resultType) !=
+ hlfir::isPolymorphicType(array.getType()))
+ return emitOpError("ARRAY must be polymorphic iff result is polymorphic");
+ if (!hlfir::isMaskArgument(getMask().getType()))
+ return emitOpError("MASK must be of logical type");
+ return mlir::success();
+}
+
+void hlfir::PackOp::getEffects(
+ llvm::SmallVectorImpl<
+ mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
+ &effects) {
+ getIntrinsicEffects(getOperation(), effects);
+}
+
//===----------------------------------------------------------------------===//
// ReshapeOp
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp b/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp
index 6ef52f4b4033c..daa072f8ad67f 100644
--- a/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp
@@ -512,6 +512,38 @@ class ArrayShiftOpConversion : public HlfirIntrinsicConversion<T> {
}
};
+class PackOpConversion : public HlfirIntrinsicConversion<hlfir::PackOp> {
+ using HlfirIntrinsicConversion<hlfir::PackOp>::HlfirIntrinsicConversion;
+
+ llvm::LogicalResult
+ matchAndRewrite(hlfir::PackOp pack,
+ mlir::PatternRewriter &rewriter) const override {
+ fir::FirOpBuilder builder{rewriter, pack.getOperation()};
+ const mlir::Location &loc = pack->getLoc();
+
+ llvm::SmallVector<IntrinsicArgument, 3> inArgs;
+ mlir::Value array = pack.getArray();
+ inArgs.push_back({array, array.getType()});
+ mlir::Value mask = pack.getMask();
+ inArgs.push_back({mask, mask.getType()});
+ mlir::Type noneType = builder.getNoneType();
+ mlir::Value vector = pack.getVector();
+ inArgs.push_back({vector, vector ? vector.getType() : noneType});
+
+ auto *argLowering = fir::getIntrinsicArgumentLowering("pack");
+ llvm::SmallVector<fir::ExtendedValue, 3> args =
+ lowerArguments(pack, inArgs, rewriter, argLowering);
+
+ mlir::Type scalarResultType = hlfir::getFortranElementType(pack.getType());
+
+ auto [resultExv, mustBeFreed] =
+ fir::genIntrinsicCall(builder, loc, "pack", scalarResultType, args);
+
+ processReturnValue(pack, resultExv, mustBeFreed, builder, rewriter);
+ return mlir::success();
+ }
+};
+
class ReshapeOpConversion : public HlfirIntrinsicConversion<hlfir::ReshapeOp> {
using HlfirIntrinsicConversion<hlfir::ReshapeOp>::HlfirIntrinsicConversion;
@@ -655,14 +687,15 @@ class LowerHLFIRIntrinsics
mlir::ModuleOp module = this->getOperation();
mlir::MLIRContext *context = &getContext();
mlir::RewritePatternSet patterns(context);
- patterns.insert<
- MatmulOpConversion, MatmulTransposeOpConversion, AllOpConversion,
- AnyOpConversion, SumOpConversion, ProductOpConversion,
- TransposeOpConversion, CountOpConversion, DotProductOpConversion,
- MaxvalOpConversion, MinvalOpConversion, MinlocOpConversion,
- MaxlocOpConversion, ArrayShiftOpConversion<hlfir::CShiftOp>,
- ArrayShiftOpConversion<hlfir::EOShiftOp>, ReshapeOpConversion,
- CmpCharOpConversion, CharTrimOpConversion, IndexOpConversion>(context);
+ patterns.insert<MatmulOpConversion, MatmulTransposeOpConversion,
+ AllOpConversion, AnyOpConversion, SumOpConversion,
+ ProductOpConversion, TransposeOpConversion,
+ CountOpConversion, DotProductOpConversion,
+ MaxvalOpConversion, MinvalOpConversion, MinlocOpConversion,
+ MaxlocOpConversion, ArrayShiftOpConversion<hlfir::CShiftOp>,
+ ArrayShiftOpConversion<hlfir::EOShiftOp>, PackOpConversion,
+ ReshapeOpConversion, 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/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp b/flang/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp
index 716737bb80ff4..c0fc82eff2e81 100644
--- a/flang/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp
@@ -15,6 +15,7 @@
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/HLFIRTools.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
+#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Optimizer/HLFIR/HLFIRDialect.h"
#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include "flang/Optimizer/HLFIR/Passes.h"
@@ -3068,6 +3069,67 @@ class DotProductConversion
}
};
+static mlir::Value computeArraySize(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ mlir::ValueRange extents) {
+ mlir::Type indexType = builder.getIndexType();
+ mlir::Value size = builder.createIntegerConstant(loc, indexType, 1);
+ for (mlir::Value extent : extents)
+ size = mlir::arith::MulIOp::create(
+ builder, loc, size, builder.createConvert(loc, indexType, extent));
+ return size;
+}
+
+static std::optional<bool> getLogicalConstant(mlir::Value value) {
+ if (auto convertOp = value.getDefiningOp<fir::ConvertOp>())
+ value = convertOp.getValue();
+ if (auto cst = fir::getIntIfConstant(value))
+ return *cst != 0;
+ return std::nullopt;
+}
+
+class PackAsReshapeConversion : public mlir::OpRewritePattern<hlfir::PackOp> {
+public:
+ using mlir::OpRewritePattern<hlfir::PackOp>::OpRewritePattern;
+
+ llvm::LogicalResult
+ matchAndRewrite(hlfir::PackOp pack,
+ mlir::PatternRewriter &rewriter) const override {
+ if (pack.getVector())
+ return rewriter.notifyMatchFailure(pack, "PACK with VECTOR");
+ hlfir::Entity mask{pack.getMask()};
+ if (mask.getRank() != 0)
+ return rewriter.notifyMatchFailure(pack, "non-scalar mask");
+ if (!getLogicalConstant(pack.getMask()).value_or(false))
+ return rewriter.notifyMatchFailure(pack, "mask is not .TRUE.");
+ hlfir::Entity array{pack.getArray()};
+ if (!fir::isa_trivial(array.getFortranElementType()) ||
+ array.isPolymorphic())
+ return rewriter.notifyMatchFailure(pack, "unsupported array type");
+
+ mlir::Location loc = pack.getLoc();
+ fir::FirOpBuilder builder{rewriter, pack.getOperation()};
+ llvm::SmallVector<mlir::Value, Fortran::common::maxRank> extents =
+ hlfir::genExtentsVector(loc, builder, array);
+ mlir::Value totalSize = computeArraySize(loc, builder, extents);
+ 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 indexType = builder.getIndexType();
+ mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
+ mlir::Value shapeAddr = fir::CoordinateOp::create(
+ builder, loc, builder.getRefType(extentType), shapeStorage, zero);
+ fir::StoreOp::create(builder, loc, totalSize, shapeAddr);
+ auto reshape = hlfir::ReshapeOp::create(
+ builder, loc, pack.getType(), array, shapeStorage,
+ /*pad=*/mlir::Value{}, /*order=*/mlir::Value{});
+ rewriter.replaceOp(pack, reshape);
+ return mlir::success();
+ }
+};
+
class ReshapeAsElementalConversion
: public mlir::OpRewritePattern<hlfir::ReshapeOp> {
public:
@@ -3268,18 +3330,6 @@ class ReshapeAsElementalConversion
}
return indices;
}
-
- /// Return size of an array given its extents.
- static mlir::Value computeArraySize(mlir::Location loc,
- fir::FirOpBuilder &builder,
- mlir::ValueRange extents) {
- mlir::Type indexType = builder.getIndexType();
- mlir::Value size = builder.createIntegerConstant(loc, indexType, 1);
- for (auto extent : extents)
- size = mlir::arith::MulIOp::create(
- builder, loc, size, builder.createConvert(loc, indexType, extent));
- return size;
- }
};
class SimplifyHLFIRIntrinsics
@@ -3333,6 +3383,7 @@ class SimplifyHLFIRIntrinsics
patterns.insert<MatmulConversion<hlfir::MatmulOp>>(context);
patterns.insert<DotProductConversion>(context);
+ patterns.insert<PackAsReshapeConversion>(context);
patterns.insert<ReshapeAsElementalConversion>(context);
if (mlir::failed(mlir::applyPatternsGreedily(
diff --git a/flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir b/flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir
new file mode 100644
index 0000000000000..80fcc18c44a7e
--- /dev/null
+++ b/flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir
@@ -0,0 +1,30 @@
+// RUN: fir-opt --simplify-hlfir-intrinsics %s | FileCheck %s
+
+func.func @pack_scalar_true_mask(%arg0: !fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32> {
+ %true = arith.constant 1 : i1
+ %mask = fir.convert %true : (i1) -> !fir.logical<4>
+ %res = hlfir.pack %arg0 %mask : (!fir.box<!fir.array<?xi32>>, !fir.logical<4>) -> !hlfir.expr<?xi32>
+ return %res : !hlfir.expr<?xi32>
+}
+// CHECK-LABEL: func.func @pack_scalar_true_mask
+// CHECK-NOT: hlfir.pack
+// CHECK: hlfir.elemental
+
+func.func @pack_var_mask(%arg0: !fir.box<!fir.array<?xi32>>, %arg1: !fir.ref<!fir.logical<4>>) -> !hlfir.expr<?xi32> {
+ %mask = fir.load %arg1 : !fir.ref<!fir.logical<4>>
+ %res = hlfir.pack %arg0 %mask : (!fir.box<!fir.array<?xi32>>, !fir.logical<4>) -> !hlfir.expr<?xi32>
+ return %res : !hlfir.expr<?xi32>
+}
+// CHECK-LABEL: func.func @pack_var_mask
+// CHECK: hlfir.pack
+// CHECK-NOT: hlfir.reshape
+
+func.func @pack_with_vector(%arg0: !fir.box<!fir.array<?xi32>>, %arg1: !fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32> {
+ %true = arith.constant 1 : i1
+ %mask = fir.convert %true : (i1) -> !fir.logical<4>
+ %res = hlfir.pack %arg0 %mask vector %arg1 : (!fir.box<!fir.array<?xi32>>, !fir.logical<4>, !fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32>
+ return %res : !hlfir.expr<?xi32>
+}
+// CHECK-LABEL: func.func @pack_with_vector
+// CHECK: hlfir.pack
+// CHECK-NOT: hlfir.reshape
diff --git a/flang/test/Lower/HLFIR/pack_scalar_true.f90 b/flang/test/Lower/HLFIR/pack_scalar_true.f90
index bf5b29254acaf..01eef03105a04 100644
--- a/flang/test/Lower/HLFIR/pack_scalar_true.f90
+++ b/flang/test/Lower/HLFIR/pack_scalar_true.f90
@@ -1,7 +1,7 @@
! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -O2 -S %s -o - | FileCheck %s --check-prefix=OPT
! 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(:)
@@ -9,10 +9,11 @@ subroutine pack_scalar_true(a, r)
end subroutine pack_scalar_true
! CHECK-LABEL: func.func @_QPpack_scalar_true
-! CHECK-NOT: _FortranAPack
-! CHECK: hlfir.reshape
+! CHECK: hlfir.pack
+! CHECK-NOT: hlfir.reshape
+! OPT-LABEL: pack_scalar_true_
+! OPT-NOT: _FortranAPack
-! Static explicit-shape array (gfortran torture intrinsic_pack.f90 pattern).
subroutine pack_static_scalar_true
integer, dimension(3, 3) :: a
integer, dimension(9) :: r
@@ -20,10 +21,10 @@ subroutine pack_static_scalar_true
end subroutine pack_static_scalar_true
! CHECK-LABEL: func.func @_QPpack_static_scalar_true
-! CHECK-NOT: _FortranAPack
-! CHECK: hlfir.reshape
+! CHECK: hlfir.pack
+! CHECK-NOT: hlfir.reshape
+! OPT-LABEL: pack_static_scalar_true_
-! Scalar logical variable mask still uses runtime PACK.
subroutine pack_scalar_var_mask(a, m, r)
integer :: a(:)
logical :: m
@@ -32,9 +33,9 @@ subroutine pack_scalar_var_mask(a, m, r)
end subroutine pack_scalar_var_mask
! CHECK-LABEL: func.func @_QPpack_scalar_var_mask
-! CHECK: fir.call @_FortranAPack
+! CHECK: hlfir.pack
+! CHECK-NOT: hlfir.reshape
-! Array mask uses the runtime PACK path.
subroutine pack_array_mask(a, m, r)
integer :: a(:)
logical :: m(:)
@@ -43,4 +44,5 @@ subroutine pack_array_mask(a, m, r)
end subroutine pack_array_mask
! CHECK-LABEL: func.func @_QPpack_array_mask
-! CHECK: fir.call @_FortranAPack
+! CHECK: hlfir.pack
+! CHECK-NOT: hlfir.reshape
diff --git a/flang/test/Lower/Intrinsics/pack.f90 b/flang/test/Lower/Intrinsics/pack.f90
index 777b5e65ebbd9..65f8b74153bb6 100644
--- a/flang/test/Lower/Intrinsics/pack.f90
+++ b/flang/test/Lower/Intrinsics/pack.f90
@@ -10,16 +10,12 @@ subroutine pack_test(a,m,v,r)
logical :: m(:)
integer :: v(:)
integer :: r(:)
-! CHECK-DAG: %[[a0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
! CHECK-DAG: %[[A:.*]]:2 = hlfir.declare %[[arg0]]
! CHECK-DAG: %[[M:.*]]:2 = hlfir.declare %[[arg1]]
! CHECK-DAG: %[[V:.*]]:2 = hlfir.declare %[[arg2]]
r = pack(a,m,v)
-! CHECK: %[[a5:.*]] = fir.convert %[[a0]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %[[a6:.*]] = fir.convert %[[A]]#1 : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
-! CHECK: %[[a7:.*]] = fir.convert %[[M]]#1 : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> !fir.box<none>
-! CHECK: %[[a8:.*]] = fir.convert %[[V]]#1 : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
-! CHECK: fir.call @_FortranAPack(%[[a5]], %[[a6]], %[[a7]], %[[a8]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
+! CHECK: hlfir.pack
+! CHECK-NOT: fir.call @_FortranAPack
end subroutine
! CHECK-LABEL: func.func @_QPtest_pack_optional(
@@ -29,15 +25,6 @@ subroutine test_pack_optional(vector, array, mask)
integer :: array(:, :)
logical :: mask(:, :)
print *, pack(array, mask, vector)
- ! CHECK: %[[VDECL:.*]]:2 = hlfir.declare %[[VAL_0]]
- ! CHECK: %[[VAL_9:.*]] = fir.load %[[VDECL]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
- ! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_9]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.ptr<!fir.array<?xi32>>
- ! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.ptr<!fir.array<?xi32>>) -> i64
- ! CHECK: %[[VAL_12:.*]] = arith.constant 0 : i64
- ! CHECK: %[[VAL_13:.*]] = arith.cmpi ne, %[[VAL_11]], %[[VAL_12]] : i64
- ! CHECK: %[[VAL_14:.*]] = fir.load %[[VDECL]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
- ! CHECK: %[[VAL_15:.*]] = fir.absent !fir.box<!fir.ptr<!fir.array<?xi32>>>
- ! CHECK: %[[VAL_16:.*]] = arith.select %[[VAL_13]], %[[VAL_14]], %[[VAL_15]] : !fir.box<!fir.ptr<!fir.array<?xi32>>>
- ! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_16]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.box<none>
- ! CHECK: fir.call @_FortranAPack(%{{.*}}, %{{.*}}, %{{.*}}, %[[VAL_26]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
+ ! CHECK: hlfir.pack
+ ! CHECK-NOT: fir.call @_FortranAPack
end subroutine
diff --git a/flang/test/Lower/polymorphic-temp.f90 b/flang/test/Lower/polymorphic-temp.f90
index cb52a1b9f5581..e082ed1b2d779 100644
--- a/flang/test/Lower/polymorphic-temp.f90
+++ b/flang/test/Lower/polymorphic-temp.f90
@@ -86,17 +86,10 @@ subroutine test_temp_from_intrinsic_pack(i, mask)
! CHECK-LABEL: func.func @_QMpoly_tmpPtest_temp_from_intrinsic_pack(
! CHECK-SAME: %[[I:.*]]: !fir.class<!fir.array<20x20x!fir.type<_QMpoly_tmpTp1{a:i32}>>> {fir.bindc_name = "i"}, %[[MASK:.*]]: !fir.ref<!fir.array<20x20x!fir.logical<4>>> {fir.bindc_name = "mask"}) {
-! CHECK: %[[TMP_RES:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpoly_tmpTp1{a:i32}>>>>
! CHECK: %[[I_DECL:.*]]:2 = hlfir.declare %[[I]]
! CHECK: %[[MASK_DECL:.*]]:2 = hlfir.declare %[[MASK]]
-! CHECK: %[[EMBOXED_MASK:.*]] = fir.embox %[[MASK_DECL]]#0(%{{.*}}) : (!fir.ref<!fir.array<20x20x!fir.logical<4>>>, !fir.shape<2>) -> !fir.box<!fir.array<20x20x!fir.logical<4>>>
-! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.type<_QMpoly_tmpTp1{a:i32}>>>
-! CHECK: %[[EMBOX_RES:.*]] = fir.embox %[[ZERO]](%{{.*}}) source_box %[[I_DECL]]#1 : (!fir.heap<!fir.array<?x!fir.type<_QMpoly_tmpTp1{a:i32}>>>, !fir.shape<1>, !fir.class<!fir.array<20x20x!fir.type<_QMpoly_tmpTp1{a:i32}>>>) -> !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpoly_tmpTp1{a:i32}>>>>
-! CHECK: fir.store %[[EMBOX_RES]] to %[[TMP_RES]] : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpoly_tmpTp1{a:i32}>>>>>
-! CHECK: %[[RES_BOX_NONE:.*]] = fir.convert %[[TMP_RES]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpoly_tmpTp1{a:i32}>>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %[[I_BOX_NONE:.*]] = fir.convert %[[I_DECL]]#1 : (!fir.class<!fir.array<20x20x!fir.type<_QMpoly_tmpTp1{a:i32}>>>) -> !fir.box<none>
-! CHECK: %[[MASK_BOX_NONE:.*]] = fir.convert %[[EMBOXED_MASK]] : (!fir.box<!fir.array<20x20x!fir.logical<4>>>) -> !fir.box<none>
-! CHECK: fir.call @_FortranAPack(%[[RES_BOX_NONE]], %[[I_BOX_NONE]], %[[MASK_BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
+! CHECK: hlfir.pack
+! CHECK-NOT: fir.call @_FortranAPack
subroutine check_rank2(r)
class(p1), intent(in) :: r(:,:)
>From 7f6b266f774e3dba24fb1c9b1628e344c92a95f1 Mon Sep 17 00:00:00 2001
From: ejose <ejose at amd.com>
Date: Mon, 10 Aug 2026 08:24:19 +0000
Subject: [PATCH 3/3] Route PACK through hlfir.pack as before, but in
SimplifyHLFIRIntrinsics recognize pack(array, .TRUE.) and lower it straight
to hlfir.elemental using fir.shape of the index extent product, avoiding
runtime _FortranAPack and stack SHAPE temporaries. Restore the ConvertCall
doc comment and expand simplify-hlfir-intrinsics-pack.fir coverage.
---
flang/lib/Lower/ConvertCall.cpp | 2 +
.../Transforms/SimplifyHLFIRIntrinsics.cpp | 169 ++++++++----------
.../HLFIR/simplify-hlfir-intrinsics-pack.fir | 84 ++++++++-
3 files changed, 155 insertions(+), 100 deletions(-)
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index de50660479f81..19678e429249b 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -2370,6 +2370,8 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
return resultEntity;
}
+/// Lower calls to intrinsic procedures with actual arguments that have been
+/// pre-lowered but have not yet been prepared according to the interface.
static std::optional<hlfir::EntityWithAttributes> genHLFIRIntrinsicRefCore(
Fortran::lower::PreparedActualArguments &loweredActuals,
const Fortran::evaluate::SpecificIntrinsic *intrinsic,
diff --git a/flang/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp b/flang/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp
index c0fc82eff2e81..3b158969a40ec 100644
--- a/flang/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp
@@ -3080,6 +3080,55 @@ static mlir::Value computeArraySize(mlir::Location loc,
return size;
}
+static mlir::Value computeLinearIndex(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ mlir::ValueRange extents,
+ mlir::ValueRange indices) {
+ std::size_t rank = extents.size();
+ assert(rank == indices.size());
+ mlir::Type indexType = builder.getIndexType();
+ mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
+ mlir::Value one = builder.createIntegerConstant(loc, indexType, 1);
+ mlir::Value linearIndex = zero;
+ std::size_t idx = 0;
+ for (auto index : llvm::reverse(indices)) {
+ mlir::Value tmp = mlir::arith::SubIOp::create(
+ builder, loc, builder.createConvert(loc, indexType, index), one);
+ tmp = mlir::arith::AddIOp::create(builder, loc, linearIndex, tmp);
+ if (idx + 1 < rank)
+ tmp = mlir::arith::MulIOp::create(
+ builder, loc, tmp,
+ builder.createConvert(loc, indexType, extents[rank - idx - 2]));
+
+ linearIndex = tmp;
+ ++idx;
+ }
+ return linearIndex;
+}
+
+static llvm::SmallVector<mlir::Value, Fortran::common::maxRank>
+delinearizeIndex(mlir::Location loc, fir::FirOpBuilder &builder,
+ mlir::ValueRange extents, mlir::Value linearIndex,
+ bool wrapAround) {
+ llvm::SmallVector<mlir::Value, Fortran::common::maxRank> indices;
+ mlir::Type indexType = builder.getIndexType();
+ mlir::Value one = builder.createIntegerConstant(loc, indexType, 1);
+ linearIndex = builder.createConvert(loc, indexType, linearIndex);
+
+ for (std::size_t dim = 0; dim < extents.size(); ++dim) {
+ mlir::Value extent = builder.createConvert(loc, indexType, extents[dim]);
+ mlir::Value currentIndex = linearIndex;
+ if (dim != extents.size() - 1 || wrapAround)
+ currentIndex =
+ mlir::arith::RemUIOp::create(builder, loc, linearIndex, extent);
+ linearIndex =
+ mlir::arith::DivUIOp::create(builder, loc, linearIndex, extent);
+ indices.push_back(
+ mlir::arith::AddIOp::create(builder, loc, currentIndex, one));
+ }
+ return indices;
+}
+
static std::optional<bool> getLogicalConstant(mlir::Value value) {
if (auto convertOp = value.getDefiningOp<fir::ConvertOp>())
value = convertOp.getValue();
@@ -3109,23 +3158,36 @@ class PackAsReshapeConversion : public mlir::OpRewritePattern<hlfir::PackOp> {
mlir::Location loc = pack.getLoc();
fir::FirOpBuilder builder{rewriter, pack.getOperation()};
- llvm::SmallVector<mlir::Value, Fortran::common::maxRank> extents =
+ builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::nuw);
+
+ llvm::SmallVector<mlir::Value, Fortran::common::maxRank> arrayExtents =
hlfir::genExtentsVector(loc, builder, array);
- mlir::Value totalSize = computeArraySize(loc, builder, extents);
- 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 indexType = builder.getIndexType();
- mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
- mlir::Value shapeAddr = fir::CoordinateOp::create(
- builder, loc, builder.getRefType(extentType), shapeStorage, zero);
- fir::StoreOp::create(builder, loc, totalSize, shapeAddr);
- auto reshape = hlfir::ReshapeOp::create(
- builder, loc, pack.getType(), array, shapeStorage,
- /*pad=*/mlir::Value{}, /*order=*/mlir::Value{});
- rewriter.replaceOp(pack, reshape);
+ mlir::Value totalSize = computeArraySize(loc, builder, arrayExtents);
+ mlir::Type elementType = array.getFortranElementType();
+
+ llvm::SmallVector<mlir::Value, 1> typeParams;
+ hlfir::genLengthParameters(loc, builder, array, typeParams);
+ mlir::Value resultShape = fir::ShapeOp::create(builder, loc, totalSize);
+ llvm::SmallVector<mlir::Value, 1> resultExtents{totalSize};
+
+ auto genKernel = [&](mlir::Location loc, fir::FirOpBuilder &builder,
+ mlir::ValueRange inputIndices) -> hlfir::Entity {
+ mlir::Value linearIndex =
+ computeLinearIndex(loc, builder, resultExtents, inputIndices);
+ llvm::SmallVector<mlir::Value, Fortran::common::maxRank> arrayIndices =
+ delinearizeIndex(loc, builder, arrayExtents, linearIndex,
+ /*wrapAround=*/false);
+ mlir::Value arrayElement =
+ hlfir::loadElementAt(loc, builder, array, arrayIndices);
+ return hlfir::Entity{arrayElement};
+ };
+ hlfir::ElementalOp elementalOp = hlfir::genElementalOp(
+ loc, builder, elementType, resultShape, typeParams, genKernel,
+ /*isUnordered=*/true,
+ /*polymorphicMold=*/hlfir::Entity{pack}.isPolymorphic() ? array
+ : mlir::Value{},
+ pack.getType());
+ rewriter.replaceOp(pack, elementalOp);
return mlir::success();
}
};
@@ -3255,81 +3317,6 @@ class ReshapeAsElementalConversion
rewriter.replaceOp(reshape, elementalOp);
return mlir::success();
}
-
-private:
- /// Compute zero-based linear index given an array extents
- /// and one-based indices:
- /// \p extents: [e0, e1, ..., en]
- /// \p indices: [i0, i1, ..., in]
- ///
- /// linear-index :=
- /// (...((in-1)*e(n-1)+(i(n-1)-1))*e(n-2)+...)*e0+(i0-1)
- static mlir::Value computeLinearIndex(mlir::Location loc,
- fir::FirOpBuilder &builder,
- mlir::ValueRange extents,
- mlir::ValueRange indices) {
- std::size_t rank = extents.size();
- assert(rank == indices.size());
- mlir::Type indexType = builder.getIndexType();
- mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
- mlir::Value one = builder.createIntegerConstant(loc, indexType, 1);
- mlir::Value linearIndex = zero;
- std::size_t idx = 0;
- for (auto index : llvm::reverse(indices)) {
- mlir::Value tmp = mlir::arith::SubIOp::create(
- builder, loc, builder.createConvert(loc, indexType, index), one);
- tmp = mlir::arith::AddIOp::create(builder, loc, linearIndex, tmp);
- if (idx + 1 < rank)
- tmp = mlir::arith::MulIOp::create(
- builder, loc, tmp,
- builder.createConvert(loc, indexType, extents[rank - idx - 2]));
-
- linearIndex = tmp;
- ++idx;
- }
- return linearIndex;
- }
-
- /// Compute one-based array indices from the given zero-based \p linearIndex
- /// and the array \p extents [e0, e1, ..., en].
- /// i0 := linearIndex % e0 + 1
- /// linearIndex := linearIndex / e0
- /// i1 := linearIndex % e1 + 1
- /// linearIndex := linearIndex / e1
- /// ...
- /// i(n-1) := linearIndex % e(n-1) + 1
- /// linearIndex := linearIndex / e(n-1)
- /// if (wrapAround) {
- /// // If the index is allowed to wrap around, then
- /// // we need to modulo it by the last dimension's extent.
- /// in := linearIndex % en + 1
- /// } else {
- /// in := linearIndex + 1
- /// }
- static llvm::SmallVector<mlir::Value, Fortran::common::maxRank>
- delinearizeIndex(mlir::Location loc, fir::FirOpBuilder &builder,
- mlir::ValueRange extents, mlir::Value linearIndex,
- bool wrapAround) {
- llvm::SmallVector<mlir::Value, Fortran::common::maxRank> indices;
- mlir::Type indexType = builder.getIndexType();
- mlir::Value one = builder.createIntegerConstant(loc, indexType, 1);
- linearIndex = builder.createConvert(loc, indexType, linearIndex);
-
- for (std::size_t dim = 0; dim < extents.size(); ++dim) {
- mlir::Value extent = builder.createConvert(loc, indexType, extents[dim]);
- // Avoid the modulo for the last index, unless wrap around is allowed.
- mlir::Value currentIndex = linearIndex;
- if (dim != extents.size() - 1 || wrapAround)
- currentIndex =
- mlir::arith::RemUIOp::create(builder, loc, linearIndex, extent);
- // The result of the last division is unused, so it will be DCEd.
- linearIndex =
- mlir::arith::DivUIOp::create(builder, loc, linearIndex, extent);
- indices.push_back(
- mlir::arith::AddIOp::create(builder, loc, currentIndex, one));
- }
- return indices;
- }
};
class SimplifyHLFIRIntrinsics
diff --git a/flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir b/flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir
index 80fcc18c44a7e..0c2955b8ba802 100644
--- a/flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir
+++ b/flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir
@@ -1,3 +1,4 @@
+// Test hlfir.pack simplification for scalar .TRUE. mask:
// RUN: fir-opt --simplify-hlfir-intrinsics %s | FileCheck %s
func.func @pack_scalar_true_mask(%arg0: !fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32> {
@@ -6,18 +7,79 @@ func.func @pack_scalar_true_mask(%arg0: !fir.box<!fir.array<?xi32>>) -> !hlfir.e
%res = hlfir.pack %arg0 %mask : (!fir.box<!fir.array<?xi32>>, !fir.logical<4>) -> !hlfir.expr<?xi32>
return %res : !hlfir.expr<?xi32>
}
-// CHECK-LABEL: func.func @pack_scalar_true_mask
-// CHECK-NOT: hlfir.pack
-// CHECK: hlfir.elemental
+// CHECK-LABEL: func.func @pack_scalar_true_mask(
+// CHECK-SAME: %[[ARRAY:.*]]: !fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32> {
+// CHECK: %[[C1:.*]] = arith.constant 1 : index
+// CHECK: %[[C0:.*]] = arith.constant 0 : index
+// CHECK: %[[DIM0:.*]]:3 = fir.box_dims %[[ARRAY]], %[[C0]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+// CHECK: %[[RESULT_SHAPE:.*]] = fir.shape %[[DIM0]]#1 : (index) -> !fir.shape<1>
+// CHECK: %[[ELEMENTAL:.*]] = hlfir.elemental %[[RESULT_SHAPE]] unordered : (!fir.shape<1>) -> !hlfir.expr<?xi32> {
+// CHECK: ^bb0(%[[IDX:.*]]: index):
+// CHECK: %[[ARRAY_DIM0:.*]]:3 = fir.box_dims %[[ARRAY]], %[[C0]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+// CHECK: %[[LB_ADJ:.*]] = arith.subi %[[ARRAY_DIM0]]#0, %[[C1]] overflow<nuw> : index
+// CHECK: %[[ARRAY_IDX:.*]] = arith.addi %[[IDX]], %[[LB_ADJ]] overflow<nuw> : index
+// CHECK: %[[ELEM_ADDR:.*]] = hlfir.designate %[[ARRAY]] (%[[ARRAY_IDX]]) : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+// CHECK: %[[ELEM:.*]] = fir.load %[[ELEM_ADDR]] : !fir.ref<i32>
+// CHECK: hlfir.yield_element %[[ELEM]] : i32
+// CHECK: }
+// CHECK-NOT: fir.alloca
+// CHECK-NOT: fir.convert {{.*}} : (index) -> i32
+// CHECK-NOT: hlfir.pack
+// CHECK-NOT: hlfir.reshape
+// CHECK: return %[[ELEMENTAL]] : !hlfir.expr<?xi32>
+// CHECK: }
+
+func.func @pack_scalar_true_mask_2d(%arg0: !fir.box<!fir.array<?x?xi32>>) -> !hlfir.expr<?xi32> {
+ %true = arith.constant 1 : i1
+ %mask = fir.convert %true : (i1) -> !fir.logical<4>
+ %res = hlfir.pack %arg0 %mask : (!fir.box<!fir.array<?x?xi32>>, !fir.logical<4>) -> !hlfir.expr<?xi32>
+ return %res : !hlfir.expr<?xi32>
+}
+// CHECK-LABEL: func.func @pack_scalar_true_mask_2d(
+// CHECK-SAME: %[[ARRAY:.*]]: !fir.box<!fir.array<?x?xi32>>) -> !hlfir.expr<?xi32> {
+// CHECK: %[[C1:.*]] = arith.constant 1 : index
+// CHECK: %[[C0:.*]] = arith.constant 0 : index
+// CHECK: %[[DIM0:.*]]:3 = fir.box_dims %[[ARRAY]], %[[C0]] : (!fir.box<!fir.array<?x?xi32>>, index) -> (index, index, index)
+// CHECK: %[[DIM1:.*]]:3 = fir.box_dims %[[ARRAY]], %[[C1]] : (!fir.box<!fir.array<?x?xi32>>, index) -> (index, index, index)
+// CHECK: %[[PROD:.*]] = arith.muli %[[DIM0]]#1, %[[DIM1]]#1 overflow<nuw> : index
+// CHECK: %[[RESULT_SHAPE:.*]] = fir.shape %[[PROD]] : (index) -> !fir.shape<1>
+// CHECK: %[[ELEMENTAL:.*]] = hlfir.elemental %[[RESULT_SHAPE]] unordered : (!fir.shape<1>) -> !hlfir.expr<?xi32> {
+// CHECK: ^bb0(%[[IDX:.*]]: index):
+// CHECK: %[[ZERO_IDX:.*]] = arith.subi %[[IDX]], %[[C1]] overflow<nuw> : index
+// CHECK: %[[IDX0:.*]] = arith.remui %[[ZERO_IDX]], %[[DIM0]]#1 : index
+// CHECK: %[[IDX1:.*]] = arith.divui %[[ZERO_IDX]], %[[DIM0]]#1 : index
+// CHECK: %[[ONE_IDX0:.*]] = arith.addi %[[IDX0]], %[[C1]] overflow<nuw> : index
+// CHECK: %[[ONE_IDX1:.*]] = arith.addi %[[IDX1]], %[[C1]] overflow<nuw> : index
+// CHECK: %[[ARRAY_DIM0:.*]]:3 = fir.box_dims %[[ARRAY]], %[[C0]] : (!fir.box<!fir.array<?x?xi32>>, index) -> (index, index, index)
+// CHECK: %[[ARRAY_DIM1:.*]]:3 = fir.box_dims %[[ARRAY]], %[[C1]] : (!fir.box<!fir.array<?x?xi32>>, index) -> (index, index, index)
+// CHECK: %[[LB0:.*]] = arith.subi %[[ARRAY_DIM0]]#0, %[[C1]] overflow<nuw> : index
+// CHECK: %[[ARRAY_IDX0:.*]] = arith.addi %[[ONE_IDX0]], %[[LB0]] overflow<nuw> : index
+// CHECK: %[[LB1:.*]] = arith.subi %[[ARRAY_DIM1]]#0, %[[C1]] overflow<nuw> : index
+// CHECK: %[[ARRAY_IDX1:.*]] = arith.addi %[[ONE_IDX1]], %[[LB1]] overflow<nuw> : index
+// CHECK: %[[ELEM_ADDR:.*]] = hlfir.designate %[[ARRAY]] (%[[ARRAY_IDX0]], %[[ARRAY_IDX1]]) : (!fir.box<!fir.array<?x?xi32>>, index, index) -> !fir.ref<i32>
+// CHECK: %[[ELEM:.*]] = fir.load %[[ELEM_ADDR]] : !fir.ref<i32>
+// CHECK: hlfir.yield_element %[[ELEM]] : i32
+// CHECK: }
+// CHECK-NOT: fir.alloca
+// CHECK-NOT: fir.convert {{.*}} : (index) -> i32
+// CHECK-NOT: hlfir.pack
+// CHECK-NOT: hlfir.reshape
+// CHECK: return %[[ELEMENTAL]] : !hlfir.expr<?xi32>
+// CHECK: }
func.func @pack_var_mask(%arg0: !fir.box<!fir.array<?xi32>>, %arg1: !fir.ref<!fir.logical<4>>) -> !hlfir.expr<?xi32> {
%mask = fir.load %arg1 : !fir.ref<!fir.logical<4>>
%res = hlfir.pack %arg0 %mask : (!fir.box<!fir.array<?xi32>>, !fir.logical<4>) -> !hlfir.expr<?xi32>
return %res : !hlfir.expr<?xi32>
}
-// CHECK-LABEL: func.func @pack_var_mask
-// CHECK: hlfir.pack
-// CHECK-NOT: hlfir.reshape
+// CHECK-LABEL: func.func @pack_var_mask(
+// CHECK-SAME: %[[ARRAY:.*]]: !fir.box<!fir.array<?xi32>>,
+// CHECK-SAME: %[[MASK:.*]]: !fir.ref<!fir.logical<4>>) -> !hlfir.expr<?xi32> {
+// CHECK: %[[MASK_VAL:.*]] = fir.load %[[MASK]] : !fir.ref<!fir.logical<4>>
+// CHECK: %[[PACK:.*]] = hlfir.pack %[[ARRAY]] %[[MASK_VAL]] : (!fir.box<!fir.array<?xi32>>, !fir.logical<4>) -> !hlfir.expr<?xi32>
+// CHECK-NOT: hlfir.reshape
+// CHECK: return %[[PACK]] : !hlfir.expr<?xi32>
+// CHECK: }
func.func @pack_with_vector(%arg0: !fir.box<!fir.array<?xi32>>, %arg1: !fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32> {
%true = arith.constant 1 : i1
@@ -25,6 +87,10 @@ func.func @pack_with_vector(%arg0: !fir.box<!fir.array<?xi32>>, %arg1: !fir.box<
%res = hlfir.pack %arg0 %mask vector %arg1 : (!fir.box<!fir.array<?xi32>>, !fir.logical<4>, !fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32>
return %res : !hlfir.expr<?xi32>
}
-// CHECK-LABEL: func.func @pack_with_vector
-// CHECK: hlfir.pack
-// CHECK-NOT: hlfir.reshape
+// CHECK-LABEL: func.func @pack_with_vector(
+// CHECK-SAME: %[[ARRAY:.*]]: !fir.box<!fir.array<?xi32>>,
+// CHECK-SAME: %[[VECTOR:.*]]: !fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32> {
+// CHECK: %[[PACK:.*]] = hlfir.pack %[[ARRAY]] {{.*}} vector %[[VECTOR]] : (!fir.box<!fir.array<?xi32>>, !fir.logical<4>, !fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32>
+// CHECK-NOT: hlfir.reshape
+// CHECK: return %[[PACK]] : !hlfir.expr<?xi32>
+// CHECK: }
More information about the flang-commits
mailing list