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