return (pexpr).Parse(state); \
}
-#define TYPE_CONTEXT_PARSER(contextString, pexpr) \
+#define TYPE_CONTEXT_PARSER(contextText, pexpr) \
template<> \
inline std::optional<typename decltype(pexpr)::resultType> \
Parser<typename decltype(pexpr)::resultType>::Parse(ParseState *state) { \
- return inContext((contextString), (pexpr)).Parse(state); \
+ return inContext((contextText), (pexpr)).Parse(state); \
}
// Some specializations of Parser<> are used multiple times, or are
}
constexpr auto endOfLine = CharMatch<'\n'>{} / skipMany("\n"_tok) ||
- fail<char>("expected end of line");
+ fail<char>("expected end of line"_msg);
constexpr auto endOfStmt = spaces >>
(CharMatch<';'>{} / skipMany(";"_tok) / maybe(endOfLine) || endOfLine);
// R507 declaration-construct ->
// specification-construct | data-stmt | format-stmt |
// entry-stmt | stmt-function-stmt
-TYPE_CONTEXT_PARSER("declaration construct",
+TYPE_CONTEXT_PARSER("declaration construct"_msg,
construct<DeclarationConstruct>{}(specificationConstruct) ||
construct<DeclarationConstruct>{}(statement(indirect(dataStmt))) ||
construct<DeclarationConstruct>{}(statement(indirect(formatStmt))) ||
// derived-type-def | enum-def | generic-stmt | interface-block |
// parameter-stmt | procedure-declaration-stmt |
// other-specification-stmt | type-declaration-stmt
-TYPE_CONTEXT_PARSER("specification construct",
+TYPE_CONTEXT_PARSER("specification construct"_msg,
construct<SpecificationConstruct>{}(indirect(Parser<DerivedTypeDef>{})) ||
construct<SpecificationConstruct>{}(indirect(Parser<EnumDef>{})) ||
construct<SpecificationConstruct>{}(
// R504 specification-part ->
// [use-stmt]... [import-stmt]... [implicit-part]
// [declaration-construct]...
-TYPE_CONTEXT_PARSER("specification part",
+TYPE_CONTEXT_PARSER("specification part"_msg,
construct<SpecificationPart>{}(many(statement(indirect(Parser<UseStmt>{}))),
many(statement(indirect(Parser<ImportStmt>{}))), implicitPart,
many(declarationConstruct)))
// TODO: Can overshoot; any trailing PARAMETER, FORMAT, & ENTRY
// statements after the last IMPLICIT should be transferred to the
// list of declaration-constructs.
-TYPE_CONTEXT_PARSER("implicit part",
+TYPE_CONTEXT_PARSER("implicit part"_msg,
construct<ImplicitPart>{}(many(Parser<ImplicitPartStmt>{})))
// R506 implicit-part-stmt ->
endOfStmt;
// R511 internal-subprogram-part -> contains-stmt [internal-subprogram]...
-TYPE_CONTEXT_PARSER("internal subprogram part",
+TYPE_CONTEXT_PARSER("internal subprogram part"_msg,
construct<InternalSubprogramPart>{}(statement(containsStmt),
many(startNewSubprogram >> internalSubprogram)))
// R510 execution-part-construct ->
// executable-construct | format-stmt | entry-stmt | data-stmt
// Extension (PGI/Intel): also accept NAMELIST in execution part
-TYPE_CONTEXT_PARSER("execution part construct",
+TYPE_CONTEXT_PARSER("execution part construct"_msg,
recovery(construct<ExecutionPartConstruct>{}(executableConstruct) ||
construct<ExecutionPartConstruct>{}(
statement(indirect(formatStmt))) ||
// R509 execution-part -> executable-construct [execution-part-construct]...
constexpr auto executionPart =
- inContext("execution part", many(executionPartConstruct));
+ inContext("execution part"_msg, many(executionPartConstruct));
// R602 underscore -> _
constexpr CharMatch<'_'> underscore;
// the other is below in R703 declaration-type-spec. Look-ahead is required
// to disambiguate the cases where a derived type name begins with the name
// of an intrinsic type, e.g., REALITY.
-TYPE_CONTEXT_PARSER("type spec",
+TYPE_CONTEXT_PARSER("type spec"_msg,
construct<TypeSpec>{}(intrinsicTypeSpec / lookAhead("::"_tok || ")"_tok)) ||
construct<TypeSpec>{}(derivedTypeSpec))
// for TYPE (...), rather than putting the alternatives within it, which
// would fail on "TYPE(real_derived)" with a misrecognition of "real" as an
// intrinsic-type-spec.
-TYPE_CONTEXT_PARSER("declaration type spec",
+TYPE_CONTEXT_PARSER("declaration type spec"_msg,
construct<DeclarationTypeSpec>{}(intrinsicTypeSpec) ||
"TYPE" >>
(parenthesized(
// COMPLEX [kind-selector] | CHARACTER [char-selector] |
// LOGICAL [kind-selector]
// Extensions: DOUBLE COMPLEX, NCHARACTER, BYTE
-TYPE_CONTEXT_PARSER("intrinsic type spec",
+TYPE_CONTEXT_PARSER("intrinsic type spec"_msg,
construct<IntrinsicTypeSpec>{}(integerTypeSpec) ||
"REAL" >>
construct<IntrinsicTypeSpec>{}(
// digit-string exponent-letter exponent [_ kind-param]
// R715 significand -> digit-string . [digit-string] | . digit-string
// N.B. Preceding spaces are not skipped.
-TYPE_CONTEXT_PARSER("REAL literal constant",
+TYPE_CONTEXT_PARSER("REAL literal constant"_msg,
construct<RealLiteralConstant>{}(some(digit),
CharMatch<'.'>{} >>
!(some(letter) >> CharMatch<'.'>{}) >> // don't misinterpret 1.AND.
inline constexpr bool isQ(char ch) { return tolower(ch) == 'q'; }
constexpr CharPredicateGuardParser exponentEorD{
- isEorD, "expected exponent letter"},
- exponentQ{isQ, "expected exponent letter"};
+ isEorD, "expected exponent letter"_msg};
+constexpr CharPredicateGuardParser exponentQ{
+ isQ, "expected exponent letter"_msg};
// R717 exponent -> signed-digit-string
// Not a complete token.
extension(exponentQ) || exponentEorD, signedDigitString))
// R718 complex-literal-constant -> ( real-part , imag-part )
-TYPE_CONTEXT_PARSER("COMPLEX literal constant",
+TYPE_CONTEXT_PARSER("COMPLEX literal constant"_msg,
parenthesized(construct<ComplexLiteralConstant>{}(
Parser<ComplexPart>{} / ",", Parser<ComplexPart>{})))
CharMatch<'\''>{} >> CharLiteral<'\''>{} ||
CharMatch<'"'>{} >> CharLiteral<'"'>{};
-TYPE_CONTEXT_PARSER("CHARACTER literal constant",
+TYPE_CONTEXT_PARSER("CHARACTER literal constant"_msg,
construct<CharLiteralConstant>{}(
kindParam / underscore, charLiteralConstantWithoutKind) ||
construct<CharLiteralConstant>{}(construct<std::optional<KindParam>>{},
constexpr auto rawHollerithLiteral = deprecated(HollerithLiteral{});
TYPE_CONTEXT_PARSER(
- "Hollerith", construct<HollerithLiteralConstant>{}(rawHollerithLiteral))
+ "Hollerith"_msg, construct<HollerithLiteralConstant>{}(rawHollerithLiteral))
// R725 logical-literal-constant -> .TRUE. | .FALSE.
// Also accept .T. and .F. as extensions.
extension(".F."_tok >> construct<LogicalLiteralConstant>{}(pure(false))))
// R726 derived-type-def ->
-// derived-type-stmt [type-param-def-stmt]... [private-or-sequence]...
-// [component-part] [type-bound-procedure-part] end-type-stmt
+// derived-type-stmt [type-param-def-stmt]...
+// [private-or-sequence]... [component-part]
+// [type-bound-procedure-part] end-type-stmt
// R735 component-part -> [component-def-stmt]...
-TYPE_CONTEXT_PARSER("derived type definition",
+TYPE_CONTEXT_PARSER("derived type definition"_msg,
construct<DerivedTypeDef>{}(statement(Parser<DerivedTypeStmt>{}),
many(statement(Parser<TypeParamDefStmt>{})),
many(statement(Parser<PrivateOrSequence>{})),
statement(Parser<EndTypeStmt>{})))
// R727 derived-type-stmt ->
-// TYPE [[, type-attr-spec-list] ::] type-name [( type-param-name-list )]
-TYPE_CONTEXT_PARSER("TYPE statement",
+// TYPE [[, type-attr-spec-list] ::] type-name [(
+// type-param-name-list )]
+TYPE_CONTEXT_PARSER("TYPE statement"_msg,
"TYPE" >> construct<DerivedTypeStmt>{}(
optionalBeforeColons(nonemptyList(Parser<TypeAttrSpec>{})),
name, defaulted(parenthesized(nonemptyList(name)))))
TYPE_PARSER(
construct<TypeParamDecl>{}(name, maybe("=" >> scalarIntConstantExpr)))
-// R736 component-def-stmt -> data-component-def-stmt | proc-component-def-stmt
+// R736 component-def-stmt -> data-component-def-stmt |
+// proc-component-def-stmt
TYPE_PARSER(construct<ComponentDefStmt>{}(Parser<DataComponentDefStmt>{}) ||
construct<ComponentDefStmt>{}(Parser<ProcComponentDefStmt>{})
// Accidental extension: PGI accepts type-param-def-stmt in
// component-part of derived-type-def. Not enabled here.
- // || extension(construct<ComponentDefStmt>{}(Parser<TypeParamDefStmt>{})
+ // ||
+ // extension(construct<ComponentDefStmt>{}(Parser<TypeParamDefStmt>{})
)
// R737 data-component-def-stmt ->
// component-name [( component-array-spec )]
// [lbracket coarray-spec rbracket] [* char-length]
// [component-initialization]
-TYPE_CONTEXT_PARSER("component declaration",
+TYPE_CONTEXT_PARSER("component declaration"_msg,
construct<ComponentDecl>{}(name, maybe(Parser<ComponentArraySpec>{}),
maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization)))
// R741 proc-component-def-stmt ->
// PROCEDURE ( [proc-interface] ) , proc-component-attr-spec-list
// :: proc-decl-list
-TYPE_CONTEXT_PARSER("PROCEDURE component definition statement",
+TYPE_CONTEXT_PARSER("PROCEDURE component definition statement"_msg,
"PROCEDURE" >>
construct<ProcComponentDefStmt>{}(parenthesized(maybe(procInterface)),
"," >> nonemptyList(Parser<ProcComponentAttrSpec>{}) / "::",
// R746 type-bound-procedure-part ->
// contains-stmt [binding-private-stmt] [type-bound-proc-binding]...
-TYPE_CONTEXT_PARSER("type bound procedure part",
+TYPE_CONTEXT_PARSER("type bound procedure part"_msg,
construct<TypeBoundProcedurePart>{}(statement(containsStmt),
maybe(statement(Parser<PrivateStmt>{})),
many(statement(Parser<TypeBoundProcBinding>{}))))
// R749 type-bound-procedure-stmt ->
// PROCEDURE [[, bind-attr-list] ::] type-bound-proc-decl-list |
// PROCEDURE ( interface-name ) , bind-attr-list :: binding-name-list
-TYPE_CONTEXT_PARSER("type bound PROCEDURE statement",
+TYPE_CONTEXT_PARSER("type bound PROCEDURE statement"_msg,
"PROCEDURE" >>
(construct<TypeBoundProcedureStmt>{}(
construct<TypeBoundProcedureStmt::WithInterface>{}(
// R751 type-bound-generic-stmt ->
// GENERIC [, access-spec] :: generic-spec => binding-name-list
-TYPE_CONTEXT_PARSER("type bound GENERIC statement",
+TYPE_CONTEXT_PARSER("type bound GENERIC statement"_msg,
"GENERIC" >> construct<TypeBoundGenericStmt>{}(maybe("," >> accessSpec),
"::" >> indirect(genericSpec), "=>" >> nonemptyList(name)))
construct<BindAttr>{}(noPass) || construct<BindAttr>{}(pass))
// R753 final-procedure-stmt -> FINAL [::] final-subroutine-name-list
-TYPE_CONTEXT_PARSER("FINAL statement",
+TYPE_CONTEXT_PARSER("FINAL statement"_msg,
"FINAL" >> maybe("::"_tok) >>
construct<FinalProcedureStmt>{}(nonemptyList(name)))
// R759 enum-def ->
// enum-def-stmt enumerator-def-stmt [enumerator-def-stmt]...
// end-enum-stmt
-TYPE_CONTEXT_PARSER("enum definition",
+TYPE_CONTEXT_PARSER("enum definition"_msg,
construct<EnumDef>{}(statement(Parser<EnumDefStmt>{}),
some(statement(Parser<EnumeratorDefStmt>{})),
statement(Parser<EndEnumStmt>{})))
TYPE_PARSER("ENUM , BIND ( C )" >> construct<EnumDefStmt>{})
// R761 enumerator-def-stmt -> ENUMERATOR [::] enumerator-list
-TYPE_CONTEXT_PARSER("ENUMERATOR statement",
+TYPE_CONTEXT_PARSER("ENUMERATOR statement"_msg,
construct<EnumeratorDefStmt>{}(
"ENUMERATOR" >> maybe("::"_tok) >> nonemptyList(Parser<Enumerator>{})))
}
// R769 array-constructor -> (/ ac-spec /) | lbracket ac-spec rbracket
-TYPE_CONTEXT_PARSER("array constructor",
+TYPE_CONTEXT_PARSER("array constructor"_msg,
construct<ArrayConstructor>{}(
"(/" >> Parser<AcSpec>{} / "/)" || bracketed(Parser<AcSpec>{})))
construct<ContiguousStmt>{}(nonemptyList(objectName)))
// R837 data-stmt -> DATA data-stmt-set [[,] data-stmt-set]...
-TYPE_CONTEXT_PARSER("DATA statement",
+TYPE_CONTEXT_PARSER("DATA statement"_msg,
"DATA" >> construct<DataStmt>{}(
nonemptySeparated(Parser<DataStmtSet>{}, maybe(","_tok))))
// R848 dimension-stmt ->
// DIMENSION [::] array-name ( array-spec )
// [, array-name ( array-spec )]...
-TYPE_CONTEXT_PARSER("DIMENSION statement",
+TYPE_CONTEXT_PARSER("DIMENSION statement"_msg,
"DIMENSION" >> maybe("::"_tok) >>
construct<DimensionStmt>{}(nonemptyList(
construct<DimensionStmt::Declaration>{}(name, arraySpec))))
// R849 intent-stmt -> INTENT ( intent-spec ) [::] dummy-arg-name-list
-TYPE_CONTEXT_PARSER("INTENT statement",
+TYPE_CONTEXT_PARSER("INTENT statement"_msg,
"INTENT" >>
construct<IntentStmt>{}(
parenthesized(intentSpec) / maybe("::"_tok), nonemptyList(name)))
// R851 parameter-stmt -> PARAMETER ( named-constant-def-list )
// Legacy extension: omitted parentheses
-TYPE_CONTEXT_PARSER("PARAMETER statement",
+TYPE_CONTEXT_PARSER("PARAMETER statement"_msg,
"PARAMETER" >>
construct<ParameterStmt>{}(
parenthesized(nonemptyList(Parser<NamedConstantDef>{})) ||
// R863 implicit-stmt ->
// IMPLICIT implicit-spec-list |
// IMPLICIT NONE [( [implicit-name-spec-list] )]
-TYPE_CONTEXT_PARSER("IMPLICIT statement",
+TYPE_CONTEXT_PARSER("IMPLICIT statement"_msg,
"IMPLICIT" >>
(construct<ImplicitStmt>{}(nonemptyList(Parser<ImplicitSpec>{})) ||
construct<ImplicitStmt>{}("NONE" >>
// R867 import-stmt ->
// IMPORT [[::] import-name-list] |
// IMPORT , ONLY : import-name-list | IMPORT , NONE | IMPORT , ALL
-TYPE_CONTEXT_PARSER("IMPORT statement",
+TYPE_CONTEXT_PARSER("IMPORT statement"_msg,
"IMPORT" >>
(construct<ImportStmt>{}(
", ONLY :" >> pure(ImportStmt::Kind::Only), nonemptyList(name)) ||
// R927 allocate-stmt ->
// ALLOCATE ( [type-spec ::] allocation-list [, alloc-opt-list] )
-TYPE_CONTEXT_PARSER("ALLOCATE statement",
+TYPE_CONTEXT_PARSER("ALLOCATE statement"_msg,
"ALLOCATE" >>
parenthesized(construct<AllocateStmt>{}(maybe(typeSpec / "::"),
nonemptyList(Parser<Allocation>{}),
maybe(boundExpr / ":") / "*"))
// R939 nullify-stmt -> NULLIFY ( pointer-object-list )
-TYPE_CONTEXT_PARSER("NULLIFY statement",
+TYPE_CONTEXT_PARSER("NULLIFY statement"_msg,
"NULLIFY" >> parenthesized(construct<NullifyStmt>{}(
nonemptyList(Parser<PointerObject>{}))))
// R941 deallocate-stmt ->
// DEALLOCATE ( allocate-object-list [, dealloc-opt-list] )
-TYPE_CONTEXT_PARSER("DEALLOCATE statement",
+TYPE_CONTEXT_PARSER("DEALLOCATE statement"_msg,
"DEALLOCATE" >> parenthesized(construct<DeallocateStmt>{}(
nonemptyList(Parser<AllocateObject>{}),
defaulted("," >> nonemptyList(statOrErrmsg)))))
TYPE_PARSER(construct<SpecificationExpr>{}(scalarIntExpr))
// R1032 assignment-stmt -> variable = expr
-TYPE_CONTEXT_PARSER(
- "assignment statement", construct<AssignmentStmt>{}(variable / "=", expr))
+TYPE_CONTEXT_PARSER("assignment statement"_msg,
+ construct<AssignmentStmt>{}(variable / "=", expr))
// R1033 pointer-assignment-stmt ->
// data-pointer-object [( bounds-spec-list )] => data-target |
// A distinction can't be made at the time of the initial parse between
// data-pointer-object and proc-pointer-object, or between data-target
// and proc-target.
-TYPE_CONTEXT_PARSER("pointer assignment statement",
+TYPE_CONTEXT_PARSER("pointer assignment statement"_msg,
construct<PointerAssignmentStmt>{}(variable,
parenthesized(nonemptyList(Parser<BoundsRemapping>{})), "=>" >> expr) ||
construct<PointerAssignmentStmt>{}(variable,
// R1041 where-stmt -> WHERE ( mask-expr ) where-assignment-stmt
// R1045 where-assignment-stmt -> assignment-stmt
// R1046 mask-expr -> logical-expr
-TYPE_CONTEXT_PARSER("WHERE statement",
+TYPE_CONTEXT_PARSER("WHERE statement"_msg,
"WHERE" >>
construct<WhereStmt>{}(parenthesized(logicalExpr), assignmentStmt))
// where-construct-stmt [where-body-construct]...
// [masked-elsewhere-stmt [where-body-construct]...]...
// [elsewhere-stmt [where-body-construct]...] end-where-stmt
-TYPE_CONTEXT_PARSER("WHERE construct",
+TYPE_CONTEXT_PARSER("WHERE construct"_msg,
construct<WhereConstruct>{}(statement(Parser<WhereConstructStmt>{}),
many(whereBodyConstruct),
many(construct<WhereConstruct::MaskedElsewhere>{}(
statement(Parser<EndWhereStmt>{})))
// R1043 where-construct-stmt -> [where-construct-name :] WHERE ( mask-expr )
-TYPE_CONTEXT_PARSER("WHERE construct statement",
+TYPE_CONTEXT_PARSER("WHERE construct statement"_msg,
construct<WhereConstructStmt>{}(
maybe(name / ":"), "WHERE" >> parenthesized(logicalExpr)))
// R1047 masked-elsewhere-stmt ->
// ELSEWHERE ( mask-expr ) [where-construct-name]
-TYPE_CONTEXT_PARSER("masked ELSEWHERE statement",
+TYPE_CONTEXT_PARSER("masked ELSEWHERE statement"_msg,
"ELSEWHERE" >> construct<MaskedElsewhereStmt>{}(
parenthesized(logicalExpr), maybe(name)))
// R1048 elsewhere-stmt -> ELSEWHERE [where-construct-name]
-TYPE_CONTEXT_PARSER("ELSEWHERE statement",
+TYPE_CONTEXT_PARSER("ELSEWHERE statement"_msg,
"ELSEWHERE" >> construct<ElsewhereStmt>{}(maybe(name)))
// R1049 end-where-stmt -> ENDWHERE [where-construct-name]
-TYPE_CONTEXT_PARSER("END WHERE statement",
+TYPE_CONTEXT_PARSER("END WHERE statement"_msg,
"END WHERE" >> construct<EndWhereStmt>{}(maybe(name)))
// R1050 forall-construct ->
// forall-construct-stmt [forall-body-construct]... end-forall-stmt
-TYPE_CONTEXT_PARSER("FORALL construct",
+TYPE_CONTEXT_PARSER("FORALL construct"_msg,
construct<ForallConstruct>{}(statement(Parser<ForallConstructStmt>{}),
many(Parser<ForallBodyConstruct>{}),
statement(Parser<EndForallStmt>{})))
// R1051 forall-construct-stmt ->
// [forall-construct-name :] FORALL concurrent-header
-TYPE_CONTEXT_PARSER("FORALL construct statement",
+TYPE_CONTEXT_PARSER("FORALL construct statement"_msg,
construct<ForallConstructStmt>{}(
maybe(name / ":"), "FORALL" >> indirect(concurrentHeader)))
construct<ForallAssignmentStmt>{}(pointerAssignmentStmt))
// R1054 end-forall-stmt -> END FORALL [forall-construct-name]
-TYPE_CONTEXT_PARSER("END FORALL statement",
+TYPE_CONTEXT_PARSER("END FORALL statement"_msg,
"END FORALL" >> construct<EndForallStmt>{}(maybe(name)))
// R1055 forall-stmt -> FORALL concurrent-header forall-assignment-stmt
-TYPE_CONTEXT_PARSER("FORALL statement",
+TYPE_CONTEXT_PARSER("FORALL statement"_msg,
"FORALL" >> construct<ForallStmt>{}(
indirect(concurrentHeader), forallAssignmentStmt))
constexpr auto block = many(executionPartConstruct);
// R1102 associate-construct -> associate-stmt block end-associate-stmt
-TYPE_CONTEXT_PARSER("ASSOCIATE construct",
+TYPE_CONTEXT_PARSER("ASSOCIATE construct"_msg,
construct<AssociateConstruct>{}(statement(Parser<AssociateStmt>{}), block,
statement(Parser<EndAssociateStmt>{})))
// R1103 associate-stmt ->
// [associate-construct-name :] ASSOCIATE ( association-list )
-TYPE_CONTEXT_PARSER("ASSOCIATE statement",
+TYPE_CONTEXT_PARSER("ASSOCIATE statement"_msg,
construct<AssociateStmt>{}(maybe(name / ":"),
"ASSOCIATE" >> parenthesized(nonemptyList(Parser<Association>{}))))
// R1107 block-construct ->
// block-stmt [block-specification-part] block end-block-stmt
-TYPE_CONTEXT_PARSER("BLOCK construct",
+TYPE_CONTEXT_PARSER("BLOCK construct"_msg,
construct<BlockConstruct>{}(statement(Parser<BlockStmt>{}),
Parser<BlockSpecificationPart>{}, // can be empty
block, statement(Parser<EndBlockStmt>{})))
TYPE_PARSER(construct<EndBlockStmt>{}("END BLOCK" >> maybe(name)))
// R1111 change-team-construct -> change-team-stmt block end-change-team-stmt
-TYPE_CONTEXT_PARSER("CHANGE TEAM construct",
+TYPE_CONTEXT_PARSER("CHANGE TEAM construct"_msg,
construct<ChangeTeamConstruct>{}(statement(Parser<ChangeTeamStmt>{}), block,
statement(Parser<EndChangeTeamStmt>{})))
// R1112 change-team-stmt ->
// [team-construct-name :] CHANGE TEAM
// ( team-variable [, coarray-association-list] [, sync-stat-list] )
-TYPE_CONTEXT_PARSER("CHANGE TEAM statement",
+TYPE_CONTEXT_PARSER("CHANGE TEAM statement"_msg,
construct<ChangeTeamStmt>{}(maybe(name / ":"),
"CHANGE TEAM (" >> teamVariable,
defaulted("," >> nonemptyList(Parser<CoarrayAssociation>{})),
// R1114 end-change-team-stmt ->
// END TEAM [( [sync-stat-list] )] [team-construct-name]
-TYPE_CONTEXT_PARSER("END CHANGE TEAM statement",
+TYPE_CONTEXT_PARSER("END CHANGE TEAM statement"_msg,
"END TEAM" >>
construct<EndChangeTeamStmt>{}(
defaulted(parenthesized(optionalList(statOrErrmsg))), maybe(name)))
// R1117 critical-stmt ->
// [critical-construct-name :] CRITICAL [( [sync-stat-list] )]
-TYPE_CONTEXT_PARSER("CRITICAL statement",
+TYPE_CONTEXT_PARSER("CRITICAL statement"_msg,
construct<CriticalStmt>{}(maybe(name / ":"),
"CRITICAL" >> defaulted(parenthesized(optionalList(statOrErrmsg)))))
// R1116 critical-construct -> critical-stmt block end-critical-stmt
-TYPE_CONTEXT_PARSER("CRITICAL construct",
+TYPE_CONTEXT_PARSER("CRITICAL construct"_msg,
construct<CriticalConstruct>{}(statement(Parser<CriticalStmt>{}), block,
statement(Parser<EndCriticalStmt>{})))
}
} leaveDoConstruct;
-TYPE_CONTEXT_PARSER("DO construct",
+TYPE_CONTEXT_PARSER("DO construct"_msg,
construct<DoConstruct>{}(
statement(Parser<NonLabelDoStmt>{}) / enterNonlabelDoConstruct, block,
statement(endDoStmt) / leaveDoConstruct))
// [,] WHILE ( scalar-logical-expr ) |
// [,] CONCURRENT concurrent-header concurrent-locality
// R1129 concurrent-locality -> [locality-spec]...
-TYPE_CONTEXT_PARSER("loop control",
+TYPE_CONTEXT_PARSER("loop control"_msg,
maybe(","_tok) >>
(construct<LoopControl>{}(loopBounds(scalarIntExpr)) ||
"WHILE" >>
concurrentHeader, many(Parser<LocalitySpec>{})))))
// R1121 label-do-stmt -> [do-construct-name :] DO label [loop-control]
-TYPE_CONTEXT_PARSER("label DO statement",
+TYPE_CONTEXT_PARSER("label DO statement"_msg,
construct<LabelDoStmt>{}(
maybe(name / ":"), "DO" >> label, maybe(loopControl)))
// R1122 nonlabel-do-stmt -> [do-construct-name :] DO [loop-control]
-TYPE_CONTEXT_PARSER("nonlabel DO statement",
+TYPE_CONTEXT_PARSER("nonlabel DO statement"_msg,
construct<NonLabelDoStmt>{}(maybe(name / ":"), "DO" >> maybe(loopControl)))
// R1132 end-do-stmt -> END DO [do-construct-name]
TYPE_CONTEXT_PARSER(
- "END DO statement", "END DO" >> construct<EndDoStmt>{}(maybe(name)))
+ "END DO statement"_msg, "END DO" >> construct<EndDoStmt>{}(maybe(name)))
// R1133 cycle-stmt -> CYCLE [do-construct-name]
TYPE_CONTEXT_PARSER(
- "CYCLE statement", "CYCLE" >> construct<CycleStmt>{}(maybe(name)))
+ "CYCLE statement"_msg, "CYCLE" >> construct<CycleStmt>{}(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 ->
+// 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",
+TYPE_CONTEXT_PARSER("IF construct"_msg,
construct<IfConstruct>{}(
statement(construct<IfThenStmt>{}(maybe(name / ":"),
"IF" >> parenthesized(scalarLogicalExpr) / "THEN")),
statement(construct<EndIfStmt>{}("END IF" >> maybe(name)))))
// R1139 if-stmt -> IF ( scalar-logical-expr ) action-stmt
-TYPE_CONTEXT_PARSER("IF statement",
+TYPE_CONTEXT_PARSER("IF statement"_msg,
"IF" >> construct<IfStmt>{}(parenthesized(scalarLogicalExpr), actionStmt))
// R1140 case-construct ->
// select-case-stmt [case-stmt block]... end-select-stmt
-TYPE_CONTEXT_PARSER("SELECT CASE construct",
+TYPE_CONTEXT_PARSER("SELECT CASE construct"_msg,
construct<CaseConstruct>{}(statement(Parser<SelectCaseStmt>{}),
many(construct<CaseConstruct::Case>{}(
statement(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",
+// R1141 select-case-stmt -> [case-construct-name :] SELECT CASE ( case-expr
+// ) R1144 case-expr -> scalar-expr
+TYPE_CONTEXT_PARSER("SELECT CASE statement"_msg,
construct<SelectCaseStmt>{}(
maybe(name / ":"), "SELECT CASE" >> parenthesized(scalar(expr))))
// R1142 case-stmt -> CASE case-selector [case-construct-name]
-TYPE_CONTEXT_PARSER("CASE statement",
+TYPE_CONTEXT_PARSER("CASE statement"_msg,
"CASE" >> construct<CaseStmt>{}(Parser<CaseSelector>{}, maybe(name)))
// R1143 end-select-stmt -> END SELECT [case-construct-name]
// R1148 select-rank-construct ->
// select-rank-stmt [select-rank-case-stmt block]...
// end-select-rank-stmt
-TYPE_CONTEXT_PARSER("SELECT RANK construct",
+TYPE_CONTEXT_PARSER("SELECT RANK construct"_msg,
construct<SelectRankConstruct>{}(statement(Parser<SelectRankStmt>{}),
many(construct<SelectRankConstruct::RankCase>{}(
statement(Parser<SelectRankCaseStmt>{}), block)),
// R1149 select-rank-stmt ->
// [select-construct-name :] SELECT RANK
// ( [associate-name =>] selector )
-TYPE_CONTEXT_PARSER("SELECT RANK statement",
+TYPE_CONTEXT_PARSER("SELECT RANK statement"_msg,
construct<SelectRankStmt>{}(maybe(name / ":"),
"SELECT RANK (" >> maybe(name / "=>"), selector / ")"))
// RANK ( scalar-int-constant-expr ) [select-construct-name] |
// RANK ( * ) [select-construct-name] |
// RANK DEFAULT [select-construct-name]
-TYPE_CONTEXT_PARSER("RANK case statement",
+TYPE_CONTEXT_PARSER("RANK case statement"_msg,
"RANK" >> (construct<SelectRankCaseStmt>{}(
parenthesized(construct<SelectRankCaseStmt::Rank>{}(
scalarIntConstantExpr) ||
// R1152 select-type-construct ->
// select-type-stmt [type-guard-stmt block]... end-select-type-stmt
-TYPE_CONTEXT_PARSER("SELECT TYPE construct",
+TYPE_CONTEXT_PARSER("SELECT TYPE construct"_msg,
construct<SelectTypeConstruct>{}(statement(Parser<SelectTypeStmt>{}),
many(construct<SelectTypeConstruct::TypeCase>{}(
statement(Parser<TypeGuardStmt>{}), block)),
// R1153 select-type-stmt ->
// [select-construct-name :] SELECT TYPE
// ( [associate-name =>] selector )
-TYPE_CONTEXT_PARSER("SELECT TYPE statement",
+TYPE_CONTEXT_PARSER("SELECT TYPE statement"_msg,
construct<SelectTypeStmt>{}(maybe(name / ":"),
"SELECT TYPE (" >> maybe(name / "=>"), selector / ")"))
// 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",
+TYPE_CONTEXT_PARSER("type guard statement"_msg,
construct<TypeGuardStmt>{}("TYPE IS" >>
parenthesized(construct<TypeGuardStmt::Guard>{}(typeSpec)) ||
"CLASS IS" >> parenthesized(construct<TypeGuardStmt::Guard>{}(
// R1156 exit-stmt -> EXIT [construct-name]
TYPE_CONTEXT_PARSER(
- "EXIT statement", "EXIT" >> construct<ExitStmt>{}(maybe(name)))
+ "EXIT statement"_msg, "EXIT" >> construct<ExitStmt>{}(maybe(name)))
// R1157 goto-stmt -> GO TO label
-TYPE_CONTEXT_PARSER("GOTO statement", "GO TO" >> construct<GotoStmt>{}(label))
+TYPE_CONTEXT_PARSER(
+ "GOTO statement"_msg, "GO TO" >> construct<GotoStmt>{}(label))
// R1158 computed-goto-stmt -> GO TO ( label-list ) [,] scalar-int-expr
-TYPE_CONTEXT_PARSER("computed GOTO statement",
+TYPE_CONTEXT_PARSER("computed GOTO statement"_msg,
"GO TO" >> construct<ComputedGotoStmt>{}(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",
+TYPE_CONTEXT_PARSER("STOP statement"_msg,
construct<StopStmt>{}("STOP" >> pure(StopStmt::Kind::Stop) ||
"ERROR STOP" >> pure(StopStmt::Kind::ErrorStop),
maybe(Parser<StopCode>{}), maybe(", QUIET =" >> scalarLogicalExpr)))
construct<StopCode>{}(scalarIntExpr))
// R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )]
-TYPE_CONTEXT_PARSER("SYNC ALL statement",
+TYPE_CONTEXT_PARSER("SYNC ALL statement"_msg,
"SYNC ALL" >> construct<SyncAllStmt>{}(
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",
+TYPE_CONTEXT_PARSER("SYNC IMAGES statement"_msg,
"SYNC IMAGES" >> 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",
+TYPE_CONTEXT_PARSER("SYNC MEMORY statement"_msg,
"SYNC MEMORY" >> construct<SyncMemoryStmt>{}(
defaulted(parenthesized(optionalList(statOrErrmsg)))))
// R1169 sync-team-stmt -> SYNC TEAM ( team-variable [, sync-stat-list] )
-TYPE_CONTEXT_PARSER("SYNC TEAM statement",
+TYPE_CONTEXT_PARSER("SYNC TEAM statement"_msg,
"SYNC TEAM" >> parenthesized(construct<SyncTeamStmt>{}(teamVariable,
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",
+TYPE_CONTEXT_PARSER("EVENT POST statement"_msg,
"EVENT POST" >> parenthesized(construct<EventPostStmt>{}(scalar(variable),
defaulted("," >> nonemptyList(statOrErrmsg)))))
// R1172 event-wait-stmt ->
// EVENT WAIT ( event-variable [, event-wait-spec-list] )
-TYPE_CONTEXT_PARSER("EVENT WAIT statement",
+TYPE_CONTEXT_PARSER("EVENT WAIT statement"_msg,
"EVENT WAIT" >>
parenthesized(construct<EventWaitStmt>{}(scalar(variable),
defaulted(
// 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",
+TYPE_CONTEXT_PARSER("FORM TEAM statement"_msg,
"FORM TEAM" >>
parenthesized(construct<FormTeamStmt>{}(scalarIntExpr,
"," >> teamVariable,
constexpr auto lockVariable = scalar(variable);
// R1178 lock-stmt -> LOCK ( lock-variable [, lock-stat-list] )
-TYPE_CONTEXT_PARSER("LOCK statement",
+TYPE_CONTEXT_PARSER("LOCK statement"_msg,
"LOCK" >>
parenthesized(construct<LockStmt>{}(lockVariable,
defaulted("," >> nonemptyList(Parser<LockStmt::LockStat>{})))))
construct<LockStmt::LockStat>{}(statOrErrmsg))
// R1180 unlock-stmt -> UNLOCK ( lock-variable [, sync-stat-list] )
-TYPE_CONTEXT_PARSER("UNLOCK statement",
+TYPE_CONTEXT_PARSER("UNLOCK statement"_msg,
"UNLOCK" >> parenthesized(construct<UnlockStmt>{}(lockVariable,
defaulted("," >> nonemptyList(statOrErrmsg)))))
TYPE_PARSER(construct<FileUnitNumber>{}(scalarIntExpr / !"="_tok))
// R1204 open-stmt -> OPEN ( connect-spec-list )
-TYPE_CONTEXT_PARSER("OPEN statement",
+TYPE_CONTEXT_PARSER("OPEN statement"_msg,
"OPEN" >> parenthesized(
construct<OpenStmt>{}(nonemptyList(Parser<ConnectSpec>{}))))
"STATUS =" >> construct<CloseStmt::CloseSpec>{}(statusExpr);
// R1208 close-stmt -> CLOSE ( close-spec-list )
-TYPE_CONTEXT_PARSER("CLOSE statement",
+TYPE_CONTEXT_PARSER("CLOSE statement"_msg,
"CLOSE" >> construct<CloseStmt>{}(parenthesized(nonemptyList(closeSpec))))
// R1210 read-stmt ->
extension(some("," >> inputItem)) || // legacy extension: leading comma
optionalList(inputItem);
-TYPE_CONTEXT_PARSER("READ statement",
+TYPE_CONTEXT_PARSER("READ statement"_msg,
"READ" >>
("(" >> construct<ReadStmt>{}(construct<std::optional<IoUnit>>{}(
maybe("UNIT ="_tok) >> ioUnit),
extension(some("," >> outputItem)) || // legacy: allow leading comma
optionalList(outputItem);
-TYPE_CONTEXT_PARSER("WRITE statement",
+TYPE_CONTEXT_PARSER("WRITE statement"_msg,
"WRITE" >>
(construct<WriteStmt>{}("(" >> construct<std::optional<IoUnit>>{}(
maybe("UNIT ="_tok) >> ioUnit),
parenthesized(nonemptyList(ioControlSpec)), outputItemList)))
// R1212 print-stmt PRINT format [, output-item-list]
-TYPE_CONTEXT_PARSER("PRINT statement",
+TYPE_CONTEXT_PARSER("PRINT statement"_msg,
"PRINT" >> construct<PrintStmt>{}(
format, defaulted("," >> nonemptyList(outputItem))))
// R1218 io-implied-do -> ( io-implied-do-object-list , io-implied-do-control )
// R1219 io-implied-do-object -> input-item | output-item
-TYPE_CONTEXT_PARSER("input implied DO",
+TYPE_CONTEXT_PARSER("input implied DO"_msg,
parenthesized(construct<InputImpliedDo>{}(
nonemptyList(inputItem / lookAhead(","_tok)),
"," >> ioImpliedDoControl)))
-TYPE_CONTEXT_PARSER("output implied DO",
+TYPE_CONTEXT_PARSER("output implied DO"_msg,
parenthesized(construct<OutputImpliedDo>{}(
nonemptyList(outputItem / lookAhead(","_tok)),
"," >> ioImpliedDoControl)))
// R1222 wait-stmt -> WAIT ( wait-spec-list )
-TYPE_CONTEXT_PARSER("WAIT statement",
+TYPE_CONTEXT_PARSER("WAIT statement"_msg,
"WAIT" >>
parenthesized(construct<WaitStmt>{}(nonemptyList(Parser<WaitSpec>{}))))
// R1224 backspace-stmt ->
// BACKSPACE file-unit-number | BACKSPACE ( position-spec-list )
-TYPE_CONTEXT_PARSER("BACKSPACE statement",
+TYPE_CONTEXT_PARSER("BACKSPACE statement"_msg,
"BACKSPACE" >> (construct<BackspaceStmt>{}(fileUnitNumber) ||
construct<BackspaceStmt>{}(
parenthesized(nonemptyList(positionOrFlushSpec)))))
// R1225 endfile-stmt ->
// ENDFILE file-unit-number | ENDFILE ( position-spec-list )
-TYPE_CONTEXT_PARSER("ENDFILE statement",
+TYPE_CONTEXT_PARSER("ENDFILE statement"_msg,
"ENDFILE" >> (construct<EndfileStmt>{}(fileUnitNumber) ||
construct<EndfileStmt>{}(
parenthesized(nonemptyList(positionOrFlushSpec)))))
// R1226 rewind-stmt -> REWIND file-unit-number | REWIND ( position-spec-list )
-TYPE_CONTEXT_PARSER("REWIND statement",
+TYPE_CONTEXT_PARSER("REWIND statement"_msg,
"REWIND" >> (construct<RewindStmt>{}(fileUnitNumber) ||
construct<RewindStmt>{}(
parenthesized(nonemptyList(positionOrFlushSpec)))))
"ERR =" >> construct<PositionOrFlushSpec>{}(errLabel))
// R1228 flush-stmt -> FLUSH file-unit-number | FLUSH ( flush-spec-list )
-TYPE_CONTEXT_PARSER("FLUSH statement",
+TYPE_CONTEXT_PARSER("FLUSH statement"_msg,
"FLUSH" >> (construct<FlushStmt>{}(fileUnitNumber) ||
construct<FlushStmt>{}(
parenthesized(nonemptyList(positionOrFlushSpec)))))
// R1230 inquire-stmt ->
// INQUIRE ( inquire-spec-list ) |
// INQUIRE ( IOLENGTH = scalar-int-variable ) output-item-list
-TYPE_CONTEXT_PARSER("INQUIRE statement",
+TYPE_CONTEXT_PARSER("INQUIRE statement"_msg,
"INQUIRE" >>
(construct<InquireStmt>{}(
parenthesized(nonemptyList(Parser<InquireSpec>{}))) ||
// [program-stmt] [specification-part] [execution-part]
// [internal-subprogram-part] end-program-stmt
// R1402 program-stmt -> PROGRAM program-name
-TYPE_CONTEXT_PARSER("main program",
+TYPE_CONTEXT_PARSER("main program"_msg,
construct<MainProgram>{}(maybe(statement("PROGRAM" >> name)),
specificationPart, executionPart, maybe(internalSubprogramPart),
unterminatedStatement(endProgramStmt)))
// R1403 end-program-stmt -> END [PROGRAM [program-name]]
-TYPE_CONTEXT_PARSER("END PROGRAM statement",
+TYPE_CONTEXT_PARSER("END PROGRAM statement"_msg,
"END" >> construct<EndProgramStmt>{}(defaulted("PROGRAM" >> maybe(name))))
// R1404 module ->
// module-stmt [specification-part] [module-subprogram-part]
// end-module-stmt
-TYPE_CONTEXT_PARSER("module",
+TYPE_CONTEXT_PARSER("module"_msg,
construct<Module>{}(statement(Parser<ModuleStmt>{}), specificationPart,
maybe(Parser<ModuleSubprogramPart>{}),
unterminatedStatement(Parser<EndModuleStmt>{})))
// R1405 module-stmt -> MODULE module-name
TYPE_CONTEXT_PARSER(
- "MODULE statement", "MODULE" >> construct<ModuleStmt>{}(name))
+ "MODULE statement"_msg, "MODULE" >> construct<ModuleStmt>{}(name))
// R1406 end-module-stmt -> END [MODULE [module-name]]
-TYPE_CONTEXT_PARSER("END MODULE statement",
+TYPE_CONTEXT_PARSER("END MODULE statement"_msg,
"END" >> construct<EndModuleStmt>{}(defaulted("MODULE" >> maybe(name))))
// R1407 module-subprogram-part -> contains-stmt [module-subprogram]...
-TYPE_CONTEXT_PARSER("module subprogram part",
+TYPE_CONTEXT_PARSER("module subprogram part"_msg,
construct<ModuleSubprogramPart>{}(statement(containsStmt),
many(startNewSubprogram >> Parser<ModuleSubprogram>{})))
// R1416 submodule ->
// submodule-stmt [specification-part] [module-subprogram-part]
// end-submodule-stmt
-TYPE_CONTEXT_PARSER("submodule",
+TYPE_CONTEXT_PARSER("submodule"_msg,
construct<Submodule>{}(statement(Parser<SubmoduleStmt>{}),
specificationPart, maybe(Parser<ModuleSubprogramPart>{}),
statement(Parser<EndSubmoduleStmt>{})))
// R1417 submodule-stmt -> SUBMODULE ( parent-identifier ) submodule-name
-TYPE_CONTEXT_PARSER("SUBMODULE statement",
+TYPE_CONTEXT_PARSER("SUBMODULE statement"_msg,
"SUBMODULE" >> construct<SubmoduleStmt>{}(
parenthesized(Parser<ParentIdentifier>{}), name))
TYPE_PARSER(construct<ParentIdentifier>{}(name, maybe(":" >> name)))
// R1419 end-submodule-stmt -> END [SUBMODULE [submodule-name]]
-TYPE_CONTEXT_PARSER("END SUBMODULE statement",
+TYPE_CONTEXT_PARSER("END SUBMODULE statement"_msg,
"END" >>
construct<EndSubmoduleStmt>{}(defaulted("SUBMODULE" >> maybe(name))))
// R1420 block-data -> block-data-stmt [specification-part] end-block-data-stmt
-TYPE_CONTEXT_PARSER("BLOCK DATA subprogram",
+TYPE_CONTEXT_PARSER("BLOCK DATA subprogram"_msg,
construct<BlockData>{}(statement(Parser<BlockDataStmt>{}),
specificationPart, unterminatedStatement(Parser<EndBlockDataStmt>{})))
// R1421 block-data-stmt -> BLOCK DATA [block-data-name]
-TYPE_CONTEXT_PARSER("BLOCK DATA statement",
+TYPE_CONTEXT_PARSER("BLOCK DATA statement"_msg,
"BLOCK DATA" >> construct<BlockDataStmt>{}(maybe(name)))
// R1422 end-block-data-stmt -> END [BLOCK DATA [block-data-name]]
-TYPE_CONTEXT_PARSER("END BLOCK DATA statement",
+TYPE_CONTEXT_PARSER("END BLOCK DATA statement"_msg,
"END" >>
construct<EndBlockDataStmt>{}(defaulted("BLOCK DATA" >> maybe(name))))
// R1505 interface-body ->
// function-stmt [specification-part] end-function-stmt |
// subroutine-stmt [specification-part] end-subroutine-stmt
-TYPE_CONTEXT_PARSER("interface body",
+TYPE_CONTEXT_PARSER("interface body"_msg,
construct<InterfaceBody>{}(
construct<InterfaceBody::Function>{}(statement(functionStmt),
indirect(specificationPart), statement(endFunctionStmt))) ||
template<>
std::optional<FunctionReference> Parser<FunctionReference>::Parse(
ParseState *state) {
- state->PushContext("function reference");
+ state->PushContext("function reference"_msg);
std::optional<Variable> var{variable.Parse(state)};
if (var.has_value()) {
if (auto funcref = std::get_if<Indirection<FunctionReference>>(&var->u)) {
return {FunctionReference{std::move(call.value())}};
}
}
- state->PutMessage("expected (arguments)");
+ state->PutMessage("expected (arguments)"_msg);
}
state->PopContext();
return {};
// R1521 call-stmt -> CALL procedure-designator [( [actual-arg-spec-list] )]
template<> std::optional<CallStmt> Parser<CallStmt>::Parse(ParseState *state) {
static constexpr auto parser =
- inContext("CALL statement", "CALL" >> variable);
+ inContext("CALL statement"_msg, "CALL" >> variable);
std::optional<Variable> var{parser.Parse(state)};
if (var.has_value()) {
if (auto funcref = std::get_if<Indirection<FunctionReference>>(&var->u)) {
// R1529 function-subprogram ->
// function-stmt [specification-part] [execution-part]
// [internal-subprogram-part] end-function-stmt
-TYPE_CONTEXT_PARSER("FUNCTION subprogram",
+TYPE_CONTEXT_PARSER("FUNCTION subprogram"_msg,
construct<FunctionSubprogram>{}(statement(functionStmt), specificationPart,
executionPart, maybe(internalSubprogramPart),
unterminatedStatement(endFunctionStmt)))
// [prefix] FUNCTION function-name ( [dummy-arg-name-list] ) [suffix]
// R1526 prefix -> prefix-spec [prefix-spec]...
// R1531 dummy-arg-name -> name
-TYPE_CONTEXT_PARSER("FUNCTION statement",
+TYPE_CONTEXT_PARSER("FUNCTION statement"_msg,
construct<FunctionStmt>{}(many(prefixSpec), "FUNCTION" >> name,
parenthesized(optionalList(name)), maybe(suffix)) ||
extension(construct<FunctionStmt>{}( // PGI & Intel accept "FUNCTION F"
// R1534 subroutine-subprogram ->
// subroutine-stmt [specification-part] [execution-part]
// [internal-subprogram-part] end-subroutine-stmt
-TYPE_CONTEXT_PARSER("SUBROUTINE subprogram",
+TYPE_CONTEXT_PARSER("SUBROUTINE subprogram"_msg,
construct<SubroutineSubprogram>{}(statement(subroutineStmt),
specificationPart, executionPart, maybe(internalSubprogramPart),
unterminatedStatement(endSubroutineStmt)))
// R1538 separate-module-subprogram ->
// mp-subprogram-stmt [specification-part] [execution-part]
// [internal-subprogram-part] end-mp-subprogram-stmt
-TYPE_CONTEXT_PARSER("separate module subprogram",
+TYPE_CONTEXT_PARSER("separate module subprogram"_msg,
construct<SeparateModuleSubprogram>{}(statement(Parser<MpSubprogramStmt>{}),
specificationPart, executionPart, maybe(internalSubprogramPart),
statement(Parser<EndMpSubprogramStmt>{})))
// R1539 mp-subprogram-stmt -> MODULE PROCEDURE procedure-name
-TYPE_CONTEXT_PARSER("MODULE PROCEDURE statement",
+TYPE_CONTEXT_PARSER("MODULE PROCEDURE statement"_msg,
construct<MpSubprogramStmt>{}("MODULE PROCEDURE" >> name))
// R1540 end-mp-subprogram-stmt -> END [PROCEDURE [procedure-name]]
-TYPE_CONTEXT_PARSER("END PROCEDURE statement",
+TYPE_CONTEXT_PARSER("END PROCEDURE statement"_msg,
"END" >>
construct<EndMpSubprogramStmt>{}(defaulted("PROCEDURE" >> maybe(name))))
construct<std::optional<Suffix>>{})))
// R1542 return-stmt -> RETURN [scalar-int-expr]
-TYPE_CONTEXT_PARSER("RETURN statement",
+TYPE_CONTEXT_PARSER("RETURN statement"_msg,
"RETURN" >> construct<ReturnStmt>{}(maybe(scalarIntExpr)))
// R1543 contains-stmt -> CONTAINS
construct<StructureField>{}(indirect(Parser<Union>{})) ||
construct<StructureField>{}(indirect(Parser<StructureDef>{})))
-TYPE_CONTEXT_PARSER("STRUCTURE definition",
+TYPE_CONTEXT_PARSER("STRUCTURE definition"_msg,
extension(construct<StructureDef>{}(statement(Parser<StructureStmt>{}),
many(Parser<StructureField>{}),
statement(
"END STRUCTURE" >> construct<StructureDef::EndStructureStmt>{}))))
-TYPE_CONTEXT_PARSER("UNION definition",
+TYPE_CONTEXT_PARSER("UNION definition"_msg,
construct<Union>{}(statement("UNION" >> construct<Union::UnionStmt>{}),
many(Parser<Map>{}),
statement("END UNION" >> construct<Union::EndUnionStmt>{})))
-TYPE_CONTEXT_PARSER("MAP definition",
+TYPE_CONTEXT_PARSER("MAP definition"_msg,
construct<Map>{}(statement("MAP" >> construct<Map::MapStmt>{}),
many(Parser<StructureField>{}),
statement("END MAP" >> construct<Map::EndMapStmt>{})))
-TYPE_CONTEXT_PARSER("arithmetic IF statement",
+TYPE_CONTEXT_PARSER("arithmetic IF statement"_msg,
deprecated("IF" >> construct<ArithmeticIfStmt>{}(parenthesized(expr),
label / ",", label / ",", label)))
-TYPE_CONTEXT_PARSER("ASSIGN statement",
+TYPE_CONTEXT_PARSER("ASSIGN statement"_msg,
deprecated("ASSIGN" >> construct<AssignStmt>{}(label, "TO" >> name)))
-TYPE_CONTEXT_PARSER("assigned GOTO statement",
+TYPE_CONTEXT_PARSER("assigned GOTO statement"_msg,
deprecated("GO TO" >>
construct<AssignedGotoStmt>{}(name,
defaulted(maybe(","_tok) >> parenthesized(nonemptyList(label))))))
-TYPE_CONTEXT_PARSER("PAUSE statement",
+TYPE_CONTEXT_PARSER("PAUSE statement"_msg,
deprecated("PAUSE" >> construct<PauseStmt>{}(maybe(Parser<StopCode>{}))))
// These requirement productions are defined by the Fortran standard but never
+#include "message.h"
#include "preprocessor.h"
#include "idioms.h"
#include "prescan.h"
return true;
}
if (dir[j].ToString() != "#") {
- prescanner->Complain("missing '#'");
+ prescanner->Complain("missing '#'"_msg);
return false;
}
j = SkipBlanks(dir, j + 1, tokens);
}
if (dirName == "define") {
if (nameToken.empty()) {
- prescanner->Complain("#define: missing or invalid name");
+ prescanner->Complain("#define: missing or invalid name"_msg);
return false;
}
nameToken = SaveTokenAsName(nameToken);
isVariadic = true;
} else {
if (an.empty() || !IsIdentifierFirstCharacter(an[0])) {
- prescanner->Complain("#define: missing or invalid argument name");
+ prescanner->Complain("#define: missing or invalid argument name"_msg);
return false;
}
argName.push_back(an);
}
j = SkipBlanks(dir, j + 1, tokens);
if (j == tokens) {
- prescanner->Complain("#define: malformed argument list");
+ prescanner->Complain("#define: malformed argument list"_msg);
return false;
}
std::string punc{dir[j].ToString()};
break;
}
if (punc != ",") {
- prescanner->Complain("#define: malformed argument list");
+ prescanner->Complain("#define: malformed argument list"_msg);
return false;
}
j = SkipBlanks(dir, j + 1, tokens);
if (j == tokens || isVariadic) {
- prescanner->Complain("#define: malformed argument list");
+ prescanner->Complain("#define: malformed argument list"_msg);
return false;
}
}
if (std::set<std::string>(argName.begin(), argName.end()).size() !=
argName.size()) {
- prescanner->Complain("#define: argument names are not distinct");
+ prescanner->Complain("#define: argument names are not distinct"_msg);
return false;
}
}
}
if (dirName == "undef") {
if (nameToken.empty()) {
- prescanner->Complain("# missing or invalid name");
+ prescanner->Complain("# missing or invalid name"_msg);
return false;
}
j = SkipBlanks(dir, j + 1, tokens);
if (j != tokens) {
- prescanner->Complain("#undef: excess tokens at end of directive");
+ prescanner->Complain("#undef: excess tokens at end of directive"_msg);
return false;
}
definitions_.erase(nameToken);
}
if (dirName == "ifdef" || dirName == "ifndef") {
if (nameToken.empty()) {
- prescanner->Complain("#"s + dirName + ": missing name");
+ prescanner->Complain("#"_msg) += dirName + ": missing name";
return false;
}
j = SkipBlanks(dir, j + 1, tokens);
if (j != tokens) {
- prescanner->Complain(
- "#"s + dirName + ": excess tokens at end of directive");
+ prescanner->Complain("#"_msg) += dirName + ": excess tokens at end of directive";
return false;
}
if (IsNameDefined(nameToken) == (dirName == "ifdef")) {
}
if (dirName == "else") {
if (j != tokens) {
- prescanner->Complain("#else: excess tokens at end of directive");
+ prescanner->Complain("#else: excess tokens at end of directive"_msg);
return false;
}
if (ifStack_.empty()) {
- prescanner->Complain("#else: not nested within #if, #ifdef, or #ifndef");
+ prescanner->Complain("#else: not nested within #if, #ifdef, or #ifndef"_msg);
return false;
}
if (ifStack_.top() != CanDeadElseAppear::Yes) {
prescanner->Complain(
- "#else: already appeared within this #if, #ifdef, or #ifndef");
+ "#else: already appeared within this #if, #ifdef, or #ifndef"_msg);
return false;
}
ifStack_.pop();
}
if (dirName == "elif") {
if (ifStack_.empty()) {
- prescanner->Complain("#elif: not nested within #if, #ifdef, or #ifndef");
+ prescanner->Complain("#elif: not nested within #if, #ifdef, or #ifndef"_msg);
return false;
}
if (ifStack_.top() != CanDeadElseAppear::Yes) {
prescanner->Complain("#elif: #else previously appeared within this "
- "#if, #ifdef, or #ifndef");
+ "#if, #ifdef, or #ifndef"_msg);
return false;
}
ifStack_.pop();
}
if (dirName == "endif") {
if (j != tokens) {
- prescanner->Complain("#endif: excess tokens at end of directive");
+ prescanner->Complain("#endif: excess tokens at end of directive"_msg);
return false;
}
if (ifStack_.empty()) {
- prescanner->Complain("#endif: no #if, #ifdef, or #ifndef");
+ prescanner->Complain("#endif: no #if, #ifdef, or #ifndef"_msg);
return false;
}
ifStack_.pop();
return true;
}
- if (dirName == "error" || dirName == "warning") {
- prescanner->Complain(dir.ToString());
- return dirName != "error";
+ if (dirName == "error") {
+ prescanner->Complain("#error: "_msg) += dir.ToString();
+ return false;
+ }
+ if (dirName == "warning") {
+ prescanner->Complain("#warning: "_msg) += dir.ToString();
+ return true;
}
if (dirName == "include") {
if (j == tokens) {
- prescanner->Complain("#include: missing name of file to include");
+ prescanner->Complain("#include: missing name of file to include"_msg);
return false;
}
std::string include;
if (dir[j].ToString() == "<") {
if (dir[tokens - 1].ToString() != ">") {
- prescanner->Complain("#include: expected '>' at end of directive");
+ prescanner->Complain("#include: expected '>' at end of directive"_msg);
return false;
}
TokenSequence braced{dir, j + 1, tokens - j - 2};
include.substr(include.size() - 1, 1) == "\"") {
include = include.substr(1, include.size() - 2);
} else {
- prescanner->Complain("#include: expected name of file to include");
+ prescanner->Complain("#include: expected name of file to include"_msg);
return false;
}
if (include.empty()) {
- prescanner->Complain("#include: empty include file name");
+ prescanner->Complain("#include: empty include file name"_msg);
return false;
}
std::stringstream error;
const SourceFile *included{allSources_->Open(include, &error)};
if (included == nullptr) {
- prescanner->Complain(error.str());
+ prescanner->Complain("#include: "_msg) += error.str();
return false;
}
ProvenanceRange fileRange{
allSources_->AddIncludedFile(*included, dir.GetProvenanceRange())};
return Prescanner{*prescanner}.Prescan(fileRange);
}
- prescanner->Complain("#"s + dirName + ": unknown or unimplemented directive");
+ prescanner->Complain("#"_msg) += dirName + ": unknown or unimplemented directive";
return false;
}
}
}
}
- prescanner->Complain("#"s + dirName + ": missing #endif");
+ prescanner->Complain("#"_msg) += dirName + ": missing #endif";
return false;
}
// 1: ? :
// 0: ,
static std::int64_t ExpressionValue(const TokenSequence &token,
- int minimumPrecedence, size_t *atToken, std::string *errors) {
+ int minimumPrecedence, size_t *atToken, MessageText *error) {
enum Operator {
PARENS,
CONST,
size_t tokens{token.size()};
if (*atToken >= tokens) {
- *errors = "incomplete expression";
+ *error = "incomplete expression"_msg;
return 0;
}
std::string t{token[*atToken].ToString()};
size_t consumed{0};
left = std::stoll(t, &consumed);
if (consumed < t.size()) {
- *errors = "uninterpretable numeric constant '"s + t + '\'';
+ *error = "uninterpretable numeric constant '"_msg;
}
} else if (IsIdentifierFirstCharacter(t[0])) {
// undefined macro name -> zero
if (it != opNameMap.end()) {
op = it->second;
} else {
- *errors = "operand expected in expression";
+ *error = "operand expected in expression"_msg;
return 0;
}
}
- if (precedence[op] < minimumPrecedence && errors->empty()) {
- *errors = "operator precedence error";
+ if (precedence[op] < minimumPrecedence && error->empty()) {
+ *error = "operator precedence error"_msg;
}
++*atToken;
- if (op != CONST && errors->empty()) {
- left = ExpressionValue(token, operandPrecedence[op], atToken, errors);
+ if (op != CONST && error->empty()) {
+ left = ExpressionValue(token, operandPrecedence[op], atToken, error);
switch (op) {
case PARENS:
if (*atToken < tokens && token[*atToken].ToString() == ")") {
++*atToken;
- } else if (errors->empty()) {
- *errors = "')' missing from expression";
+ } else if (error->empty()) {
+ *error = "')' missing from expression"_msg;
}
break;
case NOTZERO: left = !left; break;
default: CRASH_NO_CASE;
}
}
- if (!errors->empty() || *atToken >= tokens) {
+ if (!error->empty() || *atToken >= tokens) {
return left;
}
}
*atToken += advance;
std::int64_t right{
- ExpressionValue(token, operandPrecedence[op], atToken, errors)};
+ ExpressionValue(token, operandPrecedence[op], atToken, error)};
switch (op) {
case POWER:
if (left == 0 && right < 0) {
- *errors = "0 ** negative power";
+ *error = "0 ** negative power"_msg;
}
if (left == 0 || left == 1 || right == 1) {
return left;
std::int64_t power{1};
for (; right > 0; --right) {
if ((power * left) / left != power) {
- *errors = "overflow in exponentation";
+ *error = "overflow in exponentation"_msg;
return 0;
}
power *= left;
return 0;
}
if ((left * right) / left != right) {
- *errors = "overflow in multiplication";
+ *error = "overflow in multiplication"_msg;
}
return left * right;
case DIVIDE:
if (right == 0) {
- *errors = "division by zero";
+ *error = "division by zero"_msg;
return 0;
}
return left / right;
case MODULUS:
if (right == 0) {
- *errors = "modulus by zero";
+ *error = "modulus by zero"_msg;
return 0;
}
return left % right;
case ADD:
if ((left < 0) == (right < 0) && (left < 0) != (left + right < 0)) {
- *errors = "overflow in addition";
+ *error = "overflow in addition"_msg;
}
return left + right;
case SUBTRACT:
if ((left < 0) != (right < 0) && (left < 0) == (left - right < 0)) {
- *errors = "overflow in subtraction";
+ *error = "overflow in subtraction"_msg;
}
return left - right;
case LEFTSHIFT:
if (right < 0 || right > 64) {
- *errors = "bad left shift count";
+ *error = "bad left shift count"_msg;
}
return right >= 64 ? 0 : left << right;
case RIGHTSHIFT:
if (right < 0 || right > 64) {
- *errors = "bad right shift count";
+ *error = "bad right shift count"_msg;
}
return right >= 64 ? 0 : left >> right;
case BITAND:
case NEQV: return -(!left != !right);
case SELECT:
if (*atToken >= tokens || token[*atToken].ToString() != ":") {
- *errors = "':' required in selection expression";
+ *error = "':' required in selection expression"_msg;
return left;
} else {
++*atToken;
std::int64_t third{
- ExpressionValue(token, operandPrecedence[op], atToken, errors)};
+ ExpressionValue(token, operandPrecedence[op], atToken, error)};
return left != 0 ? right : third;
}
case COMMA: return right;
TokenSequence expr3{ReplaceMacros(expr2, *prescanner)};
TokenSequence expr4{StripBlanks(expr3, 0, expr3.size())};
size_t atToken{0};
- std::string error;
+ MessageText error;
bool result{ExpressionValue(expr4, 0, &atToken, &error) != 0};
if (!error.empty()) {
prescanner->Complain(error);
} else if (atToken < expr4.size()) {
- prescanner->Complain(atToken == 0 ? "could not parse any expression"
- : "excess characters after expression");
+ prescanner->Complain(atToken == 0 ? "could not parse any expression"_msg
+ : "excess characters after expression"_msg);
}
return result;
}