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