[flang] Add parsing of DO CONCURRENT REDUCE clause (#92518)

Derived from #92480. This PR supports parsing of the DO CONCURRENT
REDUCE clause in Fortran 2023. Following the style of the OpenMP parser
in MLIR, the front end accepts both arbitrary operations and procedures
for the REDUCE clause. But later Semantics can notify type errors and
resolve procedure names.

Author: khaki3

flang/examples/FeatureList/FeatureList.cpp

@@ -86,8 +86,6 @@ struct NodeVisitor {
   READ_FEATURE(AccObjectList)
   READ_FEATURE(AccObjectListWithModifier)
   READ_FEATURE(AccObjectListWithReduction)
-  READ_FEATURE(AccReductionOperator)
-  READ_FEATURE(AccReductionOperator::Operator)
   READ_FEATURE(AccSizeExpr)
   READ_FEATURE(AccSizeExprList)
   READ_FEATURE(AccSelfClause)
@@ -410,10 +408,13 @@ struct NodeVisitor {
   READ_FEATURE(LetterSpec)
   READ_FEATURE(LiteralConstant)
   READ_FEATURE(IntLiteralConstant)
+  READ_FEATURE(ReductionOperator)
+  READ_FEATURE(ReductionOperator::Operator)
   READ_FEATURE(LocalitySpec)
   READ_FEATURE(LocalitySpec::DefaultNone)
   READ_FEATURE(LocalitySpec::Local)
   READ_FEATURE(LocalitySpec::LocalInit)
+  READ_FEATURE(LocalitySpec::Reduce)
   READ_FEATURE(LocalitySpec::Shared)
   READ_FEATURE(LockStmt)
   READ_FEATURE(LockStmt::LockStat)

flang/include/flang/Parser/dump-parse-tree.h

@@ -95,8 +95,6 @@ class ParseTreeDumper {
   NODE(parser, AccObjectList)
   NODE(parser, AccObjectListWithModifier)
   NODE(parser, AccObjectListWithReduction)
-  NODE(parser, AccReductionOperator)
-  NODE_ENUM(parser::AccReductionOperator, Operator)
   NODE(parser, AccSizeExpr)
   NODE(parser, AccSizeExprList)
   NODE(parser, AccSelfClause)
@@ -436,10 +434,13 @@ class ParseTreeDumper {
   NODE(parser, LetterSpec)
   NODE(parser, LiteralConstant)
   NODE(parser, IntLiteralConstant)
+  NODE(parser, ReductionOperator)
+  NODE_ENUM(parser::ReductionOperator, Operator)
   NODE(parser, LocalitySpec)
   NODE(LocalitySpec, DefaultNone)
   NODE(LocalitySpec, Local)
   NODE(LocalitySpec, LocalInit)
+  NODE(LocalitySpec, Reduce)
   NODE(LocalitySpec, Shared)
   NODE(parser, LockStmt)
   NODE(LockStmt, LockStat)

flang/include/flang/Parser/parse-tree.h

@@ -2236,16 +2236,34 @@ struct ConcurrentHeader {
       t;
 };
 
+// F'2023 R1131 reduce-operation -> reduction-operator
+// CUF reduction-op -> reduction-operator
+// OpenACC 3.3 2.5.15 reduction-operator ->
+//                      + | * | .AND. | .OR. | .EQV. | .NEQV. |
+//                      MAX | MIN | IAND | IOR | IEOR
+struct ReductionOperator {
+  ENUM_CLASS(
+      Operator, Plus, Multiply, Max, Min, Iand, Ior, Ieor, And, Or, Eqv, Neqv)
+  WRAPPER_CLASS_BOILERPLATE(ReductionOperator, Operator);
+  CharBlock source;
+};
+
 // R1130 locality-spec ->
 //         LOCAL ( variable-name-list ) | LOCAL_INIT ( variable-name-list ) |
+//         REDUCE ( reduce-operation : variable-name-list ) |
 //         SHARED ( variable-name-list ) | DEFAULT ( NONE )
 struct LocalitySpec {
   UNION_CLASS_BOILERPLATE(LocalitySpec);
   WRAPPER_CLASS(Local, std::list<Name>);
   WRAPPER_CLASS(LocalInit, std::list<Name>);
+  struct Reduce {
+    TUPLE_CLASS_BOILERPLATE(Reduce);
+    using Operator = ReductionOperator;
+    std::tuple<Operator, std::list<Name>> t;
+  };
   WRAPPER_CLASS(Shared, std::list<Name>);
   EMPTY_CLASS(DefaultNone);
-  std::variant<Local, LocalInit, Shared, DefaultNone> u;
+  std::variant<Local, LocalInit, Reduce, Shared, DefaultNone> u;
 };
 
 // R1123 loop-control ->
@@ -4066,17 +4084,9 @@ struct AccObjectListWithModifier {
   std::tuple<std::optional<AccDataModifier>, AccObjectList> t;
 };
 
-// 2.5.15: + | * | max | min | iand | ior | ieor | .and. | .or. | .eqv. | .neqv.
-struct AccReductionOperator {
-  ENUM_CLASS(
-      Operator, Plus, Multiply, Max, Min, Iand, Ior, Ieor, And, Or, Eqv, Neqv)
-  WRAPPER_CLASS_BOILERPLATE(AccReductionOperator, Operator);
-  CharBlock source;
-};
-
 struct AccObjectListWithReduction {
   TUPLE_CLASS_BOILERPLATE(AccObjectListWithReduction);
-  std::tuple<AccReductionOperator, AccObjectList> t;
+  std::tuple<ReductionOperator, AccObjectList> t;
 };
 
 struct AccWaitArgument {
@@ -4312,11 +4322,11 @@ struct OpenACCConstruct {
 // block -> * | scalar-int-expr | ( star-or-expr-list )
 // stream -> 0, scalar-int-expr | STREAM = scalar-int-expr
 // cuf-reduction -> [ REDUCE | REDUCTION ] (
-//                  acc-reduction-op : scalar-variable-list )
+//                  reduction-op : scalar-variable-list )
 
 struct CUFReduction {
   TUPLE_CLASS_BOILERPLATE(CUFReduction);
-  using Operator = AccReductionOperator;
+  using Operator = ReductionOperator;
   std::tuple<Operator, std::list<Scalar<Variable>>> t;
 };
 

flang/include/flang/Semantics/symbol.h

@@ -714,6 +714,7 @@ class Symbol {
       CrayPointer, CrayPointee,
       LocalityLocal, // named in LOCAL locality-spec
       LocalityLocalInit, // named in LOCAL_INIT locality-spec
+      LocalityReduce, // named in REDUCE locality-spec
       LocalityShared, // named in SHARED locality-spec
       InDataStmt, // initialized in a DATA statement, =>object, or /init/
       InNamelist, // in a Namelist group

flang/lib/Lower/OpenACC.cpp

@@ -829,29 +829,29 @@ genPrivatizations(const Fortran::parser::AccObjectList &objectList,
 /// Return the corresponding enum value for the mlir::acc::ReductionOperator
 /// from the parser representation.
 static mlir::acc::ReductionOperator
-getReductionOperator(const Fortran::parser::AccReductionOperator &op) {
+getReductionOperator(const Fortran::parser::ReductionOperator &op) {
   switch (op.v) {
-  case Fortran::parser::AccReductionOperator::Operator::Plus:
+  case Fortran::parser::ReductionOperator::Operator::Plus:
     return mlir::acc::ReductionOperator::AccAdd;
-  case Fortran::parser::AccReductionOperator::Operator::Multiply:
+  case Fortran::parser::ReductionOperator::Operator::Multiply:
     return mlir::acc::ReductionOperator::AccMul;
-  case Fortran::parser::AccReductionOperator::Operator::Max:
+  case Fortran::parser::ReductionOperator::Operator::Max:
     return mlir::acc::ReductionOperator::AccMax;
-  case Fortran::parser::AccReductionOperator::Operator::Min:
+  case Fortran::parser::ReductionOperator::Operator::Min:
     return mlir::acc::ReductionOperator::AccMin;
-  case Fortran::parser::AccReductionOperator::Operator::Iand:
+  case Fortran::parser::ReductionOperator::Operator::Iand:
     return mlir::acc::ReductionOperator::AccIand;
-  case Fortran::parser::AccReductionOperator::Operator::Ior:
+  case Fortran::parser::ReductionOperator::Operator::Ior:
     return mlir::acc::ReductionOperator::AccIor;
-  case Fortran::parser::AccReductionOperator::Operator::Ieor:
+  case Fortran::parser::ReductionOperator::Operator::Ieor:
     return mlir::acc::ReductionOperator::AccXor;
-  case Fortran::parser::AccReductionOperator::Operator::And:
+  case Fortran::parser::ReductionOperator::Operator::And:
     return mlir::acc::ReductionOperator::AccLand;
-  case Fortran::parser::AccReductionOperator::Operator::Or:
+  case Fortran::parser::ReductionOperator::Operator::Or:
     return mlir::acc::ReductionOperator::AccLor;
-  case Fortran::parser::AccReductionOperator::Operator::Eqv:
+  case Fortran::parser::ReductionOperator::Operator::Eqv:
     return mlir::acc::ReductionOperator::AccEqv;
-  case Fortran::parser::AccReductionOperator::Operator::Neqv:
+  case Fortran::parser::ReductionOperator::Operator::Neqv:
     return mlir::acc::ReductionOperator::AccNeqv;
   }
   llvm_unreachable("unexpected reduction operator");
@@ -1356,8 +1356,7 @@ genReductions(const Fortran::parser::AccObjectListWithReduction &objectList,
               llvm::SmallVector<mlir::Attribute> &reductionRecipes) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   const auto &objects = std::get<Fortran::parser::AccObjectList>(objectList.t);
-  const auto &op =
-      std::get<Fortran::parser::AccReductionOperator>(objectList.t);
+  const auto &op = std::get<Fortran::parser::ReductionOperator>(objectList.t);
   mlir::acc::ReductionOperator mlirOp = getReductionOperator(op);
   Fortran::evaluate::ExpressionAnalyzer ea{semanticsContext};
   for (const auto &accObject : objects.v) {

flang/lib/Parser/executable-parsers.cpp

@@ -254,11 +254,15 @@ TYPE_PARSER(construct<ConcurrentControl>(name / "=", scalarIntExpr / ":",
 
 // R1130 locality-spec ->
 //         LOCAL ( variable-name-list ) | LOCAL_INIT ( variable-name-list ) |
+//         REDUCE ( reduce-operation : variable-name-list ) |
 //         SHARED ( variable-name-list ) | DEFAULT ( NONE )
 TYPE_PARSER(construct<LocalitySpec>(construct<LocalitySpec::Local>(
                 "LOCAL" >> parenthesized(listOfNames))) ||
     construct<LocalitySpec>(construct<LocalitySpec::LocalInit>(
         "LOCAL_INIT"_sptok >> parenthesized(listOfNames))) ||
+    construct<LocalitySpec>(construct<LocalitySpec::Reduce>(
+        "REDUCE (" >> Parser<LocalitySpec::Reduce::Operator>{} / ":",
+        listOfNames / ")")) ||
     construct<LocalitySpec>(construct<LocalitySpec::Shared>(
         "SHARED" >> parenthesized(listOfNames))) ||
     construct<LocalitySpec>(

flang/lib/Parser/openacc-parsers.cpp

@@ -39,7 +39,7 @@ TYPE_PARSER(construct<AccObjectListWithModifier>(
     maybe(Parser<AccDataModifier>{}), Parser<AccObjectList>{}))
 
 TYPE_PARSER(construct<AccObjectListWithReduction>(
-    Parser<AccReductionOperator>{} / ":", Parser<AccObjectList>{}))
+    Parser<ReductionOperator>{} / ":", Parser<AccObjectList>{}))
 
 // 2.16 (3249) wait-argument is:
 //   [devnum : int-expr :] [queues :] int-expr-list
@@ -92,20 +92,20 @@ TYPE_PARSER(
 TYPE_PARSER(construct<AccCollapseArg>(
     "FORCE:"_tok >> pure(true) || pure(false), scalarIntConstantExpr))
 
-// 2.5.15 Reduction
+// 2.5.15 Reduction, F'2023 R1131, and CUF reduction-op
 // Operator for reduction
-TYPE_PARSER(sourced(construct<AccReductionOperator>(
-    first("+" >> pure(AccReductionOperator::Operator::Plus),
-        "*" >> pure(AccReductionOperator::Operator::Multiply),
-        "MAX" >> pure(AccReductionOperator::Operator::Max),
-        "MIN" >> pure(AccReductionOperator::Operator::Min),
-        "IAND" >> pure(AccReductionOperator::Operator::Iand),
-        "IOR" >> pure(AccReductionOperator::Operator::Ior),
-        "IEOR" >> pure(AccReductionOperator::Operator::Ieor),
-        ".AND." >> pure(AccReductionOperator::Operator::And),
-        ".OR." >> pure(AccReductionOperator::Operator::Or),
-        ".EQV." >> pure(AccReductionOperator::Operator::Eqv),
-        ".NEQV." >> pure(AccReductionOperator::Operator::Neqv)))))
+TYPE_PARSER(sourced(construct<ReductionOperator>(
+    first("+" >> pure(ReductionOperator::Operator::Plus),
+        "*" >> pure(ReductionOperator::Operator::Multiply),
+        "MAX" >> pure(ReductionOperator::Operator::Max),
+        "MIN" >> pure(ReductionOperator::Operator::Min),
+        "IAND" >> pure(ReductionOperator::Operator::Iand),
+        "IOR" >> pure(ReductionOperator::Operator::Ior),
+        "IEOR" >> pure(ReductionOperator::Operator::Ieor),
+        ".AND." >> pure(ReductionOperator::Operator::And),
+        ".OR." >> pure(ReductionOperator::Operator::Or),
+        ".EQV." >> pure(ReductionOperator::Operator::Eqv),
+        ".NEQV." >> pure(ReductionOperator::Operator::Neqv)))))
 
 // 2.15.1 Bind clause
 TYPE_PARSER(sourced(construct<AccBindClause>(name)) ||

flang/lib/Parser/unparse.cpp

@@ -1038,6 +1038,10 @@ class UnparseVisitor {
   void Unparse(const LocalitySpec::LocalInit &x) {
     Word("LOCAL_INIT("), Walk(x.v, ", "), Put(')');
   }
+  void Unparse(const LocalitySpec::Reduce &x) {
+    Word("REDUCE("), Walk(std::get<parser::ReductionOperator>(x.t));
+    Walk(":", std::get<std::list<parser::Name>>(x.t), ",", ")");
+  }
   void Unparse(const LocalitySpec::Shared &x) {
     Word("SHARED("), Walk(x.v, ", "), Put(')');
   }
@@ -2018,7 +2022,7 @@ class UnparseVisitor {
   }
   void Unparse(const AccObjectList &x) { Walk(x.v, ","); }
   void Unparse(const AccObjectListWithReduction &x) {
-    Walk(std::get<AccReductionOperator>(x.t));
+    Walk(std::get<ReductionOperator>(x.t));
     Put(":");
     Walk(std::get<AccObjectList>(x.t));
   }
@@ -2753,28 +2757,28 @@ class UnparseVisitor {
   WALK_NESTED_ENUM(OmpOrderClause, Type) // OMP order-type
   WALK_NESTED_ENUM(OmpOrderModifier, Kind) // OMP order-modifier
 #undef WALK_NESTED_ENUM
-  void Unparse(const AccReductionOperator::Operator x) {
+  void Unparse(const ReductionOperator::Operator x) {
     switch (x) {
-    case AccReductionOperator::Operator::Plus:
+    case ReductionOperator::Operator::Plus:
       Word("+");
       break;
-    case AccReductionOperator::Operator::Multiply:
+    case ReductionOperator::Operator::Multiply:
       Word("*");
       break;
-    case AccReductionOperator::Operator::And:
+    case ReductionOperator::Operator::And:
       Word(".AND.");
       break;
-    case AccReductionOperator::Operator::Or:
+    case ReductionOperator::Operator::Or:
       Word(".OR.");
       break;
-    case AccReductionOperator::Operator::Eqv:
+    case ReductionOperator::Operator::Eqv:
       Word(".EQV.");
       break;
-    case AccReductionOperator::Operator::Neqv:
+    case ReductionOperator::Operator::Neqv:
       Word(".NEQV.");
       break;
     default:
-      Word(AccReductionOperator::EnumToString(x));
+      Word(ReductionOperator::EnumToString(x));
       break;
     }
   }

flang/lib/Semantics/check-acc-structure.cpp

@@ -22,33 +22,33 @@
   }
 
 using ReductionOpsSet =
-    Fortran::common::EnumSet<Fortran::parser::AccReductionOperator::Operator,
-        Fortran::parser::AccReductionOperator::Operator_enumSize>;
+    Fortran::common::EnumSet<Fortran::parser::ReductionOperator::Operator,
+        Fortran::parser::ReductionOperator::Operator_enumSize>;
 
 static ReductionOpsSet reductionIntegerSet{
-    Fortran::parser::AccReductionOperator::Operator::Plus,
-    Fortran::parser::AccReductionOperator::Operator::Multiply,
-    Fortran::parser::AccReductionOperator::Operator::Max,
-    Fortran::parser::AccReductionOperator::Operator::Min,
-    Fortran::parser::AccReductionOperator::Operator::Iand,
-    Fortran::parser::AccReductionOperator::Operator::Ior,
-    Fortran::parser::AccReductionOperator::Operator::Ieor};
+    Fortran::parser::ReductionOperator::Operator::Plus,
+    Fortran::parser::ReductionOperator::Operator::Multiply,
+    Fortran::parser::ReductionOperator::Operator::Max,
+    Fortran::parser::ReductionOperator::Operator::Min,
+    Fortran::parser::ReductionOperator::Operator::Iand,
+    Fortran::parser::ReductionOperator::Operator::Ior,
+    Fortran::parser::ReductionOperator::Operator::Ieor};
 
 static ReductionOpsSet reductionRealSet{
-    Fortran::parser::AccReductionOperator::Operator::Plus,
-    Fortran::parser::AccReductionOperator::Operator::Multiply,
-    Fortran::parser::AccReductionOperator::Operator::Max,
-    Fortran::parser::AccReductionOperator::Operator::Min};
+    Fortran::parser::ReductionOperator::Operator::Plus,
+    Fortran::parser::ReductionOperator::Operator::Multiply,
+    Fortran::parser::ReductionOperator::Operator::Max,
+    Fortran::parser::ReductionOperator::Operator::Min};
 
 static ReductionOpsSet reductionComplexSet{
-    Fortran::parser::AccReductionOperator::Operator::Plus,
-    Fortran::parser::AccReductionOperator::Operator::Multiply};
+    Fortran::parser::ReductionOperator::Operator::Plus,
+    Fortran::parser::ReductionOperator::Operator::Multiply};
 
 static ReductionOpsSet reductionLogicalSet{
-    Fortran::parser::AccReductionOperator::Operator::And,
-    Fortran::parser::AccReductionOperator::Operator::Or,
-    Fortran::parser::AccReductionOperator::Operator::Eqv,
-    Fortran::parser::AccReductionOperator::Operator::Neqv};
+    Fortran::parser::ReductionOperator::Operator::And,
+    Fortran::parser::ReductionOperator::Operator::Or,
+    Fortran::parser::ReductionOperator::Operator::Eqv,
+    Fortran::parser::ReductionOperator::Operator::Neqv};
 
 namespace Fortran::semantics {
 
@@ -670,7 +670,7 @@ void AccStructureChecker::Enter(const parser::AccClause::Reduction &reduction) {
   // The following check that the reduction operator is supported with the given
   // type.
   const parser::AccObjectListWithReduction &list{reduction.v};
-  const auto &op{std::get<parser::AccReductionOperator>(list.t)};
+  const auto &op{std::get<parser::ReductionOperator>(list.t)};
   const auto &objects{std::get<parser::AccObjectList>(list.t)};
 
   for (const auto &object : objects.v) {

flang/lib/Semantics/check-cuda.cpp

@@ -475,21 +475,21 @@ static void CheckReduce(
         auto cat{type->category()};
         bool isOk{false};
         switch (op) {
-        case parser::AccReductionOperator::Operator::Plus:
-        case parser::AccReductionOperator::Operator::Multiply:
-        case parser::AccReductionOperator::Operator::Max:
-        case parser::AccReductionOperator::Operator::Min:
+        case parser::ReductionOperator::Operator::Plus:
+        case parser::ReductionOperator::Operator::Multiply:
+        case parser::ReductionOperator::Operator::Max:
+        case parser::ReductionOperator::Operator::Min:
           isOk = cat == TypeCategory::Integer || cat == TypeCategory::Real;
           break;
-        case parser::AccReductionOperator::Operator::Iand:
-        case parser::AccReductionOperator::Operator::Ior:
-        case parser::AccReductionOperator::Operator::Ieor:
+        case parser::ReductionOperator::Operator::Iand:
+        case parser::ReductionOperator::Operator::Ior:
+        case parser::ReductionOperator::Operator::Ieor:
           isOk = cat == TypeCategory::Integer;
           break;
-        case parser::AccReductionOperator::Operator::And:
-        case parser::AccReductionOperator::Operator::Or:
-        case parser::AccReductionOperator::Operator::Eqv:
-        case parser::AccReductionOperator::Operator::Neqv:
+        case parser::ReductionOperator::Operator::And:
+        case parser::ReductionOperator::Operator::Or:
+        case parser::ReductionOperator::Operator::Eqv:
+        case parser::ReductionOperator::Operator::Neqv:
           isOk = cat == TypeCategory::Logical;
           break;
         }