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