[flang-commits] [flang] b5e18ba - [Flang][HLFIR] Lower PACK(array, .TRUE.) to hlfir.reshape (#213603)

via flang-commits flang-commits at lists.llvm.org
Tue Aug 18 02:35:28 PDT 2026


Author: ejose02
Date: 2026-08-18T15:05:23+05:30
New Revision: b5e18ba8d7439f5ba6da35c0a0de71f06651003e

URL: https://github.com/llvm/llvm-project/commit/b5e18ba8d7439f5ba6da35c0a0de71f06651003e
DIFF: https://github.com/llvm/llvm-project/commit/b5e18ba8d7439f5ba6da35c0a0de71f06651003e.diff

LOG: [Flang][HLFIR] Lower PACK(array, .TRUE.) to hlfir.reshape (#213603)

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

Added: 
    flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir
    flang/test/Lower/HLFIR/pack_scalar_true.f90

Modified: 
    flang/include/flang/Optimizer/HLFIR/HLFIROps.td
    flang/lib/Lower/HlfirIntrinsics.cpp
    flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
    flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp
    flang/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp
    flang/test/HLFIR/reshape.fir
    flang/test/Lower/Intrinsics/pack.f90
    flang/test/Lower/polymorphic-temp.f90

Removed: 
    


################################################################################
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/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp
index 9ee30e52af697..f839c869d236b 100644
--- a/flang/lib/Lower/HlfirIntrinsics.cpp
+++ b/flang/lib/Lower/HlfirIntrinsics.cpp
@@ -209,6 +209,17 @@ class HlfirReshapeLowering : public HlfirTransformationalIntrinsic {
             mlir::Type stmtResultType) override;
 };
 
+class HlfirPackLowering : public HlfirTransformationalIntrinsic {
+public:
+  using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
+
+protected:
+  mlir::Value
+  lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
+            const fir::IntrinsicArgumentLoweringRules *argLowering,
+            mlir::Type stmtResultType) override;
+};
+
 class HlfirIndexLowering : public HlfirTransformationalIntrinsic {
 public:
   using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
@@ -566,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,
@@ -649,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);

diff  --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
index 53c9b6f500d05..6ab85cf4ef61b 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
 //===----------------------------------------------------------------------===//
@@ -1708,7 +1736,7 @@ llvm::LogicalResult hlfir::ReshapeOp::verify() {
       hlfir::getFortranElementOrSequenceType(shape.getType()));
   if (shapeArrayType.getDimension() != 1)
     return emitOpError("SHAPE must be an array of rank 1");
-  if (!mlir::isa<mlir::IntegerType>(shapeArrayType.getElementType()))
+  if (!fir::isa_integer(shapeArrayType.getElementType()))
     return emitOpError("SHAPE must be an integer array");
   if (shapeArrayType.hasDynamicExtents())
     return emitOpError("SHAPE must have known size");

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..5e2f91f1984e3 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,71 @@ class DotProductConversion
   }
 };
 
