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