Lower F08 parity intrinsic

[tarunprabhu]

Summary

This patch implements lowering for the F08 parity intrinsic. This is related to D129785 which implements folding for the same.

This largely follows the implementation of the any and all intrinsics which are related.

[jeanPerier]

flang/lib/Lower/IntrinsicCall.cpp

888

I think you should use asBox here, using asAddr will force non contiguous masks to be evaluated into a contiguous temp before calling the runtime, and this is probably some choice we should leave to the runtime.

[tarunprabhu]

Addressed @jeanPerier's comment and used asBox instead of asAddr.

[jeanPerier]

LGTM, thanks

flang/include/flang/Optimizer/Builder/Runtime/Reduction.h

 
 /// Generate call to `AnyDim` runtime routine.
 /// This calls the descriptor based runtime call implementation of the `any`
 /// intrinsic.
 void genAnyDescriptor(fir::FirOpBuilder &builder, mlir::Location loc,
                       mlir::Value resultBox, mlir::Value maskBox,
                       mlir::Value dim);
 
+/// Generate call to `ParityDim` runtime routine.
+/// This calls the descriptor based runtime call implementation of the `parity`
+/// intrinsic.
+void genParityDescriptor(fir::FirOpBuilder &builder, mlir::Location loc,
+                         mlir::Value resultBox, mlir::Value maskBox,
+                         mlir::Value dim);
+
 /// Generate call to `All` runtime routine. This version of `all` is specialized
 /// for rank 1 mask arguments.
 /// This calls the version that returns a scalar logical value.
 mlir::Value genAll(fir::FirOpBuilder &builder, mlir::Location loc,
                    mlir::Value maskBox, mlir::Value dim);
 
 /// Generate call to `Any` runtime routine. This version of `any` is specialized
 /// for rank 1 mask arguments.
void genMinvalChar(fir::FirOpBuilder &builder, mlir::Location loc,
                    mlir::Value maskBox);
 
 /// Generate call to `MinvalDim` intrinsic runtime routine. This is the version
 /// that takes arrays of any rank with a dim argument specified.
 void genMinvalDim(fir::FirOpBuilder &builder, mlir::Location loc,
                   mlir::Value resultBox, mlir::Value arrayBox, mlir::Value dim,
                   mlir::Value maskBox);
 
+/// Generate call to `Parity` runtime routine. This version of `parity` is
+/// specialized for rank 1 mask arguments.
+/// This calls the version that returns a scalar logical value.
+mlir::Value genParity(fir::FirOpBuilder &builder, mlir::Location loc,
+                      mlir::Value maskBox, mlir::Value dim);
+
 /// Generate call to `Product` intrinsic runtime routine. This is the version
 /// that does not take a dim argument.
 mlir::Value genProduct(fir::FirOpBuilder &builder, mlir::Location loc,
                        mlir::Value arrayBox, mlir::Value maskBox,
                        mlir::Value resultBox);
 
 /// Generate call to `ProductDim` intrinsic runtime routine. This is the version
 /// that takes arrays of any rank with a dim argument specified.

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
   mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
   void genMvbits(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genNot(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genPack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genParity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genPopcnt(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genPoppar(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genReduce(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
static constexpr IntrinsicHandler handlers[]{
     {"not", &I::genNot},
     {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
     {"pack",
      &I::genPack,
      {{{"array", asBox},
        {"mask", asBox},
        {"vector", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"parity",
+     &I::genParity,
+     {{{"mask", asBox}, {"dim", asValue}}},
+     /*isElemental=*/false},
     {"popcnt", &I::genPopcnt},
     {"poppar", &I::genPoppar},
     {"present",
      &I::genPresent,
      {{{"a", asInquired}}},
      /*isElemental=*/false},
     {"product",
      &I::genProduct,
mlir::Value resultIrBox =
       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
 
   fir::runtime::genPack(builder, loc, resultIrBox, array, mask, vector);
 
   return readAndAddCleanUp(resultMutableBox, resultType,
                            "unexpected result for PACK");
 }
 
+// PARITY
+fir::ExtendedValue
+IntrinsicLibrary::genParity(mlir::Type resultType,
+                            llvm::ArrayRef<fir::ExtendedValue> args) {
+
+  assert(args.size() == 2);
+  // Handle required mask argument
+  mlir::Value mask = builder.createBox(loc, args[0]);
+
+  fir::BoxValue maskArry = builder.createBox(loc, args[0]);
+  int rank = maskArry.rank();
+  assert(rank >= 1);
+
+  // Handle optional dim argument
+  bool absentDim = isStaticallyAbsent(args[1]);
+  mlir::Value dim =
+      absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
+                : fir::getBase(args[1]);
+
+  if (rank == 1 || absentDim)
+    return builder.createConvert(
+        loc, resultType, fir::runtime::genParity(builder, loc, mask, dim));
+
+  // else use the result descriptor ParityDim() intrinsic
+
+  // Create mutable fir.box to be passed to the runtime for the result.
+
+  mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
+  fir::MutableBoxValue resultMutableBox =
+      fir::factory::createTempMutableBox(builder, loc, resultArrayType);
+  mlir::Value resultIrBox =
+      fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
+
+  // Call runtime. The runtime is allocating the result.
+  fir::runtime::genParityDescriptor(builder, loc, resultIrBox, mask, dim);
+  return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
+      .match(
+          [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
+            addCleanUpForTemp(loc, box.getAddr());
+            return box;
+          },
+          [&](const auto &) -> fir::ExtendedValue {
+            fir::emitFatalError(loc, "Invalid result for PARITY");
+          });
+}
+
 // POPCNT
 mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType,
                                         llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 1);
 
   mlir::Value count = builder.create<mlir::math::CtPopOp>(loc, args);
 
   return builder.createConvert(loc, resultType, count);

flang/lib/Optimizer/Builder/Runtime/Reduction.cpp

 /// intrinsic.
 void fir::runtime::genAnyDescriptor(fir::FirOpBuilder &builder,
                                     mlir::Location loc, mlir::Value resultBox,
                                     mlir::Value maskBox, mlir::Value dim) {
   auto anyFunc = fir::runtime::getRuntimeFunc<mkRTKey(AnyDim)>(loc, builder);
   genReduction2Args(anyFunc, builder, loc, resultBox, maskBox, dim);
 }
 
+/// Generate call to `ParityDim` runtime routine.
+/// This calls the descriptor based runtime call implementation of the `parity`
+/// intrinsic.
+void fir::runtime::genParityDescriptor(fir::FirOpBuilder &builder,
+                                       mlir::Location loc,
+                                       mlir::Value resultBox,
+                                       mlir::Value maskBox, mlir::Value dim) {
+  auto parityFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(ParityDim)>(loc, builder);
+  genReduction2Args(parityFunc, builder, loc, resultBox, maskBox, dim);
+}
+
 /// Generate call to `All` intrinsic runtime routine. This routine is
 /// specialized for mask arguments with rank == 1.
 mlir::Value fir::runtime::genAll(fir::FirOpBuilder &builder, mlir::Location loc,
                                  mlir::Value maskBox, mlir::Value dim) {
   auto allFunc = fir::runtime::getRuntimeFunc<mkRTKey(All)>(loc, builder);
   return genSpecial2Args(allFunc, builder, loc, maskBox, dim);
 }
 
mlir::Value fir::runtime::genMinval(fir::FirOpBuilder &builder,
   auto sourceLine =
       fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
   auto args = fir::runtime::createArguments(
       builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox);
 
   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
 }
 
+/// Generate call to `Parity` intrinsic runtime routine. This routine is
+/// specialized for mask arguments with rank == 1.
+mlir::Value fir::runtime::genParity(fir::FirOpBuilder &builder,
+                                    mlir::Location loc, mlir::Value maskBox,
+                                    mlir::Value dim) {
+  auto parityFunc = fir::runtime::getRuntimeFunc<mkRTKey(Parity)>(loc, builder);
+  return genSpecial2Args(parityFunc, builder, loc, maskBox, dim);
+}
+
 /// Generate call to `ProductDim` intrinsic runtime routine. This is the version
 /// that handles any rank array with the dim argument specified.
 void fir::runtime::genProductDim(fir::FirOpBuilder &builder, mlir::Location loc,
                                  mlir::Value resultBox, mlir::Value arrayBox,
                                  mlir::Value dim, mlir::Value maskBox) {
   auto func = fir::runtime::getRuntimeFunc<mkRTKey(ProductDim)>(loc, builder);
   genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
 }

flang/test/Lower/Intrinsics/parity.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: parity_test
+! CHECK-SAME: %[[arg0:.*]]: !fir.box<!fir.array<?x!fir.logical<4>>>{{.*}}) -> !fir.logical<4>
+logical function parity_test(mask)
+  logical :: mask(:)
+  ! CHECK: %[[c1:.*]] = arith.constant 1 : index
+  ! CHECK: %[[a1:.*]] = fir.convert %[[arg0]] : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> !fir.box<none>
+  ! CHECK: %[[a2:.*]] = fir.convert %[[c1]] : (index) -> i32
+  parity_test = parity(mask)
+  ! CHECK:  %[[a3:.*]] = fir.call @_FortranAParity(%[[a1]], %{{.*}},  %{{.*}}, %[[a2]]) : (!fir.box<none>, !fir.ref<i8>, i32, i32) -> i1
+end function parity_test
+
+! CHECK-LABEL: parity_test2
+! CHECK-SAME: %[[arg0:.*]]: !fir.box<!fir.array<?x?x!fir.logical<4>>>
+! CHECK-SAME: %[[arg1:.*]]: !fir.ref<i32>
+! CHECK-SAME: %[[arg2:.*]]: !fir.box<!fir.array<?x!fir.logical<4>>>
+subroutine parity_test2(mask, d, rslt)
+  logical :: mask(:,:)
+  integer :: d
+  logical :: rslt(:)
+  ! CHECK-DAG:  %[[a0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>
+  ! CHECK-DAG:  %[[a1:.*]] = fir.load %[[arg1:.*]] : !fir.ref<i32>
+  ! CHECK-DAG:  %[[a6:.*]] = fir.convert %[[a0:.*]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>>) -> !fir.ref<!fir.box<none>>
+  ! CHECK-DAG:  %[[a7:.*]] = fir.convert %[[arg0:.*]]: (!fir.box<!fir.array<?x?x!fir.logical<4>>>) -> !fir.box<none>
+  rslt = parity(mask, d)
+  ! CHECK:  %[[r1:.*]] = fir.call @_FortranAParityDim(%[[a6:.*]], %[[a7:.*]], %[[a1:.*]], %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, i32, !fir.ref<i8>, i32) -> none
+  ! CHECK-DAG:  %[[a10:.*]] = fir.load %[[a0:.*]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>>
+  ! CHECK-DAG:  %[[a12:.*]] = fir.box_addr %[[a10:.*]] : (!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>) -> !fir.heap<!fir.array<?x!fir.logical<4>>>
+  ! CHECK-DAG  fir.freemem %[[a12:.*]]
+end subroutine parity_test2

flang/unittests/Optimizer/Builder/Runtime/ReductionTest.cpp

TEST_F(RuntimeCallTest, genMinValTest) {
 
   testGenMinVal(*firBuilder, i8Ty, "_FortranAMinvalInteger1");
   testGenMinVal(*firBuilder, i16Ty, "_FortranAMinvalInteger2");
   testGenMinVal(*firBuilder, i32Ty, "_FortranAMinvalInteger4");
   testGenMinVal(*firBuilder, i64Ty, "_FortranAMinvalInteger8");
   testGenMinVal(*firBuilder, i128Ty, "_FortranAMinvalInteger16");
 }
 
+TEST_F(RuntimeCallTest, genParityTest) {
+  mlir::Location loc = firBuilder->getUnknownLoc();
+  mlir::Value undef = firBuilder->create<fir::UndefOp>(loc, seqTy10);
+  mlir::Value dim = firBuilder->createIntegerConstant(loc, i32Ty, 1);
+  mlir::Value parity = fir::runtime::genParity(*firBuilder, loc, undef, dim);
+  checkCallOp(parity.getDefiningOp(), "_FortranAParity", 2);
+}
+
+TEST_F(RuntimeCallTest, genParityDescriptorTest) {
+  mlir::Location loc = firBuilder->getUnknownLoc();
+  mlir::Value result = firBuilder->create<fir::UndefOp>(loc, seqTy10);
+  mlir::Value mask = firBuilder->create<fir::UndefOp>(loc, seqTy10);
+  mlir::Value dim = firBuilder->createIntegerConstant(loc, i32Ty, 1);
+  fir::runtime::genParityDescriptor(*firBuilder, loc, result, mask, dim);
+  checkCallOpFromResultBox(result, "_FortranAParityDim", 3);
+}
+
 void testGenSum(
     fir::FirOpBuilder &builder, mlir::Type eleTy, llvm::StringRef fctName) {
   mlir::Location loc = builder.getUnknownLoc();
   mlir::Type seqTy =
       fir::SequenceType::get(fir::SequenceType::Shape(1, 10), eleTy);
   mlir::Type refSeqTy = fir::ReferenceType::get(seqTy);
   mlir::Value undef = builder.create<fir::UndefOp>(loc, refSeqTy);
   mlir::Value mask = builder.create<fir::UndefOp>(loc, seqTy);