+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()};
+    builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::nuw);
+
+    llvm::SmallVector<mlir::Value, Fortran::common::maxRank> arrayExtents =
+        hlfir::genExtentsVector(loc, builder, array);
+    mlir::Type indexType = builder.getIndexType();
+    mlir::Value totalSize = builder.createIntegerConstant(loc, indexType, 1);
+    for (mlir::Value extent : arrayExtents)
+      totalSize = mlir::arith::MulIOp::create(
+          builder, loc, totalSize,
+          builder.createConvert(loc, indexType, extent));
+
+    mlir::Value one = builder.createIntegerConstant(loc, indexType, 1);
+    mlir::Value unitShape = fir::ShapeOp::create(builder, loc, one);
+    mlir::Type shapeExprType =
+        hlfir::ExprType::get(builder.getContext(), {1}, indexType,
+                             /*polymorphic=*/false);
+
+    auto genShapeKernel = [&](mlir::Location loc, fir::FirOpBuilder &builder,
+                              mlir::ValueRange) -> hlfir::Entity {
+      return hlfir::Entity{totalSize};
+    };
+    mlir::Value shapeExpr = hlfir::genElementalOp(
+        loc, builder, indexType, unitShape, /*typeParams=*/{}, genShapeKernel,
+        /*isUnordered=*/true,
+        /*polymorphicMold=*/mlir::Value{}, shapeExprType);
+
+    auto reshape = hlfir::ReshapeOp::create(
+        builder, loc, pack.getType(), pack.getArray(), shapeExpr,
+        /*pad=*/mlir::Value{}, /*order=*/mlir::Value{});
+    rewriter.replaceOp(pack, reshape);
+    rewriter.setInsertionPointAfter(reshape);
+    hlfir::DestroyOp::create(rewriter, loc, shapeExpr);
+    return mlir::success();
+  }
+};
+
 class ReshapeAsElementalConversion
     : public mlir::OpRewritePattern<hlfir::ReshapeOp> {
 public:
@@ -3333,6 +3399,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/reshape.fir b/flang/test/HLFIR/reshape.fir
index 4f586386e0909..093e9233b9e15 100644
--- a/flang/test/HLFIR/reshape.fir
+++ b/flang/test/HLFIR/reshape.fir
@@ -13,6 +13,18 @@ func.func @reshape1(%arg0: !hlfir.expr<42xi32>, %arg1: !hlfir.expr<1xi32>) -> !h
 // CHECK:           return %[[VAL_2]] : !hlfir.expr<?xi32>
 // CHECK:         }
 
+// SHAPE expression with index element type
+func.func @reshape_index_shape(%arg0: !hlfir.expr<42xi32>, %arg1: !hlfir.expr<1xindex>) -> !hlfir.expr<?xi32> {
+  %0 = hlfir.reshape %arg0 %arg1 : (!hlfir.expr<42xi32>, !hlfir.expr<1xindex>) -> !hlfir.expr<?xi32>
+  return %0 : !hlfir.expr<?xi32>
+}
+// CHECK-LABEL:   func.func @reshape_index_shape(
+// CHECK-SAME:                                   %[[VAL_0:.*]]: !hlfir.expr<42xi32>,
+// CHECK-SAME:                                   %[[VAL_1:.*]]: !hlfir.expr<1xindex>) -> !hlfir.expr<?xi32> {
+// CHECK:           %[[VAL_2:.*]] = hlfir.reshape %[[VAL_0]] %[[VAL_1]] : (!hlfir.expr<42xi32>, !hlfir.expr<1xindex>) -> !hlfir.expr<?xi32>
+// CHECK:           return %[[VAL_2]] : !hlfir.expr<?xi32>
+// CHECK:         }
+
 // Operands are expressions of assumed shape
 func.func @reshape2(%arg0: !hlfir.expr<?xi32>, %arg1: !hlfir.expr<1xi32>) -> !hlfir.expr<4xi32> {
   %0 = hlfir.reshape %arg0 %arg1 pad %arg0 order %arg0 : (!hlfir.expr<?xi32>, !hlfir.expr<1xi32>, !hlfir.expr<?xi32>, !hlfir.expr<?xi32>) -> !hlfir.expr<4xi32>

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..1700244dfa889
--- /dev/null
+++ b/flang/test/HLFIR/simplify-hlfir-intrinsics-pack.fir
@@ -0,0 +1,109 @@
+// 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> {
+  %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-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:           %[[UNIT_SHAPE:.*]] = fir.shape %[[C1]] : (index) -> !fir.shape<1>
+// CHECK:           %[[SHAPE_EXPR:.*]] = hlfir.elemental %[[UNIT_SHAPE]] unordered : (!fir.shape<1>) -> !hlfir.expr<1xindex> {
+// CHECK:           ^bb0(%{{.*}}: index):
+// CHECK:             hlfir.yield_element %{{.*}} : index
+// CHECK:           }
+// CHECK:           %[[SHAPE_VAL:.*]] = hlfir.apply %[[SHAPE_EXPR]], %[[C1]] : (!hlfir.expr<1xindex>, index) -> index
+// CHECK:           %[[RESULT_SHAPE:.*]] = fir.shape %[[SHAPE_VAL]] : (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:           hlfir.destroy %[[SHAPE_EXPR]] : !hlfir.expr<1xindex>
+// CHECK-NOT:       fir.alloca
+// 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:           %[[UNIT_SHAPE:.*]] = fir.shape %[[C1]] : (index) -> !fir.shape<1>
+// CHECK:           %[[SHAPE_EXPR:.*]] = hlfir.elemental %[[UNIT_SHAPE]] unordered : (!fir.shape<1>) -> !hlfir.expr<1xindex> {
+// CHECK:           ^bb0(%{{.*}}: index):
+// CHECK:             hlfir.yield_element %[[PROD]] : index
+// CHECK:           }
+// CHECK:           %[[HOISTED_DIM0:.*]]:3 = fir.box_dims %[[ARRAY]], %[[C0]] : (!fir.box<!fir.array<?x?xi32>>, index) -> (index, index, index)
+// CHECK:           %[[SHAPE_VAL:.*]] = hlfir.apply %[[SHAPE_EXPR]], %[[C1]] : (!hlfir.expr<1xindex>, index) -> index
+// CHECK:           %[[RESULT_SHAPE:.*]] = fir.shape %[[SHAPE_VAL]] : (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]], %[[HOISTED_DIM0]]#1 : index
+// CHECK:             %[[IDX1:.*]] = arith.divui %[[ZERO_IDX]], %[[HOISTED_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:           hlfir.destroy %[[SHAPE_EXPR]] : !hlfir.expr<1xindex>
+// CHECK-NOT:       fir.alloca
+// 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-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
+  %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-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:         }

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..01eef03105a04
--- /dev/null
+++ b/flang/test/Lower/HLFIR/pack_scalar_true.f90
@@ -0,0 +1,48 @@
+! 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
+
+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: hlfir.pack
+! CHECK-NOT: hlfir.reshape
+! OPT-LABEL: pack_scalar_true_
+! OPT-NOT: _FortranAPack
+
+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: hlfir.pack
+! CHECK-NOT: hlfir.reshape
+! OPT-LABEL: pack_static_scalar_true_
+
+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: hlfir.pack
+! CHECK-NOT: hlfir.reshape
+
+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: 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(:,:)


        


More information about the flang-commits mailing list