flang/lib/Parser/expr-parsers.cpp

   1 //===-- lib/Parser/expr-parsers.cpp ---------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 // Per-type parsers for expressions.
  10
  11 #include "expr-parsers.h"
  12 #include "basic-parsers.h"
  13 #include "misc-parsers.h"
  14 #include "stmt-parser.h"
  15 #include "token-parsers.h"
  16 #include "type-parser-implementation.h"
  17 #include "flang/Parser/characters.h"
  18 #include "flang/Parser/parse-tree.h"
  19
  20 namespace Fortran::parser {
  21
  22 // R764 boz-literal-constant -> binary-constant | octal-constant | hex-constant
  23 // R765 binary-constant -> B ' digit [digit]... ' | B " digit [digit]... "
  24 // R766 octal-constant -> O ' digit [digit]... ' | O " digit [digit]... "
  25 // R767 hex-constant ->
  26 //        Z ' hex-digit [hex-digit]... ' | Z " hex-digit [hex-digit]... "
  27 // extension: X accepted for Z
  28 // extension: BOZX suffix accepted
  29 TYPE_PARSER(construct<BOZLiteralConstant>(BOZLiteral{}))
  30
  31 // R769 array-constructor -> (/ ac-spec /) | lbracket ac-spec rbracket
  32 TYPE_CONTEXT_PARSER("array constructor"_en_US,
  33     construct<ArrayConstructor>(
  34         "(/" >> Parser<AcSpec>{} / "/)" || bracketed(Parser<AcSpec>{})))
  35
  36 // R770 ac-spec -> type-spec :: | [type-spec ::] ac-value-list
  37 TYPE_PARSER(construct<AcSpec>(maybe(typeSpec / "::"),
  38                 nonemptyList("expected array constructor values"_err_en_US,
  39                     Parser<AcValue>{})) ||
  40     construct<AcSpec>(typeSpec / "::"))
  41
  42 // R773 ac-value -> expr | ac-implied-do
  43 TYPE_PARSER(
  44     // PGI/Intel extension: accept triplets in array constructors
  45     extension<LanguageFeature::TripletInArrayConstructor>(
  46         "nonstandard usage: triplet in array constructor"_port_en_US,
  47         construct<AcValue>(construct<AcValue::Triplet>(scalarIntExpr,
  48             ":" >> scalarIntExpr, maybe(":" >> scalarIntExpr)))) ||
  49     construct<AcValue>(indirect(expr)) ||
  50     construct<AcValue>(indirect(Parser<AcImpliedDo>{})))
  51
  52 // R774 ac-implied-do -> ( ac-value-list , ac-implied-do-control )
  53 TYPE_PARSER(parenthesized(
  54     construct<AcImpliedDo>(nonemptyList(Parser<AcValue>{} / lookAhead(","_tok)),
  55         "," >> Parser<AcImpliedDoControl>{})))
  56
  57 // R775 ac-implied-do-control ->
  58 //        [integer-type-spec ::] ac-do-variable = scalar-int-expr ,
  59 //        scalar-int-expr [, scalar-int-expr]
  60 // R776 ac-do-variable -> do-variable
  61 TYPE_PARSER(construct<AcImpliedDoControl>(
  62     maybe(integerTypeSpec / "::"), loopBounds(scalarIntExpr)))
  63
  64 // R1001 primary ->
  65 //         literal-constant | designator | array-constructor |
  66 //         structure-constructor | function-reference | type-param-inquiry |
  67 //         type-param-name | ( expr )
  68 // type-param-inquiry is parsed as a structure component, except for
  69 // substring%KIND/LEN
  70 constexpr auto primary{instrumented("primary"_en_US,
  71     first(construct<Expr>(indirect(Parser<CharLiteralConstantSubstring>{})),
  72         construct<Expr>(literalConstant),
  73         construct<Expr>(construct<Expr::Parentheses>(parenthesized(expr))),
  74         construct<Expr>(indirect(functionReference) / !"("_tok / !"%"_tok),
  75         construct<Expr>(designator / !"("_tok / !"%"_tok),
  76         construct<Expr>(indirect(Parser<SubstringInquiry>{})), // %LEN or %KIND
  77         construct<Expr>(Parser<StructureConstructor>{}),
  78         construct<Expr>(Parser<ArrayConstructor>{}),
  79         // PGI/XLF extension: COMPLEX constructor (x,y)
  80         extension<LanguageFeature::ComplexConstructor>(
  81             "nonstandard usage: generalized COMPLEX constructor"_port_en_US,
  82             construct<Expr>(parenthesized(
  83                 construct<Expr::ComplexConstructor>(expr, "," >> expr)))),
  84         extension<LanguageFeature::PercentLOC>(
  85             "nonstandard usage: %LOC"_port_en_US,
  86             construct<Expr>("%LOC" >> parenthesized(construct<Expr::PercentLoc>(
  87                                           indirect(variable)))))))};
  88
  89 // R1002 level-1-expr -> [defined-unary-op] primary
  90 // TODO: Reasonable extension: permit multiple defined-unary-ops
  91 constexpr auto level1Expr{sourced(
  92     first(primary, // must come before define op to resolve .TRUE._8 ambiguity
  93         construct<Expr>(construct<Expr::DefinedUnary>(definedOpName, primary)),
  94         extension<LanguageFeature::SignedPrimary>(
  95             "nonstandard usage: signed primary"_port_en_US,
  96             construct<Expr>(construct<Expr::UnaryPlus>("+" >> primary))),
  97         extension<LanguageFeature::SignedPrimary>(
  98             "nonstandard usage: signed primary"_port_en_US,
  99             construct<Expr>(construct<Expr::Negate>("-" >> primary)))))};
 100
 101 // R1004 mult-operand -> level-1-expr [power-op mult-operand]
 102 // R1007 power-op -> **
 103 // Exponentiation (**) is Fortran's only right-associative binary operation.
 104 struct MultOperand {
 105   using resultType = Expr;
 106   constexpr MultOperand() {}
 107   static inline std::optional<Expr> Parse(ParseState &);
 108 };
 109
 110 static constexpr auto multOperand{sourced(MultOperand{})};
 111
 112 inline std::optional<Expr> MultOperand::Parse(ParseState &state) {
 113   std::optional<Expr> result{level1Expr.Parse(state)};
 114   if (result) {
 115     static constexpr auto op{attempt("**"_tok)};
 116     if (op.Parse(state)) {
 117       std::function<Expr(Expr &&)> power{[&result](Expr &&right) {
 118         return Expr{Expr::Power(std::move(result).value(), std::move(right))};
 119       }};
 120       return applyLambda(power, multOperand).Parse(state); // right-recursive
 121     }
 122   }
 123   return result;
 124 }
 125
 126 // R1005 add-operand -> [add-operand mult-op] mult-operand
 127 // R1008 mult-op -> * | /
 128 // The left recursion in the grammar is implemented iteratively.
 129 struct AddOperand {
 130   using resultType = Expr;
 131   constexpr AddOperand() {}
 132   static inline std::optional<Expr> Parse(ParseState &state) {
 133     std::optional<Expr> result{multOperand.Parse(state)};
 134     if (result) {
 135       auto source{result->source};
 136       std::function<Expr(Expr &&)> multiply{[&result](Expr &&right) {
 137         return Expr{
 138             Expr::Multiply(std::move(result).value(), std::move(right))};
 139       }};
 140       std::function<Expr(Expr &&)> divide{[&result](Expr &&right) {
 141         return Expr{Expr::Divide(std::move(result).value(), std::move(right))};
 142       }};
 143       auto more{attempt(sourced("*" >> applyLambda(multiply, multOperand) ||
 144           "/" >> applyLambda(divide, multOperand)))};
 145       while (std::optional<Expr> next{more.Parse(state)}) {
 146         result = std::move(next);
 147         result->source.ExtendToCover(source);
 148       }
 149     }
 150     return result;
 151   }
 152 };
 153 constexpr AddOperand addOperand;
 154
 155 // R1006 level-2-expr -> [[level-2-expr] add-op] add-operand
 156 // R1009 add-op -> + | -
 157 // These are left-recursive productions, implemented iteratively.
 158 // Note that standard Fortran admits a unary + or - to appear only here,
 159 // by means of a missing first operand; e.g., 2*-3 is valid in C but not
 160 // standard Fortran.  We accept unary + and - to appear before any primary
 161 // as an extension.
 162 struct Level2Expr {
 163   using resultType = Expr;
 164   constexpr Level2Expr() {}
 165   static inline std::optional<Expr> Parse(ParseState &state) {
 166     static constexpr auto unary{
 167         sourced(
 168             construct<Expr>(construct<Expr::UnaryPlus>("+" >> addOperand)) ||
 169             construct<Expr>(construct<Expr::Negate>("-" >> addOperand))) ||
 170         addOperand};
 171     std::optional<Expr> result{unary.Parse(state)};
 172     if (result) {
 173       auto source{result->source};
 174       std::function<Expr(Expr &&)> add{[&result](Expr &&right) {
 175         return Expr{Expr::Add(std::move(result).value(), std::move(right))};
 176       }};
 177       std::function<Expr(Expr &&)> subtract{[&result](Expr &&right) {
 178         return Expr{
 179             Expr::Subtract(std::move(result).value(), std::move(right))};
 180       }};
 181       auto more{attempt(sourced("+" >> applyLambda(add, addOperand) ||
 182           "-" >> applyLambda(subtract, addOperand)))};
 183       while (std::optional<Expr> next{more.Parse(state)}) {
 184         result = std::move(next);
 185         result->source.ExtendToCover(source);
 186       }
 187     }
 188     return result;
 189   }
 190 };
 191 constexpr Level2Expr level2Expr;
 192
 193 // R1010 level-3-expr -> [level-3-expr concat-op] level-2-expr
 194 // R1011 concat-op -> //
 195 // Concatenation (//) is left-associative for parsing performance, although
 196 // one would never notice if it were right-associated.
 197 struct Level3Expr {
 198   using resultType = Expr;
 199   constexpr Level3Expr() {}
 200   static inline std::optional<Expr> Parse(ParseState &state) {
 201     std::optional<Expr> result{level2Expr.Parse(state)};
 202     if (result) {
 203       auto source{result->source};
 204       std::function<Expr(Expr &&)> concat{[&result](Expr &&right) {
 205         return Expr{Expr::Concat(std::move(result).value(), std::move(right))};
 206       }};
 207       auto more{attempt(sourced("//" >> applyLambda(concat, level2Expr)))};
 208       while (std::optional<Expr> next{more.Parse(state)}) {
 209         result = std::move(next);
 210         result->source.ExtendToCover(source);
 211       }
 212     }
 213     return result;
 214   }
 215 };
 216 constexpr Level3Expr level3Expr;
 217
 218 // R1012 level-4-expr -> [level-3-expr rel-op] level-3-expr
 219 // R1013 rel-op ->
 220 //         .EQ. | .NE. | .LT. | .LE. | .GT. | .GE. |
 221 //          == | /= | < | <= | > | >=  @ | <>
 222 // N.B. relations are not recursive (i.e., LOGICAL is not ordered)
 223 struct Level4Expr {
 224   using resultType = Expr;
 225   constexpr Level4Expr() {}
 226   static inline std::optional<Expr> Parse(ParseState &state) {
 227     std::optional<Expr> result{level3Expr.Parse(state)};
 228     if (result) {
 229       auto source{result->source};
 230       std::function<Expr(Expr &&)> lt{[&result](Expr &&right) {
 231         return Expr{Expr::LT(std::move(result).value(), std::move(right))};
 232       }};
 233       std::function<Expr(Expr &&)> le{[&result](Expr &&right) {
 234         return Expr{Expr::LE(std::move(result).value(), std::move(right))};
 235       }};
 236       std::function<Expr(Expr &&)> eq{[&result](Expr &&right) {
 237         return Expr{Expr::EQ(std::move(result).value(), std::move(right))};
 238       }};
 239       std::function<Expr(Expr &&)> ne{[&result](Expr &&right) {
 240         return Expr{Expr::NE(std::move(result).value(), std::move(right))};
 241       }};
 242       std::function<Expr(Expr &&)> ge{[&result](Expr &&right) {
 243         return Expr{Expr::GE(std::move(result).value(), std::move(right))};
 244       }};
 245       std::function<Expr(Expr &&)> gt{[&result](Expr &&right) {
 246         return Expr{Expr::GT(std::move(result).value(), std::move(right))};
 247       }};
 248       auto more{attempt(
 249           sourced((".LT."_tok || "<"_tok) >> applyLambda(lt, level3Expr) ||
 250               (".LE."_tok || "<="_tok) >> applyLambda(le, level3Expr) ||
 251               (".EQ."_tok || "=="_tok) >> applyLambda(eq, level3Expr) ||
 252               (".NE."_tok || "/="_tok ||
 253                   extension<LanguageFeature::AlternativeNE>(
 254                       "nonstandard usage: <> for /= or .NE."_port_en_US,
 255                       "<>"_tok /* PGI/Cray extension; Cray also has .LG. */)) >>
 256                   applyLambda(ne, level3Expr) ||
 257               (".GE."_tok || ">="_tok) >> applyLambda(ge, level3Expr) ||
 258               (".GT."_tok || ">"_tok) >> applyLambda(gt, level3Expr)))};
 259       if (std::optional<Expr> next{more.Parse(state)}) {
 260         next->source.ExtendToCover(source);
 261         return next;
 262       }
 263     }
 264     return result;
 265   }
 266 };
 267 constexpr Level4Expr level4Expr;
 268
 269 // R1014 and-operand -> [not-op] level-4-expr
 270 // R1018 not-op -> .NOT.
 271 // N.B. Fortran's .NOT. binds less tightly than its comparison operators do.
 272 // PGI/Intel extension: accept multiple .NOT. operators
 273 struct AndOperand {
 274   using resultType = Expr;
 275   constexpr AndOperand() {}
 276   static inline std::optional<Expr> Parse(ParseState &);
 277 };
 278 constexpr AndOperand andOperand;
 279
 280 // Match a logical operator or, optionally, its abbreviation.
 281 inline constexpr auto logicalOp(const char *op, const char *abbrev) {
 282   return TokenStringMatch{op} ||
 283       extension<LanguageFeature::LogicalAbbreviations>(
 284           "nonstandard usage: abbreviated LOGICAL operator"_port_en_US,
 285           TokenStringMatch{abbrev});
 286 }
 287
 288 inline std::optional<Expr> AndOperand::Parse(ParseState &state) {
 289   static constexpr auto notOp{attempt(logicalOp(".NOT.", ".N.") >> andOperand)};
 290   if (std::optional<Expr> negation{notOp.Parse(state)}) {
 291     return Expr{Expr::NOT{std::move(*negation)}};
 292   } else {
 293     return level4Expr.Parse(state);
 294   }
 295 }
 296
 297 // R1015 or-operand -> [or-operand and-op] and-operand
 298 // R1019 and-op -> .AND.
 299 // .AND. is left-associative
 300 struct OrOperand {
 301   using resultType = Expr;
 302   constexpr OrOperand() {}
 303   static inline std::optional<Expr> Parse(ParseState &state) {
 304     static constexpr auto operand{sourced(andOperand)};
 305     std::optional<Expr> result{operand.Parse(state)};
 306     if (result) {
 307       auto source{result->source};
 308       std::function<Expr(Expr &&)> logicalAnd{[&result](Expr &&right) {
 309         return Expr{Expr::AND(std::move(result).value(), std::move(right))};
 310       }};
 311       auto more{attempt(sourced(
 312           logicalOp(".AND.", ".A.") >> applyLambda(logicalAnd, andOperand)))};
 313       while (std::optional<Expr> next{more.Parse(state)}) {
 314         result = std::move(next);
 315         result->source.ExtendToCover(source);
 316       }
 317     }
 318     return result;
 319   }
 320 };
 321 constexpr OrOperand orOperand;
 322
 323 // R1016 equiv-operand -> [equiv-operand or-op] or-operand
 324 // R1020 or-op -> .OR.
 325 // .OR. is left-associative
 326 struct EquivOperand {
 327   using resultType = Expr;
 328   constexpr EquivOperand() {}
 329   static inline std::optional<Expr> Parse(ParseState &state) {
 330     std::optional<Expr> result{orOperand.Parse(state)};
 331     if (result) {
 332       auto source{result->source};
 333       std::function<Expr(Expr &&)> logicalOr{[&result](Expr &&right) {
 334         return Expr{Expr::OR(std::move(result).value(), std::move(right))};
 335       }};
 336       auto more{attempt(sourced(
 337           logicalOp(".OR.", ".O.") >> applyLambda(logicalOr, orOperand)))};
 338       while (std::optional<Expr> next{more.Parse(state)}) {
 339         result = std::move(next);
 340         result->source.ExtendToCover(source);
 341       }
 342     }
 343     return result;
 344   }
 345 };
 346 constexpr EquivOperand equivOperand;
 347
 348 // R1017 level-5-expr -> [level-5-expr equiv-op] equiv-operand
 349 // R1021 equiv-op -> .EQV. | .NEQV.
 350 // Logical equivalence is left-associative.
 351 // Extension: .XOR. as synonym for .NEQV.
 352 struct Level5Expr {
 353   using resultType = Expr;
 354   constexpr Level5Expr() {}
 355   static inline std::optional<Expr> Parse(ParseState &state) {
 356     std::optional<Expr> result{equivOperand.Parse(state)};
 357     if (result) {
 358       auto source{result->source};
 359       std::function<Expr(Expr &&)> eqv{[&result](Expr &&right) {
 360         return Expr{Expr::EQV(std::move(result).value(), std::move(right))};
 361       }};
 362       std::function<Expr(Expr &&)> neqv{[&result](Expr &&right) {
 363         return Expr{Expr::NEQV(std::move(result).value(), std::move(right))};
 364       }};
 365       auto more{attempt(sourced(".EQV." >> applyLambda(eqv, equivOperand) ||
 366           (".NEQV."_tok ||
 367               extension<LanguageFeature::XOROperator>(
 368                   "nonstandard usage: .XOR./.X. spelling of .NEQV."_port_en_US,
 369                   logicalOp(".XOR.", ".X."))) >>
 370               applyLambda(neqv, equivOperand)))};
 371       while (std::optional<Expr> next{more.Parse(state)}) {
 372         result = std::move(next);
 373         result->source.ExtendToCover(source);
 374       }
 375     }
 376     return result;
 377   }
 378 };
 379 constexpr Level5Expr level5Expr;
 380
 381 // R1022 expr -> [expr defined-binary-op] level-5-expr
 382 // Defined binary operators associate leftwards.
 383 template <> std::optional<Expr> Parser<Expr>::Parse(ParseState &state) {
 384   std::optional<Expr> result{level5Expr.Parse(state)};
 385   if (result) {
 386     auto source{result->source};
 387     std::function<Expr(DefinedOpName &&, Expr &&)> defBinOp{
 388         [&result](DefinedOpName &&op, Expr &&right) {
 389           return Expr{Expr::DefinedBinary(
 390               std::move(op), std::move(result).value(), std::move(right))};
 391         }};
 392     auto more{attempt(
 393         sourced(applyLambda<Expr>(defBinOp, definedOpName, level5Expr)))};
 394     while (std::optional<Expr> next{more.Parse(state)}) {
 395       result = std::move(next);
 396       result->source.ExtendToCover(source);
 397     }
 398   }
 399   return result;
 400 }
 401
 402 // R1003 defined-unary-op -> . letter [letter]... .
 403 // R1023 defined-binary-op -> . letter [letter]... .
 404 // R1414 local-defined-operator -> defined-unary-op | defined-binary-op
 405 // R1415 use-defined-operator -> defined-unary-op | defined-binary-op
 406 // C1003 A defined operator must be distinct from logical literal constants
 407 // and intrinsic operator names; this is handled by attempting their parses
 408 // first, and by name resolution on their definitions, for best errors.
 409 // N.B. The name of the operator is captured with the dots around it.
 410 constexpr auto definedOpNameChar{letter ||
 411     extension<LanguageFeature::PunctuationInNames>(
 412         "nonstandard usage: non-alphabetic character in defined operator"_port_en_US,
 413         "$@"_ch)};
 414 TYPE_PARSER(
 415     space >> construct<DefinedOpName>(sourced("."_ch >>
 416                  some(definedOpNameChar) >> construct<Name>() / "."_ch)))
 417
 418 // R1028 specification-expr -> scalar-int-expr
 419 TYPE_PARSER(construct<SpecificationExpr>(scalarIntExpr))
 420
 421 // R1032 assignment-stmt -> variable = expr
 422 TYPE_CONTEXT_PARSER("assignment statement"_en_US,
 423     construct<AssignmentStmt>(variable / "=", expr))
 424
 425 // R1033 pointer-assignment-stmt ->
 426 //         data-pointer-object [( bounds-spec-list )] => data-target |
 427 //         data-pointer-object ( bounds-remapping-list ) => data-target |
 428 //         proc-pointer-object => proc-target
 429 // R1034 data-pointer-object ->
 430 //         variable-name | scalar-variable % data-pointer-component-name
 431 //   C1022 a scalar-variable shall be a data-ref
 432 //   C1024 a data-pointer-object shall not be a coindexed object
 433 // R1038 proc-pointer-object -> proc-pointer-name | proc-component-ref
 434 //
 435 // A distinction can't be made at the time of the initial parse between
 436 // data-pointer-object and proc-pointer-object, or between data-target
 437 // and proc-target.
 438 TYPE_CONTEXT_PARSER("pointer assignment statement"_en_US,
 439     construct<PointerAssignmentStmt>(dataRef,
 440         parenthesized(nonemptyList(Parser<BoundsRemapping>{})), "=>" >> expr) ||
 441         construct<PointerAssignmentStmt>(dataRef,
 442             defaulted(parenthesized(nonemptyList(Parser<BoundsSpec>{}))),
 443             "=>" >> expr))
 444
 445 // R1035 bounds-spec -> lower-bound-expr :
 446 TYPE_PARSER(construct<BoundsSpec>(boundExpr / ":"))
 447
 448 // R1036 bounds-remapping -> lower-bound-expr : upper-bound-expr
 449 TYPE_PARSER(construct<BoundsRemapping>(boundExpr / ":", boundExpr))
 450
 451 // R1039 proc-component-ref -> scalar-variable % procedure-component-name
 452 //   C1027 the scalar-variable must be a data-ref without coindices.
 453 TYPE_PARSER(construct<ProcComponentRef>(structureComponent))
 454
 455 // R1041 where-stmt -> WHERE ( mask-expr ) where-assignment-stmt
 456 // R1045 where-assignment-stmt -> assignment-stmt
 457 // R1046 mask-expr -> logical-expr
 458 TYPE_CONTEXT_PARSER("WHERE statement"_en_US,
 459     construct<WhereStmt>("WHERE" >> parenthesized(logicalExpr), assignmentStmt))
 460
 461 // R1042 where-construct ->
 462 //         where-construct-stmt [where-body-construct]...
 463 //         [masked-elsewhere-stmt [where-body-construct]...]...
 464 //         [elsewhere-stmt [where-body-construct]...] end-where-stmt
 465 TYPE_CONTEXT_PARSER("WHERE construct"_en_US,
 466     construct<WhereConstruct>(statement(Parser<WhereConstructStmt>{}),
 467         many(whereBodyConstruct),
 468         many(construct<WhereConstruct::MaskedElsewhere>(
 469             statement(Parser<MaskedElsewhereStmt>{}),
 470             many(whereBodyConstruct))),
 471         maybe(construct<WhereConstruct::Elsewhere>(
 472             statement(Parser<ElsewhereStmt>{}), many(whereBodyConstruct))),
 473         statement(Parser<EndWhereStmt>{})))
 474
 475 // R1043 where-construct-stmt -> [where-construct-name :] WHERE ( mask-expr )
 476 TYPE_CONTEXT_PARSER("WHERE construct statement"_en_US,
 477     construct<WhereConstructStmt>(
 478         maybe(name / ":"), "WHERE" >> parenthesized(logicalExpr)))
 479
 480 // R1044 where-body-construct ->
 481 //         where-assignment-stmt | where-stmt | where-construct
 482 TYPE_PARSER(construct<WhereBodyConstruct>(statement(assignmentStmt)) ||
 483     construct<WhereBodyConstruct>(statement(whereStmt)) ||
 484     construct<WhereBodyConstruct>(indirect(whereConstruct)))
 485
 486 // R1047 masked-elsewhere-stmt ->
 487 //         ELSEWHERE ( mask-expr ) [where-construct-name]
 488 TYPE_CONTEXT_PARSER("masked ELSEWHERE statement"_en_US,
 489     construct<MaskedElsewhereStmt>(
 490         "ELSE WHERE" >> parenthesized(logicalExpr), maybe(name)))
 491
 492 // R1048 elsewhere-stmt -> ELSEWHERE [where-construct-name]
 493 TYPE_CONTEXT_PARSER("ELSEWHERE statement"_en_US,
 494     construct<ElsewhereStmt>("ELSE WHERE" >> maybe(name)))
 495
 496 // R1049 end-where-stmt -> ENDWHERE [where-construct-name]
 497 TYPE_CONTEXT_PARSER("END WHERE statement"_en_US,
 498     construct<EndWhereStmt>(recovery(
 499         "END WHERE" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 500
 501 // R1050 forall-construct ->
 502 //         forall-construct-stmt [forall-body-construct]... end-forall-stmt
 503 TYPE_CONTEXT_PARSER("FORALL construct"_en_US,
 504     construct<ForallConstruct>(statement(Parser<ForallConstructStmt>{}),
 505         many(Parser<ForallBodyConstruct>{}),
 506         statement(Parser<EndForallStmt>{})))
 507
 508 // R1051 forall-construct-stmt ->
 509 //         [forall-construct-name :] FORALL concurrent-header
 510 TYPE_CONTEXT_PARSER("FORALL construct statement"_en_US,
 511     construct<ForallConstructStmt>(
 512         maybe(name / ":"), "FORALL" >> indirect(concurrentHeader)))
 513
 514 // R1052 forall-body-construct ->
 515 //         forall-assignment-stmt | where-stmt | where-construct |
 516 //         forall-construct | forall-stmt
 517 TYPE_PARSER(construct<ForallBodyConstruct>(statement(forallAssignmentStmt)) ||
 518     construct<ForallBodyConstruct>(statement(whereStmt)) ||
 519     construct<ForallBodyConstruct>(whereConstruct) ||
 520     construct<ForallBodyConstruct>(indirect(forallConstruct)) ||
 521     construct<ForallBodyConstruct>(statement(forallStmt)))
 522
 523 // R1053 forall-assignment-stmt -> assignment-stmt | pointer-assignment-stmt
 524 TYPE_PARSER(construct<ForallAssignmentStmt>(assignmentStmt) ||
 525     construct<ForallAssignmentStmt>(pointerAssignmentStmt))
 526
 527 // R1054 end-forall-stmt -> END FORALL [forall-construct-name]
 528 TYPE_CONTEXT_PARSER("END FORALL statement"_en_US,
 529     construct<EndForallStmt>(recovery(
 530         "END FORALL" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 531
 532 // R1055 forall-stmt -> FORALL concurrent-header forall-assignment-stmt
 533 TYPE_CONTEXT_PARSER("FORALL statement"_en_US,
 534     construct<ForallStmt>("FORALL" >> indirect(concurrentHeader),
 535         unlabeledStatement(forallAssignmentStmt)))
 536 } // namespace Fortran::parser