forked from OSchip/llvm-project
528 lines
25 KiB
C++
528 lines
25 KiB
C++
//===-- lib/Parser/executable-parsers.cpp ---------------------------------===//
|
|
//
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
// Per-type parsers for executable statements
|
|
|
|
#include "basic-parsers.h"
|
|
#include "debug-parser.h"
|
|
#include "expr-parsers.h"
|
|
#include "misc-parsers.h"
|
|
#include "stmt-parser.h"
|
|
#include "token-parsers.h"
|
|
#include "type-parser-implementation.h"
|
|
#include "flang/Parser/characters.h"
|
|
#include "flang/Parser/parse-tree.h"
|
|
|
|
namespace Fortran::parser {
|
|
|
|
// Fortran allows the statement with the corresponding label at the end of
|
|
// a do-construct that begins with an old-style label-do-stmt to be a
|
|
// new-style END DO statement; e.g., DO 10 I=1,N; ...; 10 END DO. Usually,
|
|
// END DO statements appear only at the ends of do-constructs that begin
|
|
// with a nonlabel-do-stmt, so care must be taken to recognize this case and
|
|
// essentially treat them like CONTINUE statements.
|
|
|
|
// R514 executable-construct ->
|
|
// action-stmt | associate-construct | block-construct |
|
|
// case-construct | change-team-construct | critical-construct |
|
|
// do-construct | if-construct | select-rank-construct |
|
|
// select-type-construct | where-construct | forall-construct
|
|
constexpr auto executableConstruct{
|
|
first(construct<ExecutableConstruct>(CapturedLabelDoStmt{}),
|
|
construct<ExecutableConstruct>(EndDoStmtForCapturedLabelDoStmt{}),
|
|
construct<ExecutableConstruct>(indirect(Parser<DoConstruct>{})),
|
|
// Attempt DO statements before assignment statements for better
|
|
// error messages in cases like "DO10I=1,(error)".
|
|
construct<ExecutableConstruct>(statement(actionStmt)),
|
|
construct<ExecutableConstruct>(indirect(Parser<AssociateConstruct>{})),
|
|
construct<ExecutableConstruct>(indirect(Parser<BlockConstruct>{})),
|
|
construct<ExecutableConstruct>(indirect(Parser<CaseConstruct>{})),
|
|
construct<ExecutableConstruct>(indirect(Parser<ChangeTeamConstruct>{})),
|
|
construct<ExecutableConstruct>(indirect(Parser<CriticalConstruct>{})),
|
|
construct<ExecutableConstruct>(indirect(Parser<IfConstruct>{})),
|
|
construct<ExecutableConstruct>(indirect(Parser<SelectRankConstruct>{})),
|
|
construct<ExecutableConstruct>(indirect(Parser<SelectTypeConstruct>{})),
|
|
construct<ExecutableConstruct>(indirect(whereConstruct)),
|
|
construct<ExecutableConstruct>(indirect(forallConstruct)),
|
|
construct<ExecutableConstruct>(indirect(ompEndLoopDirective)),
|
|
construct<ExecutableConstruct>(indirect(openmpConstruct)),
|
|
construct<ExecutableConstruct>(indirect(accEndCombinedDirective)),
|
|
construct<ExecutableConstruct>(indirect(openaccConstruct)),
|
|
construct<ExecutableConstruct>(indirect(compilerDirective)))};
|
|
|
|
// R510 execution-part-construct ->
|
|
// executable-construct | format-stmt | entry-stmt | data-stmt
|
|
// Extension (PGI/Intel): also accept NAMELIST in execution part
|
|
constexpr auto obsoleteExecutionPartConstruct{recovery(ignoredStatementPrefix >>
|
|
fail<ExecutionPartConstruct>(
|
|
"obsolete legacy extension is not supported"_err_en_US),
|
|
construct<ExecutionPartConstruct>(construct<ErrorRecovery>(ok /
|
|
statement("REDIMENSION" >> name /
|
|
parenthesized(nonemptyList(Parser<AllocateShapeSpec>{}))))))};
|
|
|
|
TYPE_PARSER(recovery(
|
|
withMessage("expected execution part construct"_err_en_US,
|
|
CONTEXT_PARSER("execution part construct"_en_US,
|
|
first(construct<ExecutionPartConstruct>(executableConstruct),
|
|
construct<ExecutionPartConstruct>(
|
|
statement(indirect(formatStmt))),
|
|
construct<ExecutionPartConstruct>(
|
|
statement(indirect(entryStmt))),
|
|
construct<ExecutionPartConstruct>(
|
|
statement(indirect(dataStmt))),
|
|
extension<LanguageFeature::ExecutionPartNamelist>(
|
|
construct<ExecutionPartConstruct>(
|
|
statement(indirect(Parser<NamelistStmt>{})))),
|
|
obsoleteExecutionPartConstruct))),
|
|
construct<ExecutionPartConstruct>(executionPartErrorRecovery)))
|
|
|
|
// R509 execution-part -> executable-construct [execution-part-construct]...
|
|
TYPE_CONTEXT_PARSER("execution part"_en_US,
|
|
construct<ExecutionPart>(many(executionPartConstruct)))
|
|
|
|
// R515 action-stmt ->
|
|
// allocate-stmt | assignment-stmt | backspace-stmt | call-stmt |
|
|
// close-stmt | continue-stmt | cycle-stmt | deallocate-stmt |
|
|
// endfile-stmt | error-stop-stmt | event-post-stmt | event-wait-stmt |
|
|
// exit-stmt | fail-image-stmt | flush-stmt | form-team-stmt |
|
|
// goto-stmt | if-stmt | inquire-stmt | lock-stmt | nullify-stmt |
|
|
// open-stmt | pointer-assignment-stmt | print-stmt | read-stmt |
|
|
// return-stmt | rewind-stmt | stop-stmt | sync-all-stmt |
|
|
// sync-images-stmt | sync-memory-stmt | sync-team-stmt | unlock-stmt |
|
|
// wait-stmt | where-stmt | write-stmt | computed-goto-stmt | forall-stmt
|
|
// R1159 continue-stmt -> CONTINUE
|
|
// R1163 fail-image-stmt -> FAIL IMAGE
|
|
TYPE_PARSER(first(construct<ActionStmt>(indirect(Parser<AllocateStmt>{})),
|
|
construct<ActionStmt>(indirect(assignmentStmt)),
|
|
construct<ActionStmt>(indirect(pointerAssignmentStmt)),
|
|
construct<ActionStmt>(indirect(Parser<BackspaceStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<CallStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<CloseStmt>{})),
|
|
construct<ActionStmt>(construct<ContinueStmt>("CONTINUE"_tok)),
|
|
construct<ActionStmt>(indirect(Parser<CycleStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<DeallocateStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<EndfileStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<EventPostStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<EventWaitStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<ExitStmt>{})),
|
|
construct<ActionStmt>(construct<FailImageStmt>("FAIL IMAGE"_sptok)),
|
|
construct<ActionStmt>(indirect(Parser<FlushStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<FormTeamStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<GotoStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<IfStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<InquireStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<LockStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<NullifyStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<OpenStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<PrintStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<ReadStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<ReturnStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<RewindStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<StopStmt>{})), // & error-stop-stmt
|
|
construct<ActionStmt>(indirect(Parser<SyncAllStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<SyncImagesStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<SyncMemoryStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<SyncTeamStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<UnlockStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<WaitStmt>{})),
|
|
construct<ActionStmt>(indirect(whereStmt)),
|
|
construct<ActionStmt>(indirect(Parser<WriteStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<ComputedGotoStmt>{})),
|
|
construct<ActionStmt>(indirect(forallStmt)),
|
|
construct<ActionStmt>(indirect(Parser<ArithmeticIfStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<AssignStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<AssignedGotoStmt>{})),
|
|
construct<ActionStmt>(indirect(Parser<PauseStmt>{}))))
|
|
|
|
// R1102 associate-construct -> associate-stmt block end-associate-stmt
|
|
TYPE_CONTEXT_PARSER("ASSOCIATE construct"_en_US,
|
|
construct<AssociateConstruct>(statement(Parser<AssociateStmt>{}), block,
|
|
statement(Parser<EndAssociateStmt>{})))
|
|
|
|
// R1103 associate-stmt ->
|
|
// [associate-construct-name :] ASSOCIATE ( association-list )
|
|
TYPE_CONTEXT_PARSER("ASSOCIATE statement"_en_US,
|
|
construct<AssociateStmt>(maybe(name / ":"),
|
|
"ASSOCIATE" >> parenthesized(nonemptyList(Parser<Association>{}))))
|
|
|
|
// R1104 association -> associate-name => selector
|
|
TYPE_PARSER(construct<Association>(name, "=>" >> selector))
|
|
|
|
// R1105 selector -> expr | variable
|
|
TYPE_PARSER(construct<Selector>(variable) / lookAhead(","_tok || ")"_tok) ||
|
|
construct<Selector>(expr))
|
|
|
|
// R1106 end-associate-stmt -> END ASSOCIATE [associate-construct-name]
|
|
TYPE_PARSER(construct<EndAssociateStmt>(
|
|
recovery("END ASSOCIATE" >> maybe(name), endStmtErrorRecovery)))
|
|
|
|
// R1107 block-construct ->
|
|
// block-stmt [block-specification-part] block end-block-stmt
|
|
TYPE_CONTEXT_PARSER("BLOCK construct"_en_US,
|
|
construct<BlockConstruct>(statement(Parser<BlockStmt>{}),
|
|
Parser<BlockSpecificationPart>{}, // can be empty
|
|
block, statement(Parser<EndBlockStmt>{})))
|
|
|
|
// R1108 block-stmt -> [block-construct-name :] BLOCK
|
|
TYPE_PARSER(construct<BlockStmt>(maybe(name / ":") / "BLOCK"))
|
|
|
|
// R1109 block-specification-part ->
|
|
// [use-stmt]... [import-stmt]... [implicit-part]
|
|
// [[declaration-construct]... specification-construct]
|
|
// C1107 prohibits COMMON, EQUIVALENCE, INTENT, NAMELIST, OPTIONAL, VALUE,
|
|
// and statement function definitions. C1108 prohibits SAVE /common/.
|
|
// C1570 indirectly prohibits ENTRY. These constraints are best enforced later.
|
|
// The odd grammar rule above would have the effect of forcing any
|
|
// trailing FORMAT and DATA statements after the last specification-construct
|
|
// to be recognized as part of the block-construct's block part rather than
|
|
// its block-specification-part, a distinction without any apparent difference.
|
|
TYPE_PARSER(construct<BlockSpecificationPart>(specificationPart))
|
|
|
|
// R1110 end-block-stmt -> END BLOCK [block-construct-name]
|
|
TYPE_PARSER(construct<EndBlockStmt>(
|
|
recovery("END BLOCK" >> maybe(name), endStmtErrorRecovery)))
|
|
|
|
// R1111 change-team-construct -> change-team-stmt block end-change-team-stmt
|
|
TYPE_CONTEXT_PARSER("CHANGE TEAM construct"_en_US,
|
|
construct<ChangeTeamConstruct>(statement(Parser<ChangeTeamStmt>{}), block,
|
|
statement(Parser<EndChangeTeamStmt>{})))
|
|
|
|
// R1112 change-team-stmt ->
|
|
// [team-construct-name :] CHANGE TEAM
|
|
// ( team-value [, coarray-association-list] [, sync-stat-list] )
|
|
TYPE_CONTEXT_PARSER("CHANGE TEAM statement"_en_US,
|
|
construct<ChangeTeamStmt>(maybe(name / ":"),
|
|
"CHANGE TEAM"_sptok >> "("_tok >> teamValue,
|
|
defaulted("," >> nonemptyList(Parser<CoarrayAssociation>{})),
|
|
defaulted("," >> nonemptyList(statOrErrmsg))) /
|
|
")")
|
|
|
|
// R1113 coarray-association -> codimension-decl => selector
|
|
TYPE_PARSER(
|
|
construct<CoarrayAssociation>(Parser<CodimensionDecl>{}, "=>" >> selector))
|
|
|
|
// R1114 end-change-team-stmt ->
|
|
// END TEAM [( [sync-stat-list] )] [team-construct-name]
|
|
TYPE_CONTEXT_PARSER("END TEAM statement"_en_US,
|
|
construct<EndChangeTeamStmt>(
|
|
"END TEAM" >> defaulted(parenthesized(optionalList(statOrErrmsg))),
|
|
maybe(name)))
|
|
|
|
// R1117 critical-stmt ->
|
|
// [critical-construct-name :] CRITICAL [( [sync-stat-list] )]
|
|
TYPE_CONTEXT_PARSER("CRITICAL statement"_en_US,
|
|
construct<CriticalStmt>(maybe(name / ":"),
|
|
"CRITICAL" >> defaulted(parenthesized(optionalList(statOrErrmsg)))))
|
|
|
|
// R1116 critical-construct -> critical-stmt block end-critical-stmt
|
|
TYPE_CONTEXT_PARSER("CRITICAL construct"_en_US,
|
|
construct<CriticalConstruct>(statement(Parser<CriticalStmt>{}), block,
|
|
statement(Parser<EndCriticalStmt>{})))
|
|
|
|
// R1118 end-critical-stmt -> END CRITICAL [critical-construct-name]
|
|
TYPE_PARSER(construct<EndCriticalStmt>(
|
|
recovery("END CRITICAL" >> maybe(name), endStmtErrorRecovery)))
|
|
|
|
// R1119 do-construct -> do-stmt block end-do
|
|
// R1120 do-stmt -> nonlabel-do-stmt | label-do-stmt
|
|
TYPE_CONTEXT_PARSER("DO construct"_en_US,
|
|
construct<DoConstruct>(
|
|
statement(Parser<NonLabelDoStmt>{}) / EnterNonlabelDoConstruct{}, block,
|
|
statement(Parser<EndDoStmt>{}) / LeaveDoConstruct{}))
|
|
|
|
// R1125 concurrent-header ->
|
|
// ( [integer-type-spec ::] concurrent-control-list
|
|
// [, scalar-mask-expr] )
|
|
TYPE_PARSER(parenthesized(construct<ConcurrentHeader>(
|
|
maybe(integerTypeSpec / "::"), nonemptyList(Parser<ConcurrentControl>{}),
|
|
maybe("," >> scalarLogicalExpr))))
|
|
|
|
// R1126 concurrent-control ->
|
|
// index-name = concurrent-limit : concurrent-limit [: concurrent-step]
|
|
// R1127 concurrent-limit -> scalar-int-expr
|
|
// R1128 concurrent-step -> scalar-int-expr
|
|
TYPE_PARSER(construct<ConcurrentControl>(name / "=", scalarIntExpr / ":",
|
|
scalarIntExpr, maybe(":" >> scalarIntExpr)))
|
|
|
|
// R1130 locality-spec ->
|
|
// LOCAL ( variable-name-list ) | LOCAL_INIT ( variable-name-list ) |
|
|
// SHARED ( variable-name-list ) | DEFAULT ( NONE )
|
|
TYPE_PARSER(construct<LocalitySpec>(construct<LocalitySpec::Local>(
|
|
"LOCAL" >> parenthesized(listOfNames))) ||
|
|
construct<LocalitySpec>(construct<LocalitySpec::LocalInit>(
|
|
"LOCAL_INIT"_sptok >> parenthesized(listOfNames))) ||
|
|
construct<LocalitySpec>(construct<LocalitySpec::Shared>(
|
|
"SHARED" >> parenthesized(listOfNames))) ||
|
|
construct<LocalitySpec>(
|
|
construct<LocalitySpec::DefaultNone>("DEFAULT ( NONE )"_tok)))
|
|
|
|
// R1123 loop-control ->
|
|
// [,] do-variable = scalar-int-expr , scalar-int-expr
|
|
// [, scalar-int-expr] |
|
|
// [,] WHILE ( scalar-logical-expr ) |
|
|
// [,] CONCURRENT concurrent-header concurrent-locality
|
|
// R1129 concurrent-locality -> [locality-spec]...
|
|
TYPE_CONTEXT_PARSER("loop control"_en_US,
|
|
maybe(","_tok) >>
|
|
(construct<LoopControl>(loopBounds(scalarExpr)) ||
|
|
construct<LoopControl>(
|
|
"WHILE" >> parenthesized(scalarLogicalExpr)) ||
|
|
construct<LoopControl>(construct<LoopControl::Concurrent>(
|
|
"CONCURRENT" >> concurrentHeader,
|
|
many(Parser<LocalitySpec>{})))))
|
|
|
|
// R1121 label-do-stmt -> [do-construct-name :] DO label [loop-control]
|
|
TYPE_CONTEXT_PARSER("label DO statement"_en_US,
|
|
construct<LabelDoStmt>(
|
|
maybe(name / ":"), "DO" >> label, maybe(loopControl)))
|
|
|
|
// R1122 nonlabel-do-stmt -> [do-construct-name :] DO [loop-control]
|
|
TYPE_CONTEXT_PARSER("nonlabel DO statement"_en_US,
|
|
construct<NonLabelDoStmt>(maybe(name / ":"), "DO" >> maybe(loopControl)))
|
|
|
|
// R1132 end-do-stmt -> END DO [do-construct-name]
|
|
TYPE_CONTEXT_PARSER("END DO statement"_en_US,
|
|
construct<EndDoStmt>(
|
|
recovery("END DO" >> maybe(name), endStmtErrorRecovery)))
|
|
|
|
// R1133 cycle-stmt -> CYCLE [do-construct-name]
|
|
TYPE_CONTEXT_PARSER(
|
|
"CYCLE statement"_en_US, construct<CycleStmt>("CYCLE" >> maybe(name)))
|
|
|
|
// R1134 if-construct ->
|
|
// if-then-stmt block [else-if-stmt block]...
|
|
// [else-stmt block] end-if-stmt
|
|
// R1135 if-then-stmt -> [if-construct-name :] IF ( scalar-logical-expr )
|
|
// THEN R1136 else-if-stmt ->
|
|
// ELSE IF ( scalar-logical-expr ) THEN [if-construct-name]
|
|
// R1137 else-stmt -> ELSE [if-construct-name]
|
|
// R1138 end-if-stmt -> END IF [if-construct-name]
|
|
TYPE_CONTEXT_PARSER("IF construct"_en_US,
|
|
construct<IfConstruct>(
|
|
statement(construct<IfThenStmt>(maybe(name / ":"),
|
|
"IF" >> parenthesized(scalarLogicalExpr) / "THEN")),
|
|
block,
|
|
many(construct<IfConstruct::ElseIfBlock>(
|
|
unambiguousStatement(construct<ElseIfStmt>(
|
|
"ELSE IF" >> parenthesized(scalarLogicalExpr),
|
|
"THEN" >> maybe(name))),
|
|
block)),
|
|
maybe(construct<IfConstruct::ElseBlock>(
|
|
statement(construct<ElseStmt>("ELSE" >> maybe(name))), block)),
|
|
statement(construct<EndIfStmt>(
|
|
recovery("END IF" >> maybe(name), endStmtErrorRecovery)))))
|
|
|
|
// R1139 if-stmt -> IF ( scalar-logical-expr ) action-stmt
|
|
TYPE_CONTEXT_PARSER("IF statement"_en_US,
|
|
construct<IfStmt>("IF" >> parenthesized(scalarLogicalExpr),
|
|
unlabeledStatement(actionStmt)))
|
|
|
|
// R1140 case-construct ->
|
|
// select-case-stmt [case-stmt block]... end-select-stmt
|
|
TYPE_CONTEXT_PARSER("SELECT CASE construct"_en_US,
|
|
construct<CaseConstruct>(statement(Parser<SelectCaseStmt>{}),
|
|
many(construct<CaseConstruct::Case>(
|
|
unambiguousStatement(Parser<CaseStmt>{}), block)),
|
|
statement(endSelectStmt)))
|
|
|
|
// R1141 select-case-stmt -> [case-construct-name :] SELECT CASE ( case-expr
|
|
// ) R1144 case-expr -> scalar-expr
|
|
TYPE_CONTEXT_PARSER("SELECT CASE statement"_en_US,
|
|
construct<SelectCaseStmt>(
|
|
maybe(name / ":"), "SELECT CASE" >> parenthesized(scalar(expr))))
|
|
|
|
// R1142 case-stmt -> CASE case-selector [case-construct-name]
|
|
TYPE_CONTEXT_PARSER("CASE statement"_en_US,
|
|
construct<CaseStmt>("CASE" >> Parser<CaseSelector>{}, maybe(name)))
|
|
|
|
// R1143 end-select-stmt -> END SELECT [case-construct-name]
|
|
// R1151 end-select-rank-stmt -> END SELECT [select-construct-name]
|
|
// R1155 end-select-type-stmt -> END SELECT [select-construct-name]
|
|
TYPE_PARSER(construct<EndSelectStmt>(
|
|
recovery("END SELECT" >> maybe(name), endStmtErrorRecovery)))
|
|
|
|
// R1145 case-selector -> ( case-value-range-list ) | DEFAULT
|
|
constexpr auto defaultKeyword{construct<Default>("DEFAULT"_tok)};
|
|
TYPE_PARSER(parenthesized(construct<CaseSelector>(
|
|
nonemptyList(Parser<CaseValueRange>{}))) ||
|
|
construct<CaseSelector>(defaultKeyword))
|
|
|
|
// R1147 case-value -> scalar-constant-expr
|
|
constexpr auto caseValue{scalar(constantExpr)};
|
|
|
|
// R1146 case-value-range ->
|
|
// case-value | case-value : | : case-value | case-value : case-value
|
|
TYPE_PARSER(construct<CaseValueRange>(construct<CaseValueRange::Range>(
|
|
construct<std::optional<CaseValue>>(caseValue),
|
|
":" >> maybe(caseValue))) ||
|
|
construct<CaseValueRange>(
|
|
construct<CaseValueRange::Range>(construct<std::optional<CaseValue>>(),
|
|
":" >> construct<std::optional<CaseValue>>(caseValue))) ||
|
|
construct<CaseValueRange>(caseValue))
|
|
|
|
// R1148 select-rank-construct ->
|
|
// select-rank-stmt [select-rank-case-stmt block]...
|
|
// end-select-rank-stmt
|
|
TYPE_CONTEXT_PARSER("SELECT RANK construct"_en_US,
|
|
construct<SelectRankConstruct>(statement(Parser<SelectRankStmt>{}),
|
|
many(construct<SelectRankConstruct::RankCase>(
|
|
unambiguousStatement(Parser<SelectRankCaseStmt>{}), block)),
|
|
statement(endSelectStmt)))
|
|
|
|
// R1149 select-rank-stmt ->
|
|
// [select-construct-name :] SELECT RANK
|
|
// ( [associate-name =>] selector )
|
|
TYPE_CONTEXT_PARSER("SELECT RANK statement"_en_US,
|
|
construct<SelectRankStmt>(maybe(name / ":"),
|
|
"SELECT RANK"_sptok >> "("_tok >> maybe(name / "=>"), selector / ")"))
|
|
|
|
// R1150 select-rank-case-stmt ->
|
|
// RANK ( scalar-int-constant-expr ) [select-construct-name] |
|
|
// RANK ( * ) [select-construct-name] |
|
|
// RANK DEFAULT [select-construct-name]
|
|
TYPE_CONTEXT_PARSER("RANK case statement"_en_US,
|
|
"RANK" >> (construct<SelectRankCaseStmt>(
|
|
parenthesized(construct<SelectRankCaseStmt::Rank>(
|
|
scalarIntConstantExpr) ||
|
|
construct<SelectRankCaseStmt::Rank>(star)) ||
|
|
construct<SelectRankCaseStmt::Rank>(defaultKeyword),
|
|
maybe(name))))
|
|
|
|
// R1152 select-type-construct ->
|
|
// select-type-stmt [type-guard-stmt block]... end-select-type-stmt
|
|
TYPE_CONTEXT_PARSER("SELECT TYPE construct"_en_US,
|
|
construct<SelectTypeConstruct>(statement(Parser<SelectTypeStmt>{}),
|
|
many(construct<SelectTypeConstruct::TypeCase>(
|
|
unambiguousStatement(Parser<TypeGuardStmt>{}), block)),
|
|
statement(endSelectStmt)))
|
|
|
|
// R1153 select-type-stmt ->
|
|
// [select-construct-name :] SELECT TYPE
|
|
// ( [associate-name =>] selector )
|
|
TYPE_CONTEXT_PARSER("SELECT TYPE statement"_en_US,
|
|
construct<SelectTypeStmt>(maybe(name / ":"),
|
|
"SELECT TYPE (" >> maybe(name / "=>"), selector / ")"))
|
|
|
|
// R1154 type-guard-stmt ->
|
|
// TYPE IS ( type-spec ) [select-construct-name] |
|
|
// CLASS IS ( derived-type-spec ) [select-construct-name] |
|
|
// CLASS DEFAULT [select-construct-name]
|
|
TYPE_CONTEXT_PARSER("type guard statement"_en_US,
|
|
construct<TypeGuardStmt>("TYPE IS"_sptok >>
|
|
parenthesized(construct<TypeGuardStmt::Guard>(typeSpec)) ||
|
|
"CLASS IS"_sptok >> parenthesized(construct<TypeGuardStmt::Guard>(
|
|
derivedTypeSpec)) ||
|
|
construct<TypeGuardStmt::Guard>("CLASS" >> defaultKeyword),
|
|
maybe(name)))
|
|
|
|
// R1156 exit-stmt -> EXIT [construct-name]
|
|
TYPE_CONTEXT_PARSER(
|
|
"EXIT statement"_en_US, construct<ExitStmt>("EXIT" >> maybe(name)))
|
|
|
|
// R1157 goto-stmt -> GO TO label
|
|
TYPE_CONTEXT_PARSER(
|
|
"GOTO statement"_en_US, construct<GotoStmt>("GO TO" >> label))
|
|
|
|
// R1158 computed-goto-stmt -> GO TO ( label-list ) [,] scalar-int-expr
|
|
TYPE_CONTEXT_PARSER("computed GOTO statement"_en_US,
|
|
construct<ComputedGotoStmt>("GO TO" >> parenthesized(nonemptyList(label)),
|
|
maybe(","_tok) >> scalarIntExpr))
|
|
|
|
// R1160 stop-stmt -> STOP [stop-code] [, QUIET = scalar-logical-expr]
|
|
// R1161 error-stop-stmt ->
|
|
// ERROR STOP [stop-code] [, QUIET = scalar-logical-expr]
|
|
TYPE_CONTEXT_PARSER("STOP statement"_en_US,
|
|
construct<StopStmt>("STOP" >> pure(StopStmt::Kind::Stop) ||
|
|
"ERROR STOP"_sptok >> pure(StopStmt::Kind::ErrorStop),
|
|
maybe(Parser<StopCode>{}), maybe(", QUIET =" >> scalarLogicalExpr)))
|
|
|
|
// R1162 stop-code -> scalar-default-char-expr | scalar-int-expr
|
|
// The two alternatives for stop-code can't be distinguished at
|
|
// parse time.
|
|
TYPE_PARSER(construct<StopCode>(scalar(expr)))
|
|
|
|
// R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )]
|
|
TYPE_CONTEXT_PARSER("SYNC ALL statement"_en_US,
|
|
construct<SyncAllStmt>("SYNC ALL"_sptok >>
|
|
defaulted(parenthesized(optionalList(statOrErrmsg)))))
|
|
|
|
// R1166 sync-images-stmt -> SYNC IMAGES ( image-set [, sync-stat-list] )
|
|
// R1167 image-set -> int-expr | *
|
|
TYPE_CONTEXT_PARSER("SYNC IMAGES statement"_en_US,
|
|
"SYNC IMAGES"_sptok >> parenthesized(construct<SyncImagesStmt>(
|
|
construct<SyncImagesStmt::ImageSet>(intExpr) ||
|
|
construct<SyncImagesStmt::ImageSet>(star),
|
|
defaulted("," >> nonemptyList(statOrErrmsg)))))
|
|
|
|
// R1168 sync-memory-stmt -> SYNC MEMORY [( [sync-stat-list] )]
|
|
TYPE_CONTEXT_PARSER("SYNC MEMORY statement"_en_US,
|
|
construct<SyncMemoryStmt>("SYNC MEMORY"_sptok >>
|
|
defaulted(parenthesized(optionalList(statOrErrmsg)))))
|
|
|
|
// R1169 sync-team-stmt -> SYNC TEAM ( team-value [, sync-stat-list] )
|
|
TYPE_CONTEXT_PARSER("SYNC TEAM statement"_en_US,
|
|
construct<SyncTeamStmt>("SYNC TEAM"_sptok >> "("_tok >> teamValue,
|
|
defaulted("," >> nonemptyList(statOrErrmsg)) / ")"))
|
|
|
|
// R1170 event-post-stmt -> EVENT POST ( event-variable [, sync-stat-list] )
|
|
// R1171 event-variable -> scalar-variable
|
|
TYPE_CONTEXT_PARSER("EVENT POST statement"_en_US,
|
|
construct<EventPostStmt>("EVENT POST"_sptok >> "("_tok >> scalar(variable),
|
|
defaulted("," >> nonemptyList(statOrErrmsg)) / ")"))
|
|
|
|
// R1172 event-wait-stmt ->
|
|
// EVENT WAIT ( event-variable [, event-wait-spec-list] )
|
|
TYPE_CONTEXT_PARSER("EVENT WAIT statement"_en_US,
|
|
construct<EventWaitStmt>("EVENT WAIT"_sptok >> "("_tok >> scalar(variable),
|
|
defaulted("," >> nonemptyList(Parser<EventWaitStmt::EventWaitSpec>{})) /
|
|
")"))
|
|
|
|
// R1174 until-spec -> UNTIL_COUNT = scalar-int-expr
|
|
constexpr auto untilSpec{"UNTIL_COUNT =" >> scalarIntExpr};
|
|
|
|
// R1173 event-wait-spec -> until-spec | sync-stat
|
|
TYPE_PARSER(construct<EventWaitStmt::EventWaitSpec>(untilSpec) ||
|
|
construct<EventWaitStmt::EventWaitSpec>(statOrErrmsg))
|
|
|
|
// R1177 team-variable -> scalar-variable
|
|
constexpr auto teamVariable{scalar(variable)};
|
|
|
|
// R1175 form-team-stmt ->
|
|
// FORM TEAM ( team-number , team-variable [, form-team-spec-list] )
|
|
// R1176 team-number -> scalar-int-expr
|
|
TYPE_CONTEXT_PARSER("FORM TEAM statement"_en_US,
|
|
construct<FormTeamStmt>("FORM TEAM"_sptok >> "("_tok >> scalarIntExpr,
|
|
"," >> teamVariable,
|
|
defaulted("," >> nonemptyList(Parser<FormTeamStmt::FormTeamSpec>{})) /
|
|
")"))
|
|
|
|
// R1178 form-team-spec -> NEW_INDEX = scalar-int-expr | sync-stat
|
|
TYPE_PARSER(
|
|
construct<FormTeamStmt::FormTeamSpec>("NEW_INDEX =" >> scalarIntExpr) ||
|
|
construct<FormTeamStmt::FormTeamSpec>(statOrErrmsg))
|
|
|
|
// R1182 lock-variable -> scalar-variable
|
|
constexpr auto lockVariable{scalar(variable)};
|
|
|
|
// R1179 lock-stmt -> LOCK ( lock-variable [, lock-stat-list] )
|
|
TYPE_CONTEXT_PARSER("LOCK statement"_en_US,
|
|
construct<LockStmt>("LOCK (" >> lockVariable,
|
|
defaulted("," >> nonemptyList(Parser<LockStmt::LockStat>{})) / ")"))
|
|
|
|
// R1180 lock-stat -> ACQUIRED_LOCK = scalar-logical-variable | sync-stat
|
|
TYPE_PARSER(
|
|
construct<LockStmt::LockStat>("ACQUIRED_LOCK =" >> scalarLogicalVariable) ||
|
|
construct<LockStmt::LockStat>(statOrErrmsg))
|
|
|
|
// R1181 unlock-stmt -> UNLOCK ( lock-variable [, sync-stat-list] )
|
|
TYPE_CONTEXT_PARSER("UNLOCK statement"_en_US,
|
|
construct<UnlockStmt>("UNLOCK (" >> lockVariable,
|
|
defaulted("," >> nonemptyList(statOrErrmsg)) / ")"))
|
|
|
|
} // namespace Fortran::parser
|