[flang][OpenMP] Parse iterators, add to MAP clause, TODO for lowering

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

@@ -474,6 +474,8 @@ class ParseTreeDumper {
   NODE(parser, NullInit)
   NODE(parser, ObjectDecl)
   NODE(parser, OldParameterStmt)
+  NODE(parser, OmpIteratorSpecifier)
+  NODE(parser, OmpIteratorModifier)
   NODE(parser, OmpAlignedClause)
   NODE(parser, OmpAtomic)
   NODE(parser, OmpAtomicCapture)

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

@@ -3424,7 +3424,17 @@ struct AssignedGotoStmt {
 
 WRAPPER_CLASS(PauseStmt, std::optional<StopCode>);
 
-// Parse tree nodes for OpenMP 4.5 directives and clauses
+// Parse tree nodes for OpenMP 4.5+ directives and clauses
+
+// [5.0] 2.1.6 iterator-specifier -> type-declaration-stmt = subscript-triple
+//             iterator-modifier -> iterator-specifier-list
+struct OmpIteratorSpecifier {
+  TUPLE_CLASS_BOILERPLATE(OmpIteratorSpecifier);
+  CharBlock source;
+  std::tuple<TypeDeclarationStmt, SubscriptTriplet> t;
+};
+
+WRAPPER_CLASS(OmpIteratorModifier, std::list<OmpIteratorSpecifier>);
 
 // 2.5 proc-bind-clause -> PROC_BIND (MASTER | CLOSE | SPREAD)
 struct OmpProcBindClause {
@@ -3450,16 +3460,25 @@ struct OmpObject {
 WRAPPER_CLASS(OmpObjectList, std::list<OmpObject>);
 
 // 2.15.5.1 map ->
-//    MAP ([ [map-type-modifiers [,] ] map-type : ] variable-name-list)
-// map-type-modifiers -> map-type-modifier [,] [...]
+//    MAP ([[map-type-modifier-list [,]] [iterator-modifier [,]] map-type : ]
+//         variable-name-list)
+// map-type-modifier-list -> map-type-modifier [,] [...]
 // map-type-modifier -> ALWAYS | CLOSE | PRESENT | OMPX_HOLD
 // map-type -> TO | FROM | TOFROM | ALLOC | RELEASE | DELETE
 struct OmpMapClause {
-  ENUM_CLASS(TypeModifier, Always, Close, Present, OmpxHold);
+  ENUM_CLASS(TypeModifier, Always, Close, Present, Ompx_Hold);
   ENUM_CLASS(Type, To, From, Tofrom, Alloc, Release, Delete)
   TUPLE_CLASS_BOILERPLATE(OmpMapClause);
-  std::tuple<std::optional<std::list<TypeModifier>>, std::optional<Type>,
-      OmpObjectList>
+
+  // All modifiers are parsed into optional lists, even if they are unique.
+  // The checks for satisfying those constraints are deferred to semantics.
+  // In OpenMP 5.2 the non-comma syntax has been deprecated: keep the
+  // information about separator presence to emit a diagnostic if needed.
+  std::tuple<std::optional<std::list<TypeModifier>>,
+      std::optional<std::list<OmpIteratorModifier>>, // unique
+      std::optional<std::list<Type>>, // unique
+      OmpObjectList,
+      bool> // were the modifiers comma-separated
       t;
 };
 

flang/lib/Lower/OpenMP/ClauseProcessor.cpp

@@ -936,57 +936,64 @@ bool ClauseProcessor::processMap(
            llvm::SmallVector<OmpMapMemberIndicesData>>
       parentMemberIndices;
 
-  bool clauseFound = findRepeatableClause<omp::clause::Map>(
-      [&](const omp::clause::Map &clause, const parser::CharBlock &source) {
-        using Map = omp::clause::Map;
-        mlir::Location clauseLocation = converter.genLocation(source);
-        const auto &mapType = std::get<std::optional<Map::MapType>>(clause.t);
-        llvm::omp::OpenMPOffloadMappingFlags mapTypeBits =
-            llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_NONE;
-        // If the map type is specified, then process it else Tofrom is the
-        // default.
-        Map::MapType type = mapType.value_or(Map::MapType::Tofrom);
-        switch (type) {
-        case Map::MapType::To:
-          mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_TO;
-          break;
-        case Map::MapType::From:
-          mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_FROM;
-          break;
-        case Map::MapType::Tofrom:
-          mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_TO |
-                         llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_FROM;
-          break;
-        case Map::MapType::Alloc:
-        case Map::MapType::Release:
-          // alloc and release is the default map_type for the Target Data
-          // Ops, i.e. if no bits for map_type is supplied then alloc/release
-          // is implicitly assumed based on the target directive. Default
-          // value for Target Data and Enter Data is alloc and for Exit Data
-          // it is release.
-          break;
-        case Map::MapType::Delete:
-          mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_DELETE;
-        }
+  auto process = [&](const omp::clause::Map &clause,
+                     const parser::CharBlock &source) {
+    using Map = omp::clause::Map;
+    mlir::Location clauseLocation = converter.genLocation(source);
+    const auto &mapType = std::get<std::optional<Map::MapType>>(clause.t);
+    llvm::omp::OpenMPOffloadMappingFlags mapTypeBits =
+        llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_NONE;
+    // If the map type is specified, then process it else Tofrom is the
+    // default.
+    Map::MapType type = mapType.value_or(Map::MapType::Tofrom);
+    switch (type) {
+    case Map::MapType::To:
+      mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_TO;
+      break;
+    case Map::MapType::From:
+      mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_FROM;
+      break;
+    case Map::MapType::Tofrom:
+      mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_TO |
+                     llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_FROM;
+      break;
+    case Map::MapType::Alloc:
+    case Map::MapType::Release:
+      // alloc and release is the default map_type for the Target Data
+      // Ops, i.e. if no bits for map_type is supplied then alloc/release
+      // is implicitly assumed based on the target directive. Default
+      // value for Target Data and Enter Data is alloc and for Exit Data
+      // it is release.
+      break;
+    case Map::MapType::Delete:
+      mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_DELETE;
+    }
 
-        auto &modTypeMods =
-            std::get<std::optional<Map::MapTypeModifiers>>(clause.t);
-        if (modTypeMods) {
-          if (llvm::is_contained(*modTypeMods, Map::MapTypeModifier::Always))
-            mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_ALWAYS;
-          // Diagnose unimplemented map-type-modifiers.
-          if (llvm::any_of(*modTypeMods, [](Map::MapTypeModifier m) {
-                return m != Map::MapTypeModifier::Always;
-              })) {
-            TODO(currentLocation, "Map type modifiers (other than 'ALWAYS')"
-                                  " are not implemented yet");
-          }
-        }
-        processMapObjects(stmtCtx, clauseLocation,
-                          std::get<omp::ObjectList>(clause.t), mapTypeBits,
-                          parentMemberIndices, result.mapVars, *ptrMapSyms);
-      });
+    auto &modTypeMods =
+        std::get<std::optional<Map::MapTypeModifiers>>(clause.t);
+    if (modTypeMods) {
+      if (llvm::is_contained(*modTypeMods, Map::MapTypeModifier::Always))
+        mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_ALWAYS;
+      // Diagnose unimplemented map-type-modifiers.
+      if (llvm::any_of(*modTypeMods, [](Map::MapTypeModifier m) {
+            return m != Map::MapTypeModifier::Always;
+          })) {
+        TODO(currentLocation, "Map type modifiers (other than 'ALWAYS')"
+                              " are not implemented yet");
+      }
+    }
+
+    if (std::get<std::optional<omp::clause::Iterator>>(clause.t)) {
+      TODO(currentLocation,
+           "Support for iterator modifiers is not implemented yet");
+    }
+
+    processMapObjects(stmtCtx, clauseLocation,
+                      std::get<omp::ObjectList>(clause.t), mapTypeBits,
+                      parentMemberIndices, result.mapVars, *ptrMapSyms);
+  };
 
+  bool clauseFound = findRepeatableClause<omp::clause::Map>(process);
   insertChildMapInfoIntoParent(converter, parentMemberIndices, result.mapVars,
                                *ptrMapSyms);
 

flang/lib/Lower/OpenMP/Clauses.cpp

@@ -232,6 +232,46 @@ MAKE_INCOMPLETE_CLASS(Match, Match);
 // MAKE_INCOMPLETE_CLASS(Otherwise, );   // missing-in-parser
 MAKE_INCOMPLETE_CLASS(When, When);
 
+List<IteratorSpecifier>
+makeIteratorSpecifiers(const parser::OmpIteratorSpecifier &inp,
+                       semantics::SemanticsContext &semaCtx) {
+  List<IteratorSpecifier> specifiers;
+
+  auto &[begin, end, step] = std::get<parser::SubscriptTriplet>(inp.t).t;
+  assert(begin && end && "Expecting begin/end values");
+  evaluate::ExpressionAnalyzer ea{semaCtx};
+
+  MaybeExpr rbegin{ea.Analyze(*begin)}, rend{ea.Analyze(*end)};
+  MaybeExpr rstep;
+  if (step)
+    rstep = ea.Analyze(*step);
+
+  assert(rbegin && rend && "Unable to get range bounds");
+  Range range{{*rbegin, *rend, rstep}};
+
+  auto &tds = std::get<parser::TypeDeclarationStmt>(inp.t);
+  auto &entities = std::get<std::list<parser::EntityDecl>>(tds.t);
+  for (const parser::EntityDecl &ed : entities) {
+    auto &name = std::get<parser::ObjectName>(ed.t);
+    assert(name.symbol && "Expecting symbol for iterator variable");
+    auto *stype = name.symbol->GetType();
+    assert(stype && "Expecting symbol type");
+    IteratorSpecifier spec{{evaluate::DynamicType::From(*stype),
+                            makeObject(name, semaCtx), range}};
+    specifiers.emplace_back(std::move(spec));
+  }
+
+  return specifiers;
+}
+
+Iterator makeIterator(const parser::OmpIteratorModifier &inp,
+                      semantics::SemanticsContext &semaCtx) {
+  Iterator iterator;
+  for (auto &&spec : inp.v)
+    llvm::append_range(iterator, makeIteratorSpecifiers(spec, semaCtx));
+  return iterator;
+}
+
 DefinedOperator makeDefinedOperator(const parser::DefinedOperator &inp,
                                     semantics::SemanticsContext &semaCtx) {
   CLAUSET_ENUM_CONVERT( //
@@ -843,18 +883,32 @@ Map make(const parser::OmpClause::Map &inp,
   CLAUSET_ENUM_CONVERT( //
       convert2, parser::OmpMapClause::TypeModifier, Map::MapTypeModifier,
       // clang-format off
-      MS(Always,   Always)
-      MS(Close,    Close)
-      MS(OmpxHold, OmpxHold)
-      MS(Present,  Present)
+      MS(Always,    Always)
+      MS(Close,     Close)
+      MS(Ompx_Hold, OmpxHold)
+      MS(Present,   Present)
       // clang-format on
   );
 
   auto &t0 = std::get<std::optional<std::list<wrapped::TypeModifier>>>(inp.v.t);
-  auto &t1 = std::get<std::optional<wrapped::Type>>(inp.v.t);
-  auto &t2 = std::get<parser::OmpObjectList>(inp.v.t);
+  auto &t1 =
+      std::get<std::optional<std::list<parser::OmpIteratorModifier>>>(inp.v.t);
+  auto &t2 = std::get<std::optional<std::list<wrapped::Type>>>(inp.v.t);
+  auto &t3 = std::get<parser::OmpObjectList>(inp.v.t);
+
+  // These should have been diagnosed already.
+  assert((!t1 || t1->size() == 1) && "Only one iterator modifier is allowed");
+  assert((!t2 || t2->size() == 1) && "Only one map type is allowed");
+
+  auto iterator = [&]() -> std::optional<Iterator> {
+    if (t1)
+      return makeIterator(t1->front(), semaCtx);
+    return std::nullopt;
+  }();
 
-  std::optional<Map::MapType> maybeType = maybeApply(convert1, t1);
+  std::optional<Map::MapType> maybeType;
+  if (t2)
+    maybeType = maybeApply(convert1, std::optional<wrapped::Type>(t2->front()));
 
   std::optional<Map::MapTypeModifiers> maybeTypeMods = maybeApply(
       [&](const std::list<wrapped::TypeModifier> &typeMods) {
@@ -867,8 +921,8 @@ Map make(const parser::OmpClause::Map &inp,
 
   return Map{{/*MapType=*/maybeType,
               /*MapTypeModifiers=*/maybeTypeMods,
-              /*Mapper=*/std::nullopt, /*Iterator=*/std::nullopt,
-              /*LocatorList=*/makeObjects(t2, semaCtx)}};
+              /*Mapper=*/std::nullopt, /*Iterator=*/std::move(iterator),
+              /*LocatorList=*/makeObjects(t3, semaCtx)}};
 }
 
 // Match: incomplete

flang/lib/Lower/OpenMP/Clauses.h

@@ -9,6 +9,7 @@
 #define FORTRAN_LOWER_OPENMP_CLAUSES_H
 
 #include "flang/Evaluate/expression.h"
+#include "flang/Evaluate/type.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/semantics.h"
@@ -29,12 +30,7 @@ namespace Fortran::lower::omp {
 using namespace Fortran;
 using SomeExpr = semantics::SomeExpr;
 using MaybeExpr = semantics::MaybeExpr;
-
-// evaluate::SomeType doesn't provide == operation. It's not really used in
-// flang's clauses so far, so a trivial implementation is sufficient.
-struct TypeTy : public evaluate::SomeType {
-  bool operator==(const TypeTy &t) const { return true; }
-};
+using TypeTy = evaluate::DynamicType;
 
 template <typename ExprTy>
 struct IdTyTemplate {
@@ -150,6 +146,9 @@ std::optional<Object> getBaseObject(const Object &object,
                                     semantics::SemanticsContext &semaCtx);
 
 namespace clause {
+using Range = tomp::type::RangeT<ExprTy>;
+using Iterator = tomp::type::IteratorT<TypeTy, IdTy, ExprTy>;
+using IteratorSpecifier = tomp::type::IteratorSpecifierT<TypeTy, IdTy, ExprTy>;
 using DefinedOperator = tomp::type::DefinedOperatorT<IdTy, ExprTy>;
 using ProcedureDesignator = tomp::type::ProcedureDesignatorT<IdTy, ExprTy>;
 using ReductionOperator = tomp::type::ReductionIdentifierT<IdTy, ExprTy>;