1 | //===-- lib/Parser/executable-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 executable statements |
10 | |
11 | #include "basic-parsers.h" |
12 | #include "expr-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 | // Fortran allows the statement with the corresponding label at the end of |
23 | // a do-construct that begins with an old-style label-do-stmt to be a |
24 | // new-style END DO statement; e.g., DO 10 I=1,N; ...; 10 END DO. Usually, |
25 | // END DO statements appear only at the ends of do-constructs that begin |
26 | // with a nonlabel-do-stmt, so care must be taken to recognize this case and |
27 | // essentially treat them like CONTINUE statements. |
28 | |
29 | // R514 executable-construct -> |
30 | // action-stmt | associate-construct | block-construct | |
31 | // case-construct | change-team-construct | critical-construct | |
32 | // do-construct | if-construct | select-rank-construct | |
33 | // select-type-construct | where-construct | forall-construct | |
34 | // (CUDA) CUF-kernel-do-construct |
35 | constexpr auto executableConstruct{first( |
36 | construct<ExecutableConstruct>(CapturedLabelDoStmt{}), |
37 | construct<ExecutableConstruct>(EndDoStmtForCapturedLabelDoStmt{}), |
38 | construct<ExecutableConstruct>(indirect(Parser<DoConstruct>{})), |
39 | // Attempt DO statements before assignment statements for better |
40 | // error messages in cases like "DO10I=1,(error)". |
41 | construct<ExecutableConstruct>(statement(actionStmt)), |
42 | construct<ExecutableConstruct>(indirect(Parser<AssociateConstruct>{})), |
43 | construct<ExecutableConstruct>(indirect(Parser<BlockConstruct>{})), |
44 | construct<ExecutableConstruct>(indirect(Parser<CaseConstruct>{})), |
45 | construct<ExecutableConstruct>(indirect(Parser<ChangeTeamConstruct>{})), |
46 | construct<ExecutableConstruct>(indirect(Parser<CriticalConstruct>{})), |
47 | construct<ExecutableConstruct>(indirect(Parser<IfConstruct>{})), |
48 | construct<ExecutableConstruct>(indirect(Parser<SelectRankConstruct>{})), |
49 | construct<ExecutableConstruct>(indirect(Parser<SelectTypeConstruct>{})), |
50 | construct<ExecutableConstruct>(indirect(whereConstruct)), |
51 | construct<ExecutableConstruct>(indirect(forallConstruct)), |
52 | construct<ExecutableConstruct>(indirect(ompEndLoopDirective)), |
53 | construct<ExecutableConstruct>(indirect(openmpConstruct)), |
54 | construct<ExecutableConstruct>(indirect(Parser<OpenACCConstruct>{})), |
55 | construct<ExecutableConstruct>(indirect(compilerDirective)), |
56 | construct<ExecutableConstruct>(indirect(Parser<CUFKernelDoConstruct>{})))}; |
57 | |
58 | // R510 execution-part-construct -> |
59 | // executable-construct | format-stmt | entry-stmt | data-stmt |
60 | // Extension (PGI/Intel): also accept NAMELIST in execution part |
61 | constexpr auto obsoleteExecutionPartConstruct{recovery(ignoredStatementPrefix >> |
62 | fail<ExecutionPartConstruct>( |
63 | "obsolete legacy extension is not supported"_err_en_US ), |
64 | construct<ExecutionPartConstruct>(construct<ErrorRecovery>(ok / |
65 | statement("REDIMENSION" >> name / |
66 | parenthesized(nonemptyList(Parser<AllocateShapeSpec>{}))))))}; |
67 | |
68 | TYPE_PARSER(recovery( |
69 | CONTEXT_PARSER("execution part construct"_en_US , |
70 | first(construct<ExecutionPartConstruct>(executableConstruct), |
71 | construct<ExecutionPartConstruct>(statement(indirect(formatStmt))), |
72 | construct<ExecutionPartConstruct>(statement(indirect(entryStmt))), |
73 | construct<ExecutionPartConstruct>(statement(indirect(dataStmt))), |
74 | extension<LanguageFeature::ExecutionPartNamelist>( |
75 | "nonstandard usage: NAMELIST in execution part"_port_en_US , |
76 | construct<ExecutionPartConstruct>( |
77 | statement(indirect(Parser<NamelistStmt>{})))), |
78 | obsoleteExecutionPartConstruct, |
79 | lookAhead(declarationConstruct) >> SkipTo<'\n'>{} >> |
80 | fail<ExecutionPartConstruct>( |
81 | "misplaced declaration in the execution part"_err_en_US ))), |
82 | construct<ExecutionPartConstruct>(executionPartErrorRecovery))) |
83 | |
84 | // R509 execution-part -> executable-construct [execution-part-construct]... |
85 | TYPE_CONTEXT_PARSER("execution part"_en_US , |
86 | construct<ExecutionPart>(many(executionPartConstruct))) |
87 | |
88 | // R515 action-stmt -> |
89 | // allocate-stmt | assignment-stmt | backspace-stmt | call-stmt | |
90 | // close-stmt | continue-stmt | cycle-stmt | deallocate-stmt | |
91 | // endfile-stmt | error-stop-stmt | event-post-stmt | event-wait-stmt | |
92 | // exit-stmt | fail-image-stmt | flush-stmt | form-team-stmt | |
93 | // goto-stmt | if-stmt | inquire-stmt | lock-stmt | notify-wait-stmt | |
94 | // nullify-stmt | open-stmt | pointer-assignment-stmt | print-stmt | |
95 | // read-stmt | return-stmt | rewind-stmt | stop-stmt | sync-all-stmt | |
96 | // sync-images-stmt | sync-memory-stmt | sync-team-stmt | unlock-stmt | |
97 | // wait-stmt | where-stmt | write-stmt | computed-goto-stmt | forall-stmt |
98 | // R1159 continue-stmt -> CONTINUE |
99 | // R1163 fail-image-stmt -> FAIL IMAGE |
100 | TYPE_PARSER(first(construct<ActionStmt>(indirect(Parser<AllocateStmt>{})), |
101 | construct<ActionStmt>(indirect(assignmentStmt)), |
102 | construct<ActionStmt>(indirect(pointerAssignmentStmt)), |
103 | construct<ActionStmt>(indirect(Parser<BackspaceStmt>{})), |
104 | construct<ActionStmt>(indirect(Parser<CallStmt>{})), |
105 | construct<ActionStmt>(indirect(Parser<CloseStmt>{})), |
106 | construct<ActionStmt>(construct<ContinueStmt>("CONTINUE"_tok )), |
107 | construct<ActionStmt>(indirect(Parser<CycleStmt>{})), |
108 | construct<ActionStmt>(indirect(Parser<DeallocateStmt>{})), |
109 | construct<ActionStmt>(indirect(Parser<EndfileStmt>{})), |
110 | construct<ActionStmt>(indirect(Parser<EventPostStmt>{})), |
111 | construct<ActionStmt>(indirect(Parser<EventWaitStmt>{})), |
112 | construct<ActionStmt>(indirect(Parser<ExitStmt>{})), |
113 | construct<ActionStmt>(construct<FailImageStmt>("FAIL IMAGE"_sptok )), |
114 | construct<ActionStmt>(indirect(Parser<FlushStmt>{})), |
115 | construct<ActionStmt>(indirect(Parser<FormTeamStmt>{})), |
116 | construct<ActionStmt>(indirect(Parser<GotoStmt>{})), |
117 | construct<ActionStmt>(indirect(Parser<IfStmt>{})), |
118 | construct<ActionStmt>(indirect(Parser<InquireStmt>{})), |
119 | construct<ActionStmt>(indirect(Parser<LockStmt>{})), |
120 | construct<ActionStmt>(indirect(Parser<NotifyWaitStmt>{})), |
121 | construct<ActionStmt>(indirect(Parser<NullifyStmt>{})), |
122 | construct<ActionStmt>(indirect(Parser<OpenStmt>{})), |
123 | construct<ActionStmt>(indirect(Parser<PrintStmt>{})), |
124 | construct<ActionStmt>(indirect(Parser<ReadStmt>{})), |
125 | construct<ActionStmt>(indirect(Parser<ReturnStmt>{})), |
126 | construct<ActionStmt>(indirect(Parser<RewindStmt>{})), |
127 | construct<ActionStmt>(indirect(Parser<StopStmt>{})), // & error-stop-stmt |
128 | construct<ActionStmt>(indirect(Parser<SyncAllStmt>{})), |
129 | construct<ActionStmt>(indirect(Parser<SyncImagesStmt>{})), |
130 | construct<ActionStmt>(indirect(Parser<SyncMemoryStmt>{})), |
131 | construct<ActionStmt>(indirect(Parser<SyncTeamStmt>{})), |
132 | construct<ActionStmt>(indirect(Parser<UnlockStmt>{})), |
133 | construct<ActionStmt>(indirect(Parser<WaitStmt>{})), |
134 | construct<ActionStmt>(indirect(whereStmt)), |
135 | construct<ActionStmt>(indirect(Parser<WriteStmt>{})), |
136 | construct<ActionStmt>(indirect(Parser<ComputedGotoStmt>{})), |
137 | construct<ActionStmt>(indirect(forallStmt)), |
138 | construct<ActionStmt>(indirect(Parser<ArithmeticIfStmt>{})), |
139 | construct<ActionStmt>(indirect(Parser<AssignStmt>{})), |
140 | construct<ActionStmt>(indirect(Parser<AssignedGotoStmt>{})), |
141 | construct<ActionStmt>(indirect(Parser<PauseStmt>{})))) |
142 | |
143 | // R1102 associate-construct -> associate-stmt block end-associate-stmt |
144 | TYPE_CONTEXT_PARSER("ASSOCIATE construct"_en_US , |
145 | construct<AssociateConstruct>(statement(Parser<AssociateStmt>{}), block, |
146 | statement(Parser<EndAssociateStmt>{}))) |
147 | |
148 | // R1103 associate-stmt -> |
149 | // [associate-construct-name :] ASSOCIATE ( association-list ) |
150 | TYPE_CONTEXT_PARSER("ASSOCIATE statement"_en_US , |
151 | construct<AssociateStmt>(maybe(name / ":" ), |
152 | "ASSOCIATE" >> parenthesized(nonemptyList(Parser<Association>{})))) |
153 | |
154 | // R1104 association -> associate-name => selector |
155 | TYPE_PARSER(construct<Association>(name, "=>" >> selector)) |
156 | |
157 | // R1105 selector -> expr | variable |
158 | TYPE_PARSER(construct<Selector>(variable) / lookAhead(","_tok || ")"_tok ) || |
159 | construct<Selector>(expr)) |
160 | |
161 | // R1106 end-associate-stmt -> END ASSOCIATE [associate-construct-name] |
162 | TYPE_PARSER(construct<EndAssociateStmt>(recovery( |
163 | "END ASSOCIATE" >> maybe(name), namedConstructEndStmtErrorRecovery))) |
164 | |
165 | // R1107 block-construct -> |
166 | // block-stmt [block-specification-part] block end-block-stmt |
167 | TYPE_CONTEXT_PARSER("BLOCK construct"_en_US , |
168 | construct<BlockConstruct>(statement(Parser<BlockStmt>{}), |
169 | Parser<BlockSpecificationPart>{}, // can be empty |
170 | block, statement(Parser<EndBlockStmt>{}))) |
171 | |
172 | // R1108 block-stmt -> [block-construct-name :] BLOCK |
173 | TYPE_PARSER(construct<BlockStmt>(maybe(name / ":" ) / "BLOCK" )) |
174 | |
175 | // R1109 block-specification-part -> |
176 | // [use-stmt]... [import-stmt]... [implicit-part] |
177 | // [[declaration-construct]... specification-construct] |
178 | // C1107 prohibits COMMON, EQUIVALENCE, INTENT, NAMELIST, OPTIONAL, VALUE, |
179 | // and statement function definitions. C1108 prohibits SAVE /common/. |
180 | // C1570 indirectly prohibits ENTRY. These constraints are best enforced later. |
181 | // The odd grammar rule above would have the effect of forcing any |
182 | // trailing FORMAT and DATA statements after the last specification-construct |
183 | // to be recognized as part of the block-construct's block part rather than |
184 | // its block-specification-part, a distinction without any apparent difference. |
185 | TYPE_PARSER(construct<BlockSpecificationPart>(specificationPart)) |
186 | |
187 | // R1110 end-block-stmt -> END BLOCK [block-construct-name] |
188 | TYPE_PARSER(construct<EndBlockStmt>( |
189 | recovery("END BLOCK" >> maybe(name), namedConstructEndStmtErrorRecovery))) |
190 | |
191 | // R1111 change-team-construct -> change-team-stmt block end-change-team-stmt |
192 | TYPE_CONTEXT_PARSER("CHANGE TEAM construct"_en_US , |
193 | construct<ChangeTeamConstruct>(statement(Parser<ChangeTeamStmt>{}), block, |
194 | statement(Parser<EndChangeTeamStmt>{}))) |
195 | |
196 | // R1112 change-team-stmt -> |
197 | // [team-construct-name :] CHANGE TEAM |
198 | // ( team-value [, coarray-association-list] [, sync-stat-list] ) |
199 | TYPE_CONTEXT_PARSER("CHANGE TEAM statement"_en_US , |
200 | construct<ChangeTeamStmt>(maybe(name / ":" ), |
201 | "CHANGE TEAM"_sptok >> "("_tok >> teamValue, |
202 | defaulted("," >> nonemptyList(Parser<CoarrayAssociation>{})), |
203 | defaulted("," >> nonemptyList(statOrErrmsg))) / |
204 | ")" ) |
205 | |
206 | // R1113 coarray-association -> codimension-decl => selector |
207 | TYPE_PARSER( |
208 | construct<CoarrayAssociation>(Parser<CodimensionDecl>{}, "=>" >> selector)) |
209 | |
210 | // R1114 end-change-team-stmt -> |
211 | // END TEAM [( [sync-stat-list] )] [team-construct-name] |
212 | TYPE_CONTEXT_PARSER("END TEAM statement"_en_US , |
213 | construct<EndChangeTeamStmt>( |
214 | "END TEAM" >> defaulted(parenthesized(optionalList(statOrErrmsg))), |
215 | maybe(name))) |
216 | |
217 | // R1117 critical-stmt -> |
218 | // [critical-construct-name :] CRITICAL [( [sync-stat-list] )] |
219 | TYPE_CONTEXT_PARSER("CRITICAL statement"_en_US , |
220 | construct<CriticalStmt>(maybe(name / ":" ), |
221 | "CRITICAL" >> defaulted(parenthesized(optionalList(statOrErrmsg))))) |
222 | |
223 | // R1116 critical-construct -> critical-stmt block end-critical-stmt |
224 | TYPE_CONTEXT_PARSER("CRITICAL construct"_en_US , |
225 | construct<CriticalConstruct>(statement(Parser<CriticalStmt>{}), block, |
226 | statement(Parser<EndCriticalStmt>{}))) |
227 | |
228 | // R1118 end-critical-stmt -> END CRITICAL [critical-construct-name] |
229 | TYPE_PARSER(construct<EndCriticalStmt>(recovery( |
230 | "END CRITICAL" >> maybe(name), namedConstructEndStmtErrorRecovery))) |
231 | |
232 | // R1119 do-construct -> do-stmt block end-do |
233 | // R1120 do-stmt -> nonlabel-do-stmt | label-do-stmt |
234 | TYPE_CONTEXT_PARSER("DO construct"_en_US , |
235 | construct<DoConstruct>( |
236 | statement(Parser<NonLabelDoStmt>{}) / EnterNonlabelDoConstruct{}, block, |
237 | statement(Parser<EndDoStmt>{}) / LeaveDoConstruct{})) |
238 | |
239 | // R1125 concurrent-header -> |
240 | // ( [integer-type-spec ::] concurrent-control-list |
241 | // [, scalar-mask-expr] ) |
242 | TYPE_PARSER(parenthesized(construct<ConcurrentHeader>( |
243 | maybe(integerTypeSpec / "::" ), nonemptyList(Parser<ConcurrentControl>{}), |
244 | maybe("," >> scalarLogicalExpr)))) |
245 | |
246 | // R1126 concurrent-control -> |
247 | // index-name = concurrent-limit : concurrent-limit [: concurrent-step] |
248 | // R1127 concurrent-limit -> scalar-int-expr |
249 | // R1128 concurrent-step -> scalar-int-expr |
250 | TYPE_PARSER(construct<ConcurrentControl>(name / "=" , scalarIntExpr / ":" , |
251 | scalarIntExpr, maybe(":" >> scalarIntExpr))) |
252 | |
253 | // R1130 locality-spec -> |
254 | // LOCAL ( variable-name-list ) | LOCAL_INIT ( variable-name-list ) | |
255 | // REDUCE ( reduce-operation : variable-name-list ) | |
256 | // SHARED ( variable-name-list ) | DEFAULT ( NONE ) |
257 | TYPE_PARSER(construct<LocalitySpec>(construct<LocalitySpec::Local>( |
258 | "LOCAL" >> parenthesized(listOfNames))) || |
259 | construct<LocalitySpec>(construct<LocalitySpec::LocalInit>( |
260 | "LOCAL_INIT"_sptok >> parenthesized(listOfNames))) || |
261 | construct<LocalitySpec>(construct<LocalitySpec::Reduce>( |
262 | "REDUCE (" >> Parser<LocalitySpec::Reduce::Operator>{} / ":" , |
263 | listOfNames / ")" )) || |
264 | construct<LocalitySpec>(construct<LocalitySpec::Shared>( |
265 | "SHARED" >> parenthesized(listOfNames))) || |
266 | construct<LocalitySpec>( |
267 | construct<LocalitySpec::DefaultNone>("DEFAULT ( NONE )"_tok ))) |
268 | |
269 | // R1123 loop-control -> |
270 | // [,] do-variable = scalar-int-expr , scalar-int-expr |
271 | // [, scalar-int-expr] | |
272 | // [,] WHILE ( scalar-logical-expr ) | |
273 | // [,] CONCURRENT concurrent-header concurrent-locality |
274 | // R1129 concurrent-locality -> [locality-spec]... |
275 | TYPE_CONTEXT_PARSER("loop control"_en_US , |
276 | maybe(","_tok ) >> |
277 | (construct<LoopControl>(loopBounds(scalarExpr)) || |
278 | construct<LoopControl>( |
279 | "WHILE" >> parenthesized(scalarLogicalExpr)) || |
280 | construct<LoopControl>(construct<LoopControl::Concurrent>( |
281 | "CONCURRENT" >> concurrentHeader, |
282 | many(Parser<LocalitySpec>{}))))) |
283 | |
284 | // "DO" is a valid statement, so the loop control is optional; but for |
285 | // better recovery from errors in the loop control, don't parse a |
286 | // DO statement with a bad loop control as a DO statement that has |
287 | // no loop control and is followed by garbage. |
288 | static constexpr auto loopControlOrEndOfStmt{ |
289 | construct<std::optional<LoopControl>>(Parser<LoopControl>{}) || |
290 | lookAhead(";\n"_ch ) >> construct<std::optional<LoopControl>>()}; |
291 | |
292 | // R1121 label-do-stmt -> [do-construct-name :] DO label [loop-control] |
293 | // A label-do-stmt with a do-construct-name is parsed as a nonlabel-do-stmt |
294 | // with an optional label. |
295 | TYPE_CONTEXT_PARSER("label DO statement"_en_US , |
296 | construct<LabelDoStmt>("DO" >> label, loopControlOrEndOfStmt)) |
297 | |
298 | // R1122 nonlabel-do-stmt -> [do-construct-name :] DO [loop-control] |
299 | TYPE_CONTEXT_PARSER("nonlabel DO statement"_en_US , |
300 | construct<NonLabelDoStmt>( |
301 | name / ":" , "DO" >> maybe(label), loopControlOrEndOfStmt) || |
302 | construct<NonLabelDoStmt>(construct<std::optional<Name>>(), |
303 | construct<std::optional<Label>>(), "DO" >> loopControlOrEndOfStmt)) |
304 | |
305 | // R1132 end-do-stmt -> END DO [do-construct-name] |
306 | TYPE_CONTEXT_PARSER("END DO statement"_en_US , |
307 | construct<EndDoStmt>( |
308 | recovery("END DO" >> maybe(name), namedConstructEndStmtErrorRecovery))) |
309 | |
310 | // R1133 cycle-stmt -> CYCLE [do-construct-name] |
311 | TYPE_CONTEXT_PARSER( |
312 | "CYCLE statement"_en_US , construct<CycleStmt>("CYCLE" >> maybe(name))) |
313 | |
314 | // R1134 if-construct -> |
315 | // if-then-stmt block [else-if-stmt block]... |
316 | // [else-stmt block] end-if-stmt |
317 | // R1135 if-then-stmt -> [if-construct-name :] IF ( scalar-logical-expr ) |
318 | // THEN R1136 else-if-stmt -> |
319 | // ELSE IF ( scalar-logical-expr ) THEN [if-construct-name] |
320 | // R1137 else-stmt -> ELSE [if-construct-name] |
321 | // R1138 end-if-stmt -> END IF [if-construct-name] |
322 | TYPE_CONTEXT_PARSER("IF construct"_en_US , |
323 | construct<IfConstruct>( |
324 | statement(construct<IfThenStmt>(maybe(name / ":" ), |
325 | "IF" >> parenthesized(scalarLogicalExpr) / |
326 | recovery("THEN"_tok , lookAhead(endOfStmt)))), |
327 | block, |
328 | many(construct<IfConstruct::ElseIfBlock>( |
329 | unambiguousStatement(construct<ElseIfStmt>( |
330 | "ELSE IF" >> parenthesized(scalarLogicalExpr), |
331 | recovery("THEN"_tok , ok) >> maybe(name))), |
332 | block)), |
333 | maybe(construct<IfConstruct::ElseBlock>( |
334 | statement(construct<ElseStmt>("ELSE" >> maybe(name))), block)), |
335 | statement(construct<EndIfStmt>(recovery( |
336 | "END IF" >> maybe(name), namedConstructEndStmtErrorRecovery))))) |
337 | |
338 | // R1139 if-stmt -> IF ( scalar-logical-expr ) action-stmt |
339 | TYPE_CONTEXT_PARSER("IF statement"_en_US , |
340 | construct<IfStmt>("IF" >> parenthesized(scalarLogicalExpr), |
341 | unlabeledStatement(actionStmt))) |
342 | |
343 | // R1140 case-construct -> |
344 | // select-case-stmt [case-stmt block]... end-select-stmt |
345 | TYPE_CONTEXT_PARSER("SELECT CASE construct"_en_US , |
346 | construct<CaseConstruct>(statement(Parser<SelectCaseStmt>{}), |
347 | many(construct<CaseConstruct::Case>( |
348 | unambiguousStatement(Parser<CaseStmt>{}), block)), |
349 | statement(endSelectStmt))) |
350 | |
351 | // R1141 select-case-stmt -> [case-construct-name :] SELECT CASE ( case-expr |
352 | // ) R1144 case-expr -> scalar-expr |
353 | TYPE_CONTEXT_PARSER("SELECT CASE statement"_en_US , |
354 | construct<SelectCaseStmt>( |
355 | maybe(name / ":" ), "SELECT CASE" >> parenthesized(scalar(expr)))) |
356 | |
357 | // R1142 case-stmt -> CASE case-selector [case-construct-name] |
358 | TYPE_CONTEXT_PARSER("CASE statement"_en_US , |
359 | construct<CaseStmt>("CASE" >> Parser<CaseSelector>{}, maybe(name))) |
360 | |
361 | // R1143 end-select-stmt -> END SELECT [case-construct-name] |
362 | // R1151 end-select-rank-stmt -> END SELECT [select-construct-name] |
363 | // R1155 end-select-type-stmt -> END SELECT [select-construct-name] |
364 | TYPE_PARSER(construct<EndSelectStmt>( |
365 | recovery("END SELECT" >> maybe(name), namedConstructEndStmtErrorRecovery))) |
366 | |
367 | // R1145 case-selector -> ( case-value-range-list ) | DEFAULT |
368 | constexpr auto defaultKeyword{construct<Default>("DEFAULT"_tok )}; |
369 | TYPE_PARSER(parenthesized(construct<CaseSelector>( |
370 | nonemptyList(Parser<CaseValueRange>{}))) || |
371 | construct<CaseSelector>(defaultKeyword)) |
372 | |
373 | // R1147 case-value -> scalar-constant-expr |
374 | constexpr auto caseValue{scalar(constantExpr)}; |
375 | |
376 | // R1146 case-value-range -> |
377 | // case-value | case-value : | : case-value | case-value : case-value |
378 | TYPE_PARSER(construct<CaseValueRange>(construct<CaseValueRange::Range>( |
379 | construct<std::optional<CaseValue>>(caseValue), |
380 | ":" >> maybe(caseValue))) || |
381 | construct<CaseValueRange>( |
382 | construct<CaseValueRange::Range>(construct<std::optional<CaseValue>>(), |
383 | ":" >> construct<std::optional<CaseValue>>(caseValue))) || |
384 | construct<CaseValueRange>(caseValue)) |
385 | |
386 | // R1148 select-rank-construct -> |
387 | // select-rank-stmt [select-rank-case-stmt block]... |
388 | // end-select-rank-stmt |
389 | TYPE_CONTEXT_PARSER("SELECT RANK construct"_en_US , |
390 | construct<SelectRankConstruct>(statement(Parser<SelectRankStmt>{}), |
391 | many(construct<SelectRankConstruct::RankCase>( |
392 | unambiguousStatement(Parser<SelectRankCaseStmt>{}), block)), |
393 | statement(endSelectStmt))) |
394 | |
395 | // R1149 select-rank-stmt -> |
396 | // [select-construct-name :] SELECT RANK |
397 | // ( [associate-name =>] selector ) |
398 | TYPE_CONTEXT_PARSER("SELECT RANK statement"_en_US , |
399 | construct<SelectRankStmt>(maybe(name / ":" ), |
400 | "SELECT RANK"_sptok >> "("_tok >> maybe(name / "=>" ), selector / ")" )) |
401 | |
402 | // R1150 select-rank-case-stmt -> |
403 | // RANK ( scalar-int-constant-expr ) [select-construct-name] | |
404 | // RANK ( * ) [select-construct-name] | |
405 | // RANK DEFAULT [select-construct-name] |
406 | TYPE_CONTEXT_PARSER("RANK case statement"_en_US , |
407 | "RANK" >> (construct<SelectRankCaseStmt>( |
408 | parenthesized(construct<SelectRankCaseStmt::Rank>( |
409 | scalarIntConstantExpr) || |
410 | construct<SelectRankCaseStmt::Rank>(star)) || |
411 | construct<SelectRankCaseStmt::Rank>(defaultKeyword), |
412 | maybe(name)))) |
413 | |
414 | // R1152 select-type-construct -> |
415 | // select-type-stmt [type-guard-stmt block]... end-select-type-stmt |
416 | TYPE_CONTEXT_PARSER("SELECT TYPE construct"_en_US , |
417 | construct<SelectTypeConstruct>(statement(Parser<SelectTypeStmt>{}), |
418 | many(construct<SelectTypeConstruct::TypeCase>( |
419 | unambiguousStatement(Parser<TypeGuardStmt>{}), block)), |
420 | statement(endSelectStmt))) |
421 | |
422 | // R1153 select-type-stmt -> |
423 | // [select-construct-name :] SELECT TYPE |
424 | // ( [associate-name =>] selector ) |
425 | TYPE_CONTEXT_PARSER("SELECT TYPE statement"_en_US , |
426 | construct<SelectTypeStmt>(maybe(name / ":" ), |
427 | "SELECT TYPE (" >> maybe(name / "=>" ), selector / ")" )) |
428 | |
429 | // R1154 type-guard-stmt -> |
430 | // TYPE IS ( type-spec ) [select-construct-name] | |
431 | // CLASS IS ( derived-type-spec ) [select-construct-name] | |
432 | // CLASS DEFAULT [select-construct-name] |
433 | TYPE_CONTEXT_PARSER("type guard statement"_en_US , |
434 | construct<TypeGuardStmt>("TYPE IS"_sptok >> |
435 | parenthesized(construct<TypeGuardStmt::Guard>(typeSpec)) || |
436 | "CLASS IS"_sptok >> parenthesized(construct<TypeGuardStmt::Guard>( |
437 | derivedTypeSpec)) || |
438 | construct<TypeGuardStmt::Guard>("CLASS" >> defaultKeyword), |
439 | maybe(name))) |
440 | |
441 | // R1156 exit-stmt -> EXIT [construct-name] |
442 | TYPE_CONTEXT_PARSER( |
443 | "EXIT statement"_en_US , construct<ExitStmt>("EXIT" >> maybe(name))) |
444 | |
445 | // R1157 goto-stmt -> GO TO label |
446 | TYPE_CONTEXT_PARSER( |
447 | "GOTO statement"_en_US , construct<GotoStmt>("GO TO" >> label)) |
448 | |
449 | // R1158 computed-goto-stmt -> GO TO ( label-list ) [,] scalar-int-expr |
450 | TYPE_CONTEXT_PARSER("computed GOTO statement"_en_US , |
451 | construct<ComputedGotoStmt>("GO TO" >> parenthesized(nonemptyList(label)), |
452 | maybe(","_tok ) >> scalarIntExpr)) |
453 | |
454 | // R1160 stop-stmt -> STOP [stop-code] [, QUIET = scalar-logical-expr] |
455 | // R1161 error-stop-stmt -> |
456 | // ERROR STOP [stop-code] [, QUIET = scalar-logical-expr] |
457 | TYPE_CONTEXT_PARSER("STOP statement"_en_US , |
458 | construct<StopStmt>("STOP" >> pure(StopStmt::Kind::Stop) || |
459 | "ERROR STOP"_sptok >> pure(StopStmt::Kind::ErrorStop), |
460 | maybe(Parser<StopCode>{}), maybe(", QUIET =" >> scalarLogicalExpr))) |
461 | |
462 | // R1162 stop-code -> scalar-default-char-expr | scalar-int-expr |
463 | // The two alternatives for stop-code can't be distinguished at |
464 | // parse time. |
465 | TYPE_PARSER(construct<StopCode>(scalar(expr))) |
466 | |
467 | // F2030: R1166 notify-wait-stmt -> |
468 | // NOTIFY WAIT ( notify-variable [, event-wait-spec-list] ) |
469 | TYPE_CONTEXT_PARSER("NOTIFY WAIT statement"_en_US , |
470 | construct<NotifyWaitStmt>( |
471 | "NOTIFY WAIT"_sptok >> "("_tok >> scalar(variable), |
472 | defaulted("," >> nonemptyList(Parser<EventWaitSpec>{})) / ")" )) |
473 | |
474 | // R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )] |
475 | TYPE_CONTEXT_PARSER("SYNC ALL statement"_en_US , |
476 | construct<SyncAllStmt>("SYNC ALL"_sptok >> |
477 | defaulted(parenthesized(optionalList(statOrErrmsg))))) |
478 | |
479 | // R1166 sync-images-stmt -> SYNC IMAGES ( image-set [, sync-stat-list] ) |
480 | // R1167 image-set -> int-expr | * |
481 | TYPE_CONTEXT_PARSER("SYNC IMAGES statement"_en_US , |
482 | "SYNC IMAGES"_sptok >> parenthesized(construct<SyncImagesStmt>( |
483 | construct<SyncImagesStmt::ImageSet>(intExpr) || |
484 | construct<SyncImagesStmt::ImageSet>(star), |
485 | defaulted("," >> nonemptyList(statOrErrmsg))))) |
486 | |
487 | // R1168 sync-memory-stmt -> SYNC MEMORY [( [sync-stat-list] )] |
488 | TYPE_CONTEXT_PARSER("SYNC MEMORY statement"_en_US , |
489 | construct<SyncMemoryStmt>("SYNC MEMORY"_sptok >> |
490 | defaulted(parenthesized(optionalList(statOrErrmsg))))) |
491 | |
492 | // R1169 sync-team-stmt -> SYNC TEAM ( team-value [, sync-stat-list] ) |
493 | TYPE_CONTEXT_PARSER("SYNC TEAM statement"_en_US , |
494 | construct<SyncTeamStmt>("SYNC TEAM"_sptok >> "("_tok >> teamValue, |
495 | defaulted("," >> nonemptyList(statOrErrmsg)) / ")" )) |
496 | |
497 | // R1170 event-post-stmt -> EVENT POST ( event-variable [, sync-stat-list] ) |
498 | // R1171 event-variable -> scalar-variable |
499 | TYPE_CONTEXT_PARSER("EVENT POST statement"_en_US , |
500 | construct<EventPostStmt>("EVENT POST"_sptok >> "("_tok >> scalar(variable), |
501 | defaulted("," >> nonemptyList(statOrErrmsg)) / ")" )) |
502 | |
503 | // R1172 event-wait-stmt -> |
504 | // EVENT WAIT ( event-variable [, event-wait-spec-list] ) |
505 | TYPE_CONTEXT_PARSER("EVENT WAIT statement"_en_US , |
506 | construct<EventWaitStmt>("EVENT WAIT"_sptok >> "("_tok >> scalar(variable), |
507 | defaulted("," >> nonemptyList(Parser<EventWaitSpec>{})) / ")" )) |
508 | |
509 | // R1174 until-spec -> UNTIL_COUNT = scalar-int-expr |
510 | constexpr auto untilSpec{"UNTIL_COUNT =" >> scalarIntExpr}; |
511 | |
512 | // R1173 event-wait-spec -> until-spec | sync-stat |
513 | TYPE_PARSER(construct<EventWaitSpec>(untilSpec) || |
514 | construct<EventWaitSpec>(statOrErrmsg)) |
515 | |
516 | // R1177 team-variable -> scalar-variable |
517 | constexpr auto teamVariable{scalar(variable)}; |
518 | |
519 | // R1175 form-team-stmt -> |
520 | // FORM TEAM ( team-number , team-variable [, form-team-spec-list] ) |
521 | // R1176 team-number -> scalar-int-expr |
522 | TYPE_CONTEXT_PARSER("FORM TEAM statement"_en_US , |
523 | construct<FormTeamStmt>("FORM TEAM"_sptok >> "("_tok >> scalarIntExpr, |
524 | "," >> teamVariable, |
525 | defaulted("," >> nonemptyList(Parser<FormTeamStmt::FormTeamSpec>{})) / |
526 | ")" )) |
527 | |
528 | // R1178 form-team-spec -> NEW_INDEX = scalar-int-expr | sync-stat |
529 | TYPE_PARSER( |
530 | construct<FormTeamStmt::FormTeamSpec>("NEW_INDEX =" >> scalarIntExpr) || |
531 | construct<FormTeamStmt::FormTeamSpec>(statOrErrmsg)) |
532 | |
533 | // R1182 lock-variable -> scalar-variable |
534 | constexpr auto lockVariable{scalar(variable)}; |
535 | |
536 | // R1179 lock-stmt -> LOCK ( lock-variable [, lock-stat-list] ) |
537 | TYPE_CONTEXT_PARSER("LOCK statement"_en_US , |
538 | construct<LockStmt>("LOCK (" >> lockVariable, |
539 | defaulted("," >> nonemptyList(Parser<LockStmt::LockStat>{})) / ")" )) |
540 | |
541 | // R1180 lock-stat -> ACQUIRED_LOCK = scalar-logical-variable | sync-stat |
542 | TYPE_PARSER( |
543 | construct<LockStmt::LockStat>("ACQUIRED_LOCK =" >> scalarLogicalVariable) || |
544 | construct<LockStmt::LockStat>(statOrErrmsg)) |
545 | |
546 | // R1181 unlock-stmt -> UNLOCK ( lock-variable [, sync-stat-list] ) |
547 | TYPE_CONTEXT_PARSER("UNLOCK statement"_en_US , |
548 | construct<UnlockStmt>("UNLOCK (" >> lockVariable, |
549 | defaulted("," >> nonemptyList(statOrErrmsg)) / ")" )) |
550 | |
551 | // CUF-kernel-do-construct -> |
552 | // !$CUF KERNEL DO [ (scalar-int-constant-expr) ] |
553 | // <<< grid, block [, stream] >>> |
554 | // [ cuf-reduction... ] |
555 | // do-construct |
556 | // star-or-expr -> * | scalar-int-expr |
557 | // grid -> * | scalar-int-expr | ( star-or-expr-list ) |
558 | // block -> * | scalar-int-expr | ( star-or-expr-list ) |
559 | // stream -> 0, scalar-int-expr | STREAM = scalar-int-expr |
560 | // cuf-reduction -> [ REDUCTION | REDUCE ] ( |
561 | // acc-reduction-op : scalar-variable-list ) |
562 | |
563 | constexpr auto starOrExpr{construct<CUFKernelDoConstruct::StarOrExpr>( |
564 | "*" >> pure<std::optional<ScalarIntExpr>>() || |
565 | applyFunction(presentOptional<ScalarIntExpr>, scalarIntExpr))}; |
566 | constexpr auto gridOrBlock{parenthesized(nonemptyList(starOrExpr)) || |
567 | applyFunction(singletonList<CUFKernelDoConstruct::StarOrExpr>, starOrExpr)}; |
568 | |
569 | TYPE_PARSER(("REDUCTION"_tok || "REDUCE"_tok ) >> |
570 | parenthesized(construct<CUFReduction>(Parser<CUFReduction::Operator>{}, |
571 | ":" >> nonemptyList(scalar(variable))))) |
572 | |
573 | TYPE_PARSER("<<<" >> |
574 | construct<CUFKernelDoConstruct::LaunchConfiguration>(gridOrBlock, |
575 | "," >> gridOrBlock, |
576 | maybe((", 0 ,"_tok || ", STREAM ="_tok ) >> scalarIntExpr) / ">>>" )) |
577 | |
578 | TYPE_PARSER(sourced(beginDirective >> "$CUF KERNEL DO"_tok >> |
579 | construct<CUFKernelDoConstruct::Directive>( |
580 | maybe(parenthesized(scalarIntConstantExpr)), |
581 | maybe(Parser<CUFKernelDoConstruct::LaunchConfiguration>{}), |
582 | many(Parser<CUFReduction>{}) / endDirective))) |
583 | TYPE_CONTEXT_PARSER("!$CUF KERNEL DO construct"_en_US , |
584 | extension<LanguageFeature::CUDA>(construct<CUFKernelDoConstruct>( |
585 | Parser<CUFKernelDoConstruct::Directive>{}, |
586 | maybe(Parser<DoConstruct>{})))) |
587 | |
588 | } // namespace Fortran::parser |
589 | |