[flang][OpenMP] Parse cancel-directive-name as clause

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

@@ -489,7 +489,9 @@ class ParseTreeDumper {
   NODE(parser, OmpOtherwiseClause)
   NODE(parser, OmpWhenClause)
   NODE(OmpWhenClause, Modifier)
+  NODE(parser, OmpDirectiveName)
   NODE(parser, OmpDirectiveSpecification)
+  NODE_ENUM(OmpDirectiveSpecification, Flags)
   NODE(parser, OmpTraitPropertyName)
   NODE(parser, OmpTraitScore)
   NODE(parser, OmpTraitPropertyExtension)
@@ -544,6 +546,7 @@ class ParseTreeDumper {
 #define GEN_FLANG_DUMP_PARSE_TREE_CLAUSES
 #include "llvm/Frontend/OpenMP/OMP.inc"
   NODE(parser, OmpClauseList)
+  NODE(parser, OmpCancellationConstructTypeClause)
   NODE(parser, OmpContainsClause)
   NODE(parser, OmpCriticalDirective)
   NODE(parser, OmpErrorDirective)
@@ -586,7 +589,6 @@ class ParseTreeDumper {
   NODE(OmpFromClause, Modifier)
   NODE(parser, OmpExpectation)
   NODE_ENUM(OmpExpectation, Value)
-  NODE(parser, OmpDirectiveNameModifier)
   NODE(parser, OmpHoldsClause)
   NODE(parser, OmpIfClause)
   NODE(OmpIfClause, Modifier)
@@ -687,7 +689,6 @@ class ParseTreeDumper {
   NODE(parser, OpenMPAtomicConstruct)
   NODE(parser, OpenMPBlockConstruct)
   NODE(parser, OpenMPCancelConstruct)
-  NODE(OpenMPCancelConstruct, If)
   NODE(parser, OpenMPCancellationPointConstruct)
   NODE(parser, OpenMPConstruct)
   NODE(parser, OpenMPCriticalConstruct)

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

@@ -3464,6 +3464,19 @@ WRAPPER_CLASS(PauseStmt, std::optional<StopCode>);
 struct OmpClause;
 struct OmpDirectiveSpecification;
 
+struct OmpDirectiveName {
+  // No boilerplates: this class should be copyable, movable, etc.
+  constexpr OmpDirectiveName() = default;
+  constexpr OmpDirectiveName(const OmpDirectiveName &) = default;
+  // Construct from an already parsed text. Use Verbatim for this because
+  // Verbatim's source corresponds to an actual source location.
+  // This allows "construct<OmpDirectiveName>(Verbatim("<name>"))".
+  OmpDirectiveName(const Verbatim &name);
+  using WrapperTrait = std::true_type;
+  CharBlock source;
+  llvm::omp::Directive v{llvm::omp::Directive::OMPD_unknown};
+};
+
 // 2.1 Directives or clauses may accept a list or extended-list.
 //     A list item is a variable, array section or common block name (enclosed
 //     in slashes). An extended list item is a list item or a procedure Name.
@@ -3794,9 +3807,7 @@ struct OmpDeviceModifier {
 // [*] The IF clause is allowed on CANCEL in OpenMP 4.5, but only without
 // the directive-name-modifier. For the sake of uniformity CANCEL can be
 // considered a valid value in 4.5 as well.
-struct OmpDirectiveNameModifier {
-  WRAPPER_CLASS_BOILERPLATE(OmpDirectiveNameModifier, llvm::omp::Directive);
-};
+using OmpDirectiveNameModifier = OmpDirectiveName;
 
 // Ref: [5.1:205-209], [5.2:166-168]
 //
@@ -4036,6 +4047,12 @@ struct OmpBindClause {
   WRAPPER_CLASS_BOILERPLATE(OmpBindClause, Binding);
 };
 
+// Artificial clause to represent a cancellable construct.
+struct OmpCancellationConstructTypeClause {
+  TUPLE_CLASS_BOILERPLATE(OmpCancellationConstructTypeClause);
+  std::tuple<OmpDirectiveName, std::optional<ScalarLogicalExpr>> t;
+};
+
 // Ref: [5.2:214]
 //
 // contains-clause ->
@@ -4491,10 +4508,16 @@ struct OmpClauseList {
 // --- Directives and constructs
 
 struct OmpDirectiveSpecification {
-  CharBlock source;
+  ENUM_CLASS(Flags, None, DeprecatedSyntax);
   TUPLE_CLASS_BOILERPLATE(OmpDirectiveSpecification);
-  std::tuple<llvm::omp::Directive, std::optional<std::list<OmpArgument>>,
-      std::optional<OmpClauseList>>
+  llvm::omp::Directive DirId() const { //
+    return std::get<OmpDirectiveName>(t).v;
+  }
+  const OmpClauseList &Clauses() const;
+
+  CharBlock source;
+  std::tuple<OmpDirectiveName, std::optional<std::list<OmpArgument>>,
+      std::optional<OmpClauseList>, Flags>
       t;
 };
 
@@ -4853,15 +4876,14 @@ struct OmpCancelType {
 struct OpenMPCancellationPointConstruct {
   TUPLE_CLASS_BOILERPLATE(OpenMPCancellationPointConstruct);
   CharBlock source;
-  std::tuple<Verbatim, OmpCancelType> t;
+  std::tuple<Verbatim, OmpClauseList> t;
 };
 
 // 2.14.1 cancel -> CANCEL construct-type-clause [ [,] if-clause]
 struct OpenMPCancelConstruct {
   TUPLE_CLASS_BOILERPLATE(OpenMPCancelConstruct);
-  WRAPPER_CLASS(If, ScalarLogicalExpr);
   CharBlock source;
-  std::tuple<Verbatim, OmpCancelType, std::optional<If>> t;
+  std::tuple<Verbatim, OmpClauseList> t;
 };
 
 // Ref: [5.0:254-255], [5.1:287-288], [5.2:322-323]

flang/lib/Parser/openmp-parsers.cpp

@@ -27,15 +27,40 @@ namespace Fortran::parser {
 constexpr auto startOmpLine = skipStuffBeforeStatement >> "!$OMP "_sptok;
 constexpr auto endOmpLine = space >> endOfLine;
 
+// Given a parser P for a wrapper class, invoke P, and if it succeeds return
+// the wrapped object.
+template <typename Parser> struct UnwrapParser {
+  static_assert(
+      Parser::resultType::WrapperTrait::value && "Wrapper class required");
+  using resultType = decltype(Parser::resultType::v);
+  constexpr UnwrapParser(Parser p) : parser_(p) {}
+
+  std::optional<resultType> Parse(ParseState &state) const {
+    if (auto result{parser_.Parse(state)}) {
+      return result->v;
+    }
+    return std::nullopt;
+  }
+
+private:
+  const Parser parser_;
+};
+
+template <typename Parser> constexpr auto unwrap(const Parser &p) {
+  return UnwrapParser<Parser>(p);
+}
+
 /// Parse OpenMP directive name (this includes compound directives).
 struct OmpDirectiveNameParser {
-  using resultType = llvm::omp::Directive;
+  using resultType = OmpDirectiveName;
   using Token = TokenStringMatch<false, false>;
 
   std::optional<resultType> Parse(ParseState &state) const {
     for (const NameWithId &nid : directives()) {
       if (attempt(Token(nid.first.data())).Parse(state)) {
-        return nid.second;
+        OmpDirectiveName n;
+        n.v = nid.second;
+        return n;
       }
     }
     return std::nullopt;
@@ -218,7 +243,7 @@ TYPE_PARSER(construct<OmpTraitSelectorName::Value>(
 TYPE_PARSER(sourced(construct<OmpTraitSelectorName>(
     // Parse predefined names first (because of SIMD).
     construct<OmpTraitSelectorName>(Parser<OmpTraitSelectorName::Value>{}) ||
-    construct<OmpTraitSelectorName>(OmpDirectiveNameParser{}) ||
+    construct<OmpTraitSelectorName>(unwrap(OmpDirectiveNameParser{})) ||
     // identifier-or-string for extensions
     construct<OmpTraitSelectorName>(
         applyFunction(nameToString, Parser<Name>{})) ||
@@ -775,12 +800,13 @@ TYPE_PARSER(construct<OmpMessageClause>(expr))
 
 TYPE_PARSER(construct<OmpHoldsClause>(indirect(expr)))
 TYPE_PARSER(construct<OmpAbsentClause>(many(maybe(","_tok) >>
-    construct<llvm::omp::Directive>(OmpDirectiveNameParser{}))))
+    construct<llvm::omp::Directive>(unwrap(OmpDirectiveNameParser{})))))
 TYPE_PARSER(construct<OmpContainsClause>(many(maybe(","_tok) >>
-    construct<llvm::omp::Directive>(OmpDirectiveNameParser{}))))
+    construct<llvm::omp::Directive>(unwrap(OmpDirectiveNameParser{})))))
 
-TYPE_PARSER("ABSENT" >> construct<OmpClause>(construct<OmpClause::Absent>(
-                            parenthesized(Parser<OmpAbsentClause>{}))) ||
+TYPE_PARSER( //
+    "ABSENT" >> construct<OmpClause>(construct<OmpClause::Absent>(
+                    parenthesized(Parser<OmpAbsentClause>{}))) ||
     "ACQUIRE" >> construct<OmpClause>(construct<OmpClause::Acquire>()) ||
     "ACQ_REL" >> construct<OmpClause>(construct<OmpClause::AcqRel>()) ||
     "AFFINITY" >> construct<OmpClause>(construct<OmpClause::Affinity>(
@@ -957,7 +983,24 @@ TYPE_PARSER("ABSENT" >> construct<OmpClause>(construct<OmpClause::Absent>(
     "UPDATE" >> construct<OmpClause>(construct<OmpClause::Update>(
                     parenthesized(Parser<OmpUpdateClause>{}))) ||
     "WHEN" >> construct<OmpClause>(construct<OmpClause::When>(
-                  parenthesized(Parser<OmpWhenClause>{}))))
+                  parenthesized(Parser<OmpWhenClause>{}))) ||
+    // Cancellable constructs
+    construct<OmpClause>(construct<OmpClause::CancellationConstructType>(
+        construct<OmpCancellationConstructTypeClause>( //
+            construct<OmpDirectiveName>(verbatim("DO"_id)),
+            maybe(parenthesized(scalarLogicalExpr))))) ||
+    construct<OmpClause>(construct<OmpClause::CancellationConstructType>(
+        construct<OmpCancellationConstructTypeClause>( //
+            construct<OmpDirectiveName>(verbatim("PARALLEL"_id)),
+            maybe(parenthesized(scalarLogicalExpr))))) ||
+    construct<OmpClause>(construct<OmpClause::CancellationConstructType>(
+        construct<OmpCancellationConstructTypeClause>( //
+            construct<OmpDirectiveName>(verbatim("SECTIONS"_id)),
+            maybe(parenthesized(scalarLogicalExpr))))) ||
+    construct<OmpClause>(construct<OmpClause::CancellationConstructType>(
+        construct<OmpCancellationConstructTypeClause>( //
+            construct<OmpDirectiveName>(verbatim("TASKGROUP"_id)),
+            maybe(parenthesized(scalarLogicalExpr))))))
 
 // [Clause, [Clause], ...]
 TYPE_PARSER(sourced(construct<OmpClauseList>(
@@ -971,10 +1014,33 @@ TYPE_PARSER(sourced(construct<OmpErrorDirective>(
 
 // --- Parsers for directives and constructs --------------------------
 
-TYPE_PARSER(sourced(construct<OmpDirectiveSpecification>( //
-    OmpDirectiveNameParser{},
-    maybe(parenthesized(nonemptyList(Parser<OmpArgument>{}))),
-    maybe(Parser<OmpClauseList>{}))))
+OmpDirectiveSpecification static makeFlushFromOldSyntax1(Verbatim &&text,
+    std::optional<OmpClauseList> &&clauses,
+    std::optional<std::list<OmpArgument>> &&args,
+    OmpDirectiveSpecification::Flags &&flags) {
+  return OmpDirectiveSpecification{OmpDirectiveName(text), std::move(args),
+      std::move(clauses), std::move(flags)};
+}
+
+TYPE_PARSER(sourced(
+    // Parse the old syntax: FLUSH [clauses] [(objects)]
+    construct<OmpDirectiveSpecification>(
+        // Force this old-syntax parser to fail for FLUSH followed by '('.
+        // Otherwise it could succeed on the new syntax but have one of
+        // lists absent in the parsed result.
+        // E.g. for FLUSH(x) SEQ_CST it would find no clauses following
+        // the directive name, parse the argument list "(x)" and stop.
+        applyFunction<OmpDirectiveSpecification>(makeFlushFromOldSyntax1,
+            verbatim("FLUSH"_tok) / !lookAhead("("_tok),
+            maybe(Parser<OmpClauseList>{}),
+            maybe(parenthesized(nonemptyList(Parser<OmpArgument>{}))),
+            pure(OmpDirectiveSpecification::Flags::DeprecatedSyntax))) ||
+    // Parse the standard syntax: directive [(arguments)] [clauses]
+    construct<OmpDirectiveSpecification>( //
+        sourced(OmpDirectiveNameParser{}),
+        maybe(parenthesized(nonemptyList(Parser<OmpArgument>{}))),
+        maybe(Parser<OmpClauseList>{}),
+        pure(OmpDirectiveSpecification::Flags::None))))
 
 TYPE_PARSER(sourced(construct<OmpNothingDirective>("NOTHING" >> ok)))
 
@@ -1057,11 +1123,11 @@ TYPE_PARSER(sourced(construct<OmpCancelType>(
 
 // 2.14.2 Cancellation Point construct
 TYPE_PARSER(sourced(construct<OpenMPCancellationPointConstruct>(
-    verbatim("CANCELLATION POINT"_tok), Parser<OmpCancelType>{})))
+    verbatim("CANCELLATION POINT"_tok), Parser<OmpClauseList>{})))
 
 // 2.14.1 Cancel construct
-TYPE_PARSER(sourced(construct<OpenMPCancelConstruct>(verbatim("CANCEL"_tok),
-    Parser<OmpCancelType>{}, maybe("IF" >> parenthesized(scalarLogicalExpr)))))
+TYPE_PARSER(sourced(construct<OpenMPCancelConstruct>(
+    verbatim("CANCEL"_tok), Parser<OmpClauseList>{})))
 
 TYPE_PARSER(sourced(construct<OmpFailClause>(
     parenthesized(indirect(Parser<OmpMemoryOrderClause>{})))))
@@ -1145,9 +1211,10 @@ TYPE_PARSER(
     sourced(construct<OpenMPStandaloneConstruct>(
                 Parser<OpenMPSimpleStandaloneConstruct>{}) ||
         construct<OpenMPStandaloneConstruct>(Parser<OpenMPFlushConstruct>{}) ||
-        construct<OpenMPStandaloneConstruct>(Parser<OpenMPCancelConstruct>{}) ||
+        // Try CANCELLATION POINT before CANCEL.
         construct<OpenMPStandaloneConstruct>(
             Parser<OpenMPCancellationPointConstruct>{}) ||
+        construct<OpenMPStandaloneConstruct>(Parser<OpenMPCancelConstruct>{}) ||
         construct<OpenMPStandaloneConstruct>(
             Parser<OmpMetadirectiveDirective>{}) ||
         construct<OpenMPStandaloneConstruct>(Parser<OpenMPDepobjConstruct>{})) /

flang/lib/Parser/parse-tree.cpp

@@ -253,6 +253,23 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Name &x) {
   return os << x.ToString();
 }
 
+OmpDirectiveName::OmpDirectiveName(const Verbatim &name) {
+  std::string_view nameView{name.source.begin(), name.source.size()};
+  std::string nameLower{ToLowerCaseLetters(nameView)};
+  // The function getOpenMPDirectiveKind will return OMPD_unknown in two cases:
+  // (1) if the given string doesn't match any actual directive, or
+  // (2) if the given string was "unknown".
+  // The Verbatim(<token>) parser will succeed as long as the given token
+  // matches the source.
+  // Since using "construct<OmpDirectiveName>(verbatim(...))" will succeed
+  // if the verbatim parser succeeds, in order to get OMPD_unknown the
+  // token given to Verbatim must be invalid. Because it's an internal issue
+  // asserting is ok.
+  v = llvm::omp::getOpenMPDirectiveKind(nameLower);
+  assert(v != llvm::omp::Directive::OMPD_unknown && "Invalid directive name");
+  source = name.source;
+}
+
 OmpDependenceType::Value OmpDoacross::GetDepType() const {
   return common::visit( //
       common::visitors{
@@ -319,4 +336,12 @@ namespace Fortran::parser {
 llvm::omp::Clause OmpClause::Id() const {
   return std::visit([](auto &&s) { return getClauseIdForClass(s); }, u);
 }
+
+const OmpClauseList &OmpDirectiveSpecification::Clauses() const {
+  static OmpClauseList empty{std::move(decltype(OmpClauseList::v){})};
+  if (auto &clauses = std::get<std::optional<OmpClauseList>>(t)) {
+    return *clauses;
+  }
+  return empty;
+}
 } // namespace Fortran::parser

flang/lib/Parser/unparse.cpp

@@ -2094,14 +2094,30 @@ class UnparseVisitor {
     Word(llvm::omp::getOpenMPDirectiveName(x).str());
   }
   void Unparse(const OmpDirectiveSpecification &x) {
-    using ArgList = std::list<parser::OmpArgument>;
-    Walk(std::get<llvm::omp::Directive>(x.t));
-    if (auto &args{std::get<std::optional<ArgList>>(x.t)}) {
-      Put("(");
-      Walk(*args);
-      Put(")");
+    auto unparseArgs{[&]() {
+      using ArgList = std::list<parser::OmpArgument>;
+      if (auto &args{std::get<std::optional<ArgList>>(x.t)}) {
+        Put("(");
+        Walk(*args);
+        Put(")");
+      }
+    }};
+    auto unparseClauses{[&]() { //
+      Walk(std::get<std::optional<OmpClauseList>>(x.t));
+    }};
+
+    Walk(std::get<OmpDirectiveName>(x.t));
+    auto flags{std::get<OmpDirectiveSpecification::Flags>(x.t)};
+    if (flags == OmpDirectiveSpecification::Flags::DeprecatedSyntax) {
+      if (x.DirId() == llvm::omp::Directive::OMPD_flush) {
+        // FLUSH clause arglist
+        unparseClauses();
+        unparseArgs();
+      }
+    } else {
+      unparseArgs();
+      unparseClauses();
     }
-    Walk(std::get<std::optional<OmpClauseList>>(x.t));
   }
   void Unparse(const OmpTraitScore &x) {
     Word("SCORE(");
@@ -2835,15 +2851,14 @@ class UnparseVisitor {
   void Unparse(const OpenMPCancellationPointConstruct &x) {
     BeginOpenMP();
     Word("!$OMP CANCELLATION POINT ");
-    Walk(std::get<OmpCancelType>(x.t));
+    Walk(std::get<OmpClauseList>(x.t));
     Put("\n");
     EndOpenMP();
   }
   void Unparse(const OpenMPCancelConstruct &x) {
     BeginOpenMP();
     Word("!$OMP CANCEL ");
-    Walk(std::get<OmpCancelType>(x.t));
-    Walk(std::get<std::optional<OpenMPCancelConstruct::If>>(x.t));
+    Walk(std::get<OmpClauseList>(x.t));
     Put("\n");
     EndOpenMP();
   }