Fold F08 parity intrinsic

[tarunprabhu]

Summary

This patch implements compile-time folding for the F08 parity intrinsic.

[klausler]

flang/lib/Evaluate/fold-logical.cpp

15

"ALL, ANY, & PARITY"

[tarunprabhu]

Fixed typo.

I noticed it before submitting, regenerated the patch, and yet somehow managed to upload the old one ... (sigh)

[tarunprabhu]

Apologies. There was a bug in the test that caused it to always pass.

This has been fixed with this update.

[tarunprabhu]

Fix test that was causing build failure.

flang/lib/Evaluate/fold-logical.cpp

 //===-- lib/Evaluate/fold-logical.cpp -------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "fold-implementation.h"
 #include "fold-reduction.h"
 #include "flang/Evaluate/check-expression.h"
 
 namespace Fortran::evaluate {
 
-// for ALL & ANY
+// for ALL, ANY & PARITY
 template <typename T>
-static Expr<T> FoldAllAny(FoldingContext &context, FunctionRef<T> &&ref,
+static Expr<T> FoldAllAnyParity(FoldingContext &context, FunctionRef<T> &&ref,
     Scalar<T> (Scalar<T>::*operation)(const Scalar<T> &) const,
     Scalar<T> identity) {
   static_assert(T::category == TypeCategory::Logical);
   using Element = Scalar<T>;
   std::optional<int> dim;
   if (std::optional<Constant<T>> array{
           ProcessReductionArgs<T>(context, ref.arguments(), dim, identity,
               /*ARRAY(MASK)=*/0, /*DIM=*/1)}) {
Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
     FunctionRef<Type<TypeCategory::Logical, KIND>> &&funcRef) {
   using T = Type<TypeCategory::Logical, KIND>;
   ActualArguments &args{funcRef.arguments()};
   auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
   CHECK(intrinsic);
   std::string name{intrinsic->name};
   using SameInt = Type<TypeCategory::Integer, KIND>;
   if (name == "all") {
-    return FoldAllAny(
+    return FoldAllAnyParity(
         context, std::move(funcRef), &Scalar<T>::AND, Scalar<T>{true});
   } else if (name == "any") {
-    return FoldAllAny(
+    return FoldAllAnyParity(
         context, std::move(funcRef), &Scalar<T>::OR, Scalar<T>{false});
   } else if (name == "associated") {
     bool gotConstant{true};
     const Expr<SomeType> *firstArgExpr{args[0]->UnwrapExpr()};
     if (!firstArgExpr || !IsNullPointer(*firstArgExpr)) {
       gotConstant = false;
     } else if (args[1]) { // There's a second argument
       const Expr<SomeType> *secondArgExpr{args[1]->UnwrapExpr()};
if (cx0 && cx1) {
                   ConvertToType<Ascii>(std::move(*cx1)))));
     }
   } else if (name == "logical") {
     if (auto *expr{UnwrapExpr<Expr<SomeLogical>>(args[0])}) {
       return Fold(context, ConvertToType<T>(std::move(*expr)));
     }
   } else if (name == "merge") {
     return FoldMerge<T>(context, std::move(funcRef));
+  } else if (name == "parity") {
+    return FoldAllAnyParity(
+        context, std::move(funcRef), &Scalar<T>::NEQV, Scalar<T>{false});
   } else if (name == "same_type_as") {
     // Type equality testing with SAME_TYPE_AS() ignores any type parameters.
     // Returns a constant truth value when the result is known now.
     if (args[0] && args[1]) {
       auto t0{args[0]->GetType()};
       auto t1{args[1]->GetType()};
       if (t0 && t1) {
         if (auto result{t0->SameTypeAs(*t1)}) {

flang/test/Evaluate/fold-parity.f90

+! RUN: %python %S/test_folding.py %s %flang_fc1
+
+! Test fold parity intrinsic.
+
+module paritytest
+  logical, parameter :: test_1t = parity((/ .true. /))
+  logical, parameter :: test_1f = .not. parity((/ .false. /))
+
+  logical, parameter :: test_e1 = .not. parity((/ .true., .true. /))
+  logical, parameter :: test_o1 = parity((/ .true., .true., .true. /))
+  logical, parameter :: test_o12 = parity((/ .true., .true., .true., .false. /))
+
+  logical, parameter, dimension(2, 3) :: a32 = reshape((/&
+       .true., .true., .false., &
+       .true., .true., .true. &
+       /), shape(a32), order=(/2, 1/))
+
+  logical, parameter, dimension(2, 3) :: a32t = reshape((/&
+       .true., .true., .true., &
+       .true., .true., .true. &
+       /), shape(a32t))
+
+  logical, parameter, dimension(2, 3) :: a32f = reshape((/&
+       .false., .false., .false., &
+       .false., .false., .false. &
+       /), shape(a32f))
+
+  logical, parameter :: test_a32 = parity(a32)
+  logical, parameter :: test_a32t = .not. parity(a32t)
+  logical, parameter :: test_a32f = .not. parity(a32f)
+
+  logical, parameter :: test_a321 =
+       all(parity(a32, 1) .EQV. (/ .false., .false., .true. /))
+
+  logical, parameter :: test_a322 = &
+       all(parity(a32, 2) .EQV. (/ .false., .true. /))
+
+end module paritytest