flang/lib/Parser/openacc-parsers.cpp

//===-- lib/Parser/openacc-parsers.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
//
//===----------------------------------------------------------------------===//

// Top-level grammar specification for OpenACC 3.3.

#include "basic-parsers.h"
#include "expr-parsers.h"
#include "misc-parsers.h"
#include "stmt-parser.h"
#include "token-parsers.h"
#include "type-parser-implementation.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/tools.h"
#include "flang/Parser/user-state.h"

// OpenACC Directives and Clauses
namespace Fortran::parser {

// Only need to handle ! line comments because prescanning normalizes the
// other types of line comments from fixed form.
constexpr auto startAccLine{skipStuffBeforeStatement >>
    withMessage(
        "expected OpenACC directive sentinel: !$ACC, C$ACC, or *$ACC"_err_en_US,
        "!$ACC "_sptok)};
constexpr auto endAccLine{space >>
    recovery(
        withMessage("expected end of OpenACC directive"_err_en_US, endOfLine),
        SkipTo<'\n'>{} || ok)};

// Autogenerated clauses parser. Information is taken from ACC.td and the
// parser is generated by tablegen.
// Scalar value parsers are provided by Flang directly. Specific value parsers
// are provided below.
#define GEN_FLANG_CLAUSES_PARSER
#include "llvm/Frontend/OpenACC/ACC.inc"

TYPE_PARSER(
    construct<AccObject>(designator) || construct<AccObject>("/" >> name / "/"))

TYPE_PARSER(construct<AccObjectList>(nonemptyList(Parser<AccObject>{})))

TYPE_PARSER(construct<AccObjectListWithModifier>(
    maybe(Parser<AccDataModifier>{}), Parser<AccObjectList>{}))

TYPE_PARSER(construct<AccObjectListWithReduction>(
    Parser<ReductionOperator>{} / ":", Parser<AccObjectList>{}))

// 2.16 (3249) wait-argument is:
//   [devnum : int-expr :] [queues :] int-expr-list
TYPE_PARSER(construct<AccWaitArgument>(maybe("DEVNUM :" >> scalarIntExpr / ":"),
    "QUEUES :" >> nonemptyList(scalarIntExpr) || nonemptyList(scalarIntExpr)))

// 2.9 (1984-1986) size-expr is one of:
//   * (represented as an empty std::optional<ScalarIntExpr>)
//   int-expr
TYPE_PARSER(construct<AccSizeExpr>(scalarIntExpr) ||
    construct<AccSizeExpr>("*" >> construct<std::optional<ScalarIntExpr>>()))
TYPE_PARSER(construct<AccSizeExprList>(nonemptyList(Parser<AccSizeExpr>{})))

TYPE_PARSER(sourced(construct<AccDeviceTypeExpr>(
    first("*" >> pure(Fortran::common::OpenACCDeviceType::Star),
        "DEFAULT" >> pure(Fortran::common::OpenACCDeviceType::Default),
        "NVIDIA" >> pure(Fortran::common::OpenACCDeviceType::Nvidia),
        "ACC_DEVICE_NVIDIA" >> pure(Fortran::common::OpenACCDeviceType::Nvidia),
        "RADEON" >> pure(Fortran::common::OpenACCDeviceType::Radeon),
        "HOST" >> pure(Fortran::common::OpenACCDeviceType::Host),
        "MULTICORE" >> pure(Fortran::common::OpenACCDeviceType::Multicore)))))

TYPE_PARSER(
    construct<AccDeviceTypeExprList>(nonemptyList(Parser<AccDeviceTypeExpr>{})))

// tile size is one of:
//   * (represented as an empty std::optional<ScalarIntExpr>)
//   constant-int-expr
TYPE_PARSER(sourced(construct<AccTileExpr>(scalarIntConstantExpr) ||
    construct<AccTileExpr>(
        "*" >> construct<std::optional<ScalarIntConstantExpr>>())))
TYPE_PARSER(construct<AccTileExprList>(nonemptyList(Parser<AccTileExpr>{})))

// 2.9 (1979-1982) gang-arg is one of :
//   [num:]int-expr
//   dim:int-expr
//   static:size-expr
TYPE_PARSER(sourced(construct<AccGangArg>(construct<AccGangArg::Static>(
                        "STATIC :" >> Parser<AccSizeExpr>{})) ||
    construct<AccGangArg>(
        construct<AccGangArg::Dim>("DIM :" >> scalarIntExpr)) ||
    construct<AccGangArg>(
        construct<AccGangArg::Num>(maybe("NUM :"_tok) >> scalarIntExpr))))

// 2.9 gang-arg-list
TYPE_PARSER(
    construct<AccGangArgList>(many(maybe(","_tok) >> Parser<AccGangArg>{})))

// 2.9.1 collapse
TYPE_PARSER(construct<AccCollapseArg>(
    "FORCE :"_tok >> pure(true) || pure(false), scalarIntConstantExpr))

// 2.5.15 Reduction, F'2023 R1131, and CUF reduction-op
// Operator for reduction
TYPE_PARSER(construct<ReductionOperator>(
    first("+" >> pure(ReductionOperator::Operator::Plus),
        "-" >> pure(ReductionOperator::Operator::Minus),
        "*" >> 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) ||
    construct<AccBindClause>(scalarDefaultCharExpr)))

// 2.5.16 Default clause
TYPE_PARSER(sourced(construct<AccDefaultClause>(
    first("NONE" >> pure(llvm::acc::DefaultValue::ACC_Default_none),
        "PRESENT" >> pure(llvm::acc::DefaultValue::ACC_Default_present)))))

// SELF clause is either a simple optional condition for compute construct
// or a synonym of the HOST clause for the update directive 2.14.4 holding
// an object list.
TYPE_PARSER(sourced(
    construct<AccSelfClause>(Parser<AccObjectList>{}) / lookAhead(")"_tok) ||
    construct<AccSelfClause>(scalarLogicalExpr) / lookAhead(")"_tok) ||
    construct<AccSelfClause>(
        recovery(fail<std::optional<ScalarLogicalExpr>>(
                     "logical expression or object list expected"_err_en_US),
            SkipTo<')'>{} >> pure<std::optional<ScalarLogicalExpr>>()))))

// Modifier for copyin, copyout, cache and create
TYPE_PARSER(sourced(construct<AccDataModifier>(
    first("ZERO :" >> pure(AccDataModifier::Modifier::Zero),
        "READONLY :" >> pure(AccDataModifier::Modifier::ReadOnly)))))

// Combined directives
TYPE_PARSER(sourced(construct<AccCombinedDirective>(
    first("KERNELS LOOP" >> pure(llvm::acc::Directive::ACCD_kernels_loop),
        "PARALLEL LOOP" >> pure(llvm::acc::Directive::ACCD_parallel_loop),
        "SERIAL LOOP" >> pure(llvm::acc::Directive::ACCD_serial_loop)))))

// Block directives
TYPE_PARSER(sourced(construct<AccBlockDirective>(
    first("DATA" >> pure(llvm::acc::Directive::ACCD_data),
        "HOST_DATA" >> pure(llvm::acc::Directive::ACCD_host_data),
        "KERNELS" >> pure(llvm::acc::Directive::ACCD_kernels),
        "PARALLEL" >> pure(llvm::acc::Directive::ACCD_parallel),
        "SERIAL" >> pure(llvm::acc::Directive::ACCD_serial)))))

// Standalone directives
TYPE_PARSER(sourced(construct<AccStandaloneDirective>(
    first("ENTER DATA" >> pure(llvm::acc::Directive::ACCD_enter_data),
        "EXIT DATA" >> pure(llvm::acc::Directive::ACCD_exit_data),
        "INIT" >> pure(llvm::acc::Directive::ACCD_init),
        "SHUTDOWN" >> pure(llvm::acc::Directive::ACCD_shutdown),
        "SET" >> pure(llvm::acc::Directive::ACCD_set),
        "UPDATE" >> pure(llvm::acc::Directive::ACCD_update)))))

// A non-block DO construct, e.g.
//   do 10 i = 1, n
//   10 continue
// is parsed as a flat sequence of statements and is only turned into a
// DoConstruct later, when the DO loops are canonicalized.  The DO loop
// associated with an OpenACC loop or combined construct has to be recognized
// while parsing the construct, otherwise the end directive that follows the
// loop cannot be attached to the construct.  Build the DoConstruct here, the
// same way the canonicalization of the DO loops would have built it.
struct AccNonBlockDoConstruct {
  using resultType = DoConstruct;
  using LabelDoStatement = Statement<common::Indirection<LabelDoStmt>>;

  std::optional<DoConstruct> Parse(ParseState &state) const {
    if (auto doStmt{CapturedLabelDoStmt::Parse(state)}) {
      if (auto loop{ParseLoop(state, std::move(*doStmt))}) {
        return std::move(loop->construct);
      }
    }
    return std::nullopt;
  }

private:
  struct Loop {
    DoConstruct construct;
    Label label; // of the statement that terminated the loop
  };

  static LabelDoStatement *GetLabelDoStatement(ExecutionPartConstruct &epc) {
    if (auto *executable{std::get_if<ExecutableConstruct>(&epc.u)}) {
      return std::get_if<LabelDoStatement>(&executable->u);
    }
    return nullptr;
  }

  // Parse execution part constructs until the statement carrying the label of
  // the DO statement has been seen, then build the DO construct.  Nested label
  // DO statements are turned into DO constructs here as well; loops that share
  // a label are all terminated by the same statement, which closes the
  // innermost loop and, with it, all of the loops that enclose it.
  std::optional<Loop> ParseLoop(
      ParseState &state, LabelDoStatement &&doStmt) const {
    const Label label{std::get<Label>(doStmt.statement.value().t)};
    Block body;
    bool terminated{false};
    while (!terminated) {
      auto epc{executionPartConstruct.Parse(state)};
      if (!epc) {
        return std::nullopt;
      }
      if (auto *nestedDoStmt{GetLabelDoStatement(*epc)}) {
        auto nested{ParseLoop(state, std::move(*nestedDoStmt))};
        if (!nested) {
          return std::nullopt;
        }
        terminated = nested->label == label;
        body.emplace_back(ExecutableConstruct{
            common::Indirection<DoConstruct>{std::move(nested->construct)}});
        continue;
      }
      std::optional<Label> epcLabel{GetStatementLabel(*epc)};
      if (!epcLabel) {
        if (auto *acc{Unwrap<OpenACCConstruct>(*epc)}) {
          epcLabel = GetFinalLabel(*acc);
        }
      }
      terminated = epcLabel && *epcLabel == label;
      body.emplace_back(std::move(*epc));
    }

    // The terminating statement may be an END DO statement; the DO construct
    // built below has its own synthetic one, so turn it into a CONTINUE
    // statement to keep its label and source.  Only an unnamed labeled DO
    // statement is parsed here (a named one is parsed as a DO construct), so
    // a construct name on the END DO statement is not allowed (C1135);
    // diagnose it before it is lost.
    if (auto *last{std::get_if<ExecutableConstruct>(&body.back().u)}) {
      if (auto *endDoStmt{
              std::get_if<Statement<common::Indirection<EndDoStmt>>>(
                  &last->u)}) {
        if (const auto &name{endDoStmt->statement.value().v}) {
          state.Say(name->source, "Unexpected DO construct name '%s'"_err_en_US,
              name->source);
        }
        Statement<ActionStmt> continueStmt{
            std::optional<Label>{endDoStmt->label}, ContinueStmt{}};
        continueStmt.source = endDoStmt->source;
        last->u = std::move(continueStmt);
      }
    }

    Statement<NonLabelDoStmt> nonLabelDoStmt{std::move(doStmt.label),
        NonLabelDoStmt{
            std::make_tuple(std::optional<Name>{}, std::optional<Label>{},
                std::move(std::get<std::optional<LoopControl>>(
                    doStmt.statement.value().t)))}};
    nonLabelDoStmt.source = doStmt.source;
    DoConstruct doConstruct{
        std::make_tuple(std::move(nonLabelDoStmt), std::move(body),
            Statement<EndDoStmt>{
                std::optional<Label>{}, EndDoStmt{std::optional<Name>{}}})};
    return Loop{std::move(doConstruct), label};
  }
};

// The DO loop associated with a loop or combined construct.
constexpr auto accAssociatedDoConstruct{
    Parser<DoConstruct>{} || AccNonBlockDoConstruct{}};

// Loop directives
TYPE_PARSER(sourced(construct<AccLoopDirective>(
    first("LOOP" >> pure(llvm::acc::Directive::ACCD_loop)))))

TYPE_PARSER(sourced(construct<AccBeginLoopDirective>(
    Parser<AccLoopDirective>{}, Parser<AccClauseList>{})))

TYPE_PARSER(construct<AccEndLoop>("END LOOP"_tok))

TYPE_PARSER(construct<OpenACCLoopConstruct>(
    Parser<AccBeginLoopDirective>{} / endAccLine,
    maybe(accAssociatedDoConstruct),
    maybe(startAccLine >> Parser<AccEndLoop>{} / endAccLine)))

// 2.15.1 Routine directive
// The name list is optional: empty list = unnamed/implicit form; 1+ names =
// named form.
TYPE_PARSER(sourced(construct<OpenACCRoutineConstruct>(verbatim("ROUTINE"_tok),
    defaulted(localRecovery(
        "empty parentheses in ROUTINE directive; omit parentheses for the unnamed form"_err_en_US,
        !parenthesized(ok) >> parenthesized(nonemptyList(name)),
        parenthesized(ok))),
    Parser<AccClauseList>{})))

// 2.10 Cache directive
TYPE_PARSER(sourced(
    construct<OpenACCCacheConstruct>(sourced(construct<Verbatim>("CACHE"_tok)),
        parenthesized(Parser<AccObjectListWithModifier>{}))))

// 2.11 Combined constructs
TYPE_PARSER(sourced(construct<AccBeginCombinedDirective>(
    Parser<AccCombinedDirective>{}, Parser<AccClauseList>{})))

// 2.12 Atomic constructs
TYPE_PARSER(construct<AccEndAtomic>(startAccLine >> "END ATOMIC"_tok))

TYPE_PARSER("ATOMIC" >> construct<AccAtomicRead>(verbatim("READ"_tok),
                            Parser<AccClauseList>{} / endAccLine,
                            statement(assignmentStmt),
                            maybe(Parser<AccEndAtomic>{} / endAccLine)))

TYPE_PARSER("ATOMIC" >> construct<AccAtomicWrite>(verbatim("WRITE"_tok),
                            Parser<AccClauseList>{} / endAccLine,
                            statement(assignmentStmt),
                            maybe(Parser<AccEndAtomic>{} / endAccLine)))

TYPE_PARSER("ATOMIC" >>
    construct<AccAtomicUpdate>(maybe(verbatim("UPDATE"_tok)),
        Parser<AccClauseList>{} / endAccLine, statement(assignmentStmt),
        maybe(Parser<AccEndAtomic>{} / endAccLine)))

TYPE_PARSER("ATOMIC" >>
    construct<AccAtomicCapture>(verbatim("CAPTURE"_tok),
        Parser<AccClauseList>{} / endAccLine, statement(assignmentStmt),
        statement(assignmentStmt), Parser<AccEndAtomic>{} / endAccLine))

TYPE_PARSER(
    sourced(construct<OpenACCAtomicConstruct>(Parser<AccAtomicRead>{}) ||
        construct<OpenACCAtomicConstruct>(Parser<AccAtomicCapture>{}) ||
        construct<OpenACCAtomicConstruct>(Parser<AccAtomicWrite>{}) ||
        construct<OpenACCAtomicConstruct>(Parser<AccAtomicUpdate>{})))

// 2.13 Declare constructs
TYPE_PARSER(sourced(construct<AccDeclarativeDirective>(
    first("DECLARE" >> pure(llvm::acc::Directive::ACCD_declare)))))

// [Clause, [Clause], ...]
TYPE_PARSER(sourced(construct<AccClauseList>(
    many(maybe(","_tok) >> sourced(Parser<AccClause>{})))))

// 2.16.3 Wait directive
TYPE_PARSER(sourced(construct<OpenACCWaitConstruct>(
    sourced(construct<Verbatim>("WAIT"_tok)),
    maybe(parenthesized(Parser<AccWaitArgument>{})), Parser<AccClauseList>{})))

// Block Constructs
TYPE_PARSER(sourced(construct<AccBeginBlockDirective>(
    sourced(Parser<AccBlockDirective>{}), Parser<AccClauseList>{})))

TYPE_PARSER(startAccLine >> sourced(construct<AccEndBlockDirective>("END"_tok >>
                                recovery(sourced(Parser<AccBlockDirective>{}),
                                    construct<AccBlockDirective>(pure(
                                        llvm::acc::Directive::ACCD_data))))))

TYPE_PARSER(construct<OpenACCBlockConstruct>(
    Parser<AccBeginBlockDirective>{} / endAccLine, block,
    // NB, This allows mismatched directives, but semantics checks that they
    // match.
    recovery(withMessage("expected OpenACC end block directive"_err_en_US,
                 attempt(Parser<AccEndBlockDirective>{} / endAccLine)),
        construct<AccEndBlockDirective>(construct<AccBlockDirective>(
            pure(llvm::acc::Directive::ACCD_data))))))

// Standalone constructs
TYPE_PARSER(sourced(construct<OpenACCStandaloneConstruct>(
    Parser<AccStandaloneDirective>{}, Parser<AccClauseList>{})))

// Standalone declarative constructs
TYPE_PARSER(sourced(construct<OpenACCStandaloneDeclarativeConstruct>(
    Parser<AccDeclarativeDirective>{}, Parser<AccClauseList>{})))

TYPE_PARSER(startAccLine >>
    withMessage("expected OpenACC directive"_err_en_US,
        sourced(first(construct<OpenACCDeclarativeConstruct>(
                          Parser<OpenACCStandaloneDeclarativeConstruct>{}),
            construct<OpenACCDeclarativeConstruct>(
                Parser<OpenACCRoutineConstruct>{})))))

TYPE_PARSER(sourced(construct<OpenACCEndConstruct>(
    "END"_tok >> "LOOP"_tok >> pure(llvm::acc::Directive::ACCD_loop))))

// OpenACC constructs
TYPE_CONTEXT_PARSER("OpenACC construct"_en_US,
    startAccLine >>
        withMessage("expected OpenACC directive"_err_en_US,
            // Combined constructs before block constructs so we try to match
            // the longest possible match first.
            first(
                construct<OpenACCConstruct>(Parser<OpenACCCombinedConstruct>{}),
                construct<OpenACCConstruct>(Parser<OpenACCBlockConstruct>{}),
                construct<OpenACCConstruct>(Parser<OpenACCLoopConstruct>{}),
                construct<OpenACCConstruct>(
                    Parser<OpenACCStandaloneConstruct>{}),
                construct<OpenACCConstruct>(Parser<OpenACCCacheConstruct>{}),
                construct<OpenACCConstruct>(Parser<OpenACCWaitConstruct>{}),
                construct<OpenACCConstruct>(Parser<OpenACCAtomicConstruct>{}),
                construct<OpenACCConstruct>(Parser<OpenACCEndConstruct>{}))))

TYPE_PARSER(startAccLine >>
    sourced(construct<AccEndCombinedDirective>(sourced("END"_tok >>
        construct<AccCombinedDirective>("KERNELS"_tok >> maybe("LOOP"_tok) >>
                pure(llvm::acc::Directive::ACCD_kernels_loop) ||
            "PARALLEL"_tok >> maybe("LOOP"_tok) >>
                pure(llvm::acc::Directive::ACCD_parallel_loop) ||
            "SERIAL"_tok >> maybe("LOOP"_tok) >>
                pure(llvm::acc::Directive::ACCD_serial_loop))))))

TYPE_PARSER(sourced(construct<OpenACCCombinedConstruct>(
    Parser<AccBeginCombinedDirective>{} / endAccLine,
    maybe(accAssociatedDoConstruct),
    maybe(Parser<AccEndCombinedDirective>{} / endAccLine))))

} // namespace Fortran::parser