1457 lines · cpp
1//===-- lib/Parser/Fortran-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-exception6//7//===----------------------------------------------------------------------===//8 9// Top-level grammar specification for Fortran. These parsers drive10// the tokenization parsers in cooked-tokens.h to consume characters,11// recognize the productions of Fortran, and to construct a parse tree.12// See ParserCombinators.md for documentation on the parser combinator13// library used here to implement an LL recursive descent recognizer.14 15// The productions that follow are derived from the draft Fortran 201816// standard, with some necessary modifications to remove left recursion17// and some generalization in order to defer cases where parses depend18// on the definitions of symbols. The "Rxxx" numbers that appear in19// comments refer to these numbered requirements in the Fortran standard.20 21// The whole Fortran grammar originally constituted one header file,22// but that turned out to require more memory to compile with current23// C++ compilers than some people were willing to accept, so now the24// various per-type parsers are partitioned into several C++ source25// files. This file contains parsers for constants, types, declarations,26// and misfits (mostly clauses 7, 8, & 9 of Fortran 2018). The others:27// executable-parsers.cpp Executable statements28// expr-parsers.cpp Expressions29// io-parsers.cpp I/O statements and FORMAT30// openmp-parsers.cpp OpenMP directives31// program-parsers.cpp Program units32 33#include "basic-parsers.h"34#include "expr-parsers.h"35#include "misc-parsers.h"36#include "stmt-parser.h"37#include "token-parsers.h"38#include "type-parser-implementation.h"39#include "flang/Parser/parse-tree.h"40#include "flang/Parser/user-state.h"41 42namespace Fortran::parser {43 44// R601 alphanumeric-character -> letter | digit | underscore45// R603 name -> letter [alphanumeric-character]...46constexpr auto nonDigitIdChar{letter || otherIdChar};47constexpr auto rawName{nonDigitIdChar >> many(nonDigitIdChar || digit)};48TYPE_PARSER(space >> sourced(rawName >> construct<Name>()))49 50// R608 intrinsic-operator ->51// power-op | mult-op | add-op | concat-op | rel-op |52// not-op | and-op | or-op | equiv-op53// R610 extended-intrinsic-op -> intrinsic-operator54// These parsers must be ordered carefully to avoid misrecognition.55constexpr auto namedIntrinsicOperator{56 ".LT." >> pure(DefinedOperator::IntrinsicOperator::LT) ||57 ".LE." >> pure(DefinedOperator::IntrinsicOperator::LE) ||58 ".EQ." >> pure(DefinedOperator::IntrinsicOperator::EQ) ||59 ".NE." >> pure(DefinedOperator::IntrinsicOperator::NE) ||60 ".GE." >> pure(DefinedOperator::IntrinsicOperator::GE) ||61 ".GT." >> pure(DefinedOperator::IntrinsicOperator::GT) ||62 ".NOT." >> pure(DefinedOperator::IntrinsicOperator::NOT) ||63 ".AND." >> pure(DefinedOperator::IntrinsicOperator::AND) ||64 ".OR." >> pure(DefinedOperator::IntrinsicOperator::OR) ||65 ".EQV." >> pure(DefinedOperator::IntrinsicOperator::EQV) ||66 ".NEQV." >> pure(DefinedOperator::IntrinsicOperator::NEQV) ||67 extension<LanguageFeature::XOROperator>(68 "nonstandard usage: .XOR. spelling of .NEQV."_port_en_US,69 ".XOR." >> pure(DefinedOperator::IntrinsicOperator::NEQV)) ||70 extension<LanguageFeature::LogicalAbbreviations>(71 "nonstandard usage: abbreviated logical operator"_port_en_US,72 ".N." >> pure(DefinedOperator::IntrinsicOperator::NOT) ||73 ".A." >> pure(DefinedOperator::IntrinsicOperator::AND) ||74 ".O." >> pure(DefinedOperator::IntrinsicOperator::OR) ||75 extension<LanguageFeature::XOROperator>(76 "nonstandard usage: .X. spelling of .NEQV."_port_en_US,77 ".X." >> pure(DefinedOperator::IntrinsicOperator::NEQV)))};78 79constexpr auto intrinsicOperator{80 "**" >> pure(DefinedOperator::IntrinsicOperator::Power) ||81 "*" >> pure(DefinedOperator::IntrinsicOperator::Multiply) ||82 "//" >> pure(DefinedOperator::IntrinsicOperator::Concat) ||83 "/=" >> pure(DefinedOperator::IntrinsicOperator::NE) ||84 "/" >> pure(DefinedOperator::IntrinsicOperator::Divide) ||85 "+" >> pure(DefinedOperator::IntrinsicOperator::Add) ||86 "-" >> pure(DefinedOperator::IntrinsicOperator::Subtract) ||87 "<=" >> pure(DefinedOperator::IntrinsicOperator::LE) ||88 extension<LanguageFeature::AlternativeNE>(89 "nonstandard usage: <> spelling of /= or .NE."_port_en_US,90 "<>" >> pure(DefinedOperator::IntrinsicOperator::NE)) ||91 "<" >> pure(DefinedOperator::IntrinsicOperator::LT) ||92 "==" >> pure(DefinedOperator::IntrinsicOperator::EQ) ||93 ">=" >> pure(DefinedOperator::IntrinsicOperator::GE) ||94 ">" >> pure(DefinedOperator::IntrinsicOperator::GT) ||95 namedIntrinsicOperator};96 97// R609 defined-operator ->98// defined-unary-op | defined-binary-op | extended-intrinsic-op99TYPE_PARSER(construct<DefinedOperator>(intrinsicOperator) ||100 construct<DefinedOperator>(definedOpName))101 102// R505 implicit-part -> [implicit-part-stmt]... implicit-stmt103// N.B. PARAMETER, FORMAT, & ENTRY statements that appear before any104// other kind of declaration-construct will be parsed into the105// implicit-part.106TYPE_CONTEXT_PARSER("implicit part"_en_US,107 construct<ImplicitPart>(many(Parser<ImplicitPartStmt>{})))108 109// R506 implicit-part-stmt ->110// implicit-stmt | parameter-stmt | format-stmt | entry-stmt111TYPE_PARSER(first(112 construct<ImplicitPartStmt>(statement(indirect(Parser<ImplicitStmt>{}))),113 construct<ImplicitPartStmt>(statement(indirect(parameterStmt))),114 construct<ImplicitPartStmt>(statement(indirect(oldParameterStmt))),115 construct<ImplicitPartStmt>(statement(indirect(formatStmt))),116 construct<ImplicitPartStmt>(statement(indirect(entryStmt))),117 construct<ImplicitPartStmt>(indirect(compilerDirective)),118 construct<ImplicitPartStmt>(indirect(openaccDeclarativeConstruct))))119 120// R512 internal-subprogram -> function-subprogram | subroutine-subprogram121// Internal subprograms are not program units, so their END statements122// can be followed by ';' and another statement on the same line.123TYPE_CONTEXT_PARSER("internal subprogram"_en_US,124 (construct<InternalSubprogram>(indirect(functionSubprogram)) ||125 construct<InternalSubprogram>(indirect(subroutineSubprogram))) /126 forceEndOfStmt ||127 construct<InternalSubprogram>(indirect(compilerDirective)))128 129// R511 internal-subprogram-part -> contains-stmt [internal-subprogram]...130TYPE_CONTEXT_PARSER("internal subprogram part"_en_US,131 construct<InternalSubprogramPart>(statement(containsStmt),132 many(StartNewSubprogram{} >> Parser<InternalSubprogram>{})))133 134// R605 literal-constant ->135// int-literal-constant | real-literal-constant |136// complex-literal-constant | logical-literal-constant |137// char-literal-constant | boz-literal-constant |138// unsigned-literal-constant139TYPE_PARSER(140 first(construct<LiteralConstant>(Parser<HollerithLiteralConstant>{}),141 construct<LiteralConstant>(realLiteralConstant),142 construct<LiteralConstant>(intLiteralConstant),143 construct<LiteralConstant>(Parser<ComplexLiteralConstant>{}),144 construct<LiteralConstant>(Parser<BOZLiteralConstant>{}),145 construct<LiteralConstant>(charLiteralConstant),146 construct<LiteralConstant>(Parser<LogicalLiteralConstant>{}),147 construct<LiteralConstant>(unsignedLiteralConstant)))148 149// R606 named-constant -> name150TYPE_PARSER(construct<NamedConstant>(name))151 152// R701 type-param-value -> scalar-int-expr | * | :153TYPE_PARSER(construct<TypeParamValue>(scalarIntExpr) ||154 construct<TypeParamValue>(star) ||155 construct<TypeParamValue>(construct<TypeParamValue::Deferred>(":"_tok)))156 157// R702 type-spec -> intrinsic-type-spec | derived-type-spec158// N.B. This type-spec production is one of two instances in the Fortran159// grammar where intrinsic types and bare derived type names can clash;160// the other is below in R703 declaration-type-spec. Look-ahead is required161// to disambiguate the cases where a derived type name begins with the name162// of an intrinsic type, e.g., REALITY.163TYPE_CONTEXT_PARSER("type spec"_en_US,164 construct<TypeSpec>(intrinsicTypeSpec / lookAhead("::"_tok || ")"_tok)) ||165 construct<TypeSpec>(derivedTypeSpec))166 167// R703 declaration-type-spec ->168// intrinsic-type-spec | TYPE ( intrinsic-type-spec ) |169// TYPE ( derived-type-spec ) | CLASS ( derived-type-spec ) |170// CLASS ( * ) | TYPE ( * )171// N.B. It is critical to distribute "parenthesized()" over the alternatives172// for TYPE (...), rather than putting the alternatives within it, which173// would fail on "TYPE(real_derived)" with a misrecognition of "real" as an174// intrinsic-type-spec.175// N.B. TYPE(x) is a derived type if x is a one-word extension intrinsic176// type (BYTE or DOUBLECOMPLEX), not the extension intrinsic type.177TYPE_CONTEXT_PARSER("declaration type spec"_en_US,178 construct<DeclarationTypeSpec>(intrinsicTypeSpec) ||179 "TYPE" >>180 (parenthesized(construct<DeclarationTypeSpec>(181 !"DOUBLECOMPLEX"_tok >> !"BYTE"_tok >> intrinsicTypeSpec)) ||182 parenthesized(construct<DeclarationTypeSpec>(183 construct<DeclarationTypeSpec::Type>(derivedTypeSpec))) ||184 construct<DeclarationTypeSpec>(185 "( * )" >> construct<DeclarationTypeSpec::TypeStar>())) ||186 "CLASS" >> parenthesized(construct<DeclarationTypeSpec>(187 construct<DeclarationTypeSpec::Class>(188 derivedTypeSpec)) ||189 construct<DeclarationTypeSpec>("*" >>190 construct<DeclarationTypeSpec::ClassStar>())) ||191 extension<LanguageFeature::DECStructures>(192 "nonstandard usage: STRUCTURE"_port_en_US,193 construct<DeclarationTypeSpec>(194 // As is also done for the STRUCTURE statement, the name of195 // the structure includes the surrounding slashes to avoid196 // name clashes.197 construct<DeclarationTypeSpec::Record>(198 "RECORD" >> sourced("/" >> name / "/")))) ||199 construct<DeclarationTypeSpec>(vectorTypeSpec))200 201// R704 intrinsic-type-spec ->202// integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |203// COMPLEX [kind-selector] | CHARACTER [char-selector] |204// LOGICAL [kind-selector]205// Extensions: DOUBLE COMPLEX, BYTE206TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,207 first(construct<IntrinsicTypeSpec>(integerTypeSpec),208 construct<IntrinsicTypeSpec>(209 construct<IntrinsicTypeSpec::Real>("REAL" >> maybe(kindSelector))),210 construct<IntrinsicTypeSpec>("DOUBLE PRECISION" >>211 construct<IntrinsicTypeSpec::DoublePrecision>()),212 construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Complex>(213 "COMPLEX" >> maybe(kindSelector))),214 construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Character>(215 "CHARACTER" >> maybe(Parser<CharSelector>{}))),216 construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Logical>(217 "LOGICAL" >> maybe(kindSelector))),218 construct<IntrinsicTypeSpec>(unsignedTypeSpec),219 extension<LanguageFeature::DoubleComplex>(220 "nonstandard usage: DOUBLE COMPLEX"_port_en_US,221 construct<IntrinsicTypeSpec>("DOUBLE COMPLEX"_sptok >>222 construct<IntrinsicTypeSpec::DoubleComplex>())),223 extension<LanguageFeature::Byte>("nonstandard usage: BYTE"_port_en_US,224 construct<IntrinsicTypeSpec>(construct<IntegerTypeSpec>(225 "BYTE" >> construct<std::optional<KindSelector>>(pure(1)))))))226 227// Extension: Vector type228// VECTOR(intrinsic-type-spec) | __VECTOR_PAIR | __VECTOR_QUAD229TYPE_CONTEXT_PARSER("vector type spec"_en_US,230 extension<LanguageFeature::PPCVector>(231 "nonstandard usage: Vector type"_port_en_US,232 first(construct<VectorTypeSpec>(intrinsicVectorTypeSpec),233 construct<VectorTypeSpec>("__VECTOR_PAIR" >>234 construct<VectorTypeSpec::PairVectorTypeSpec>()),235 construct<VectorTypeSpec>("__VECTOR_QUAD" >>236 construct<VectorTypeSpec::QuadVectorTypeSpec>()))))237 238// VECTOR(integer-type-spec) | VECTOR(real-type-spec) |239// VECTOR(unsigned-type-spec) |240TYPE_PARSER(construct<IntrinsicVectorTypeSpec>("VECTOR" >>241 parenthesized(construct<VectorElementType>(integerTypeSpec) ||242 construct<VectorElementType>(unsignedTypeSpec) ||243 construct<VectorElementType>(construct<IntrinsicTypeSpec::Real>(244 "REAL" >> maybe(kindSelector))))))245 246// UNSIGNED type247TYPE_PARSER(construct<UnsignedTypeSpec>("UNSIGNED" >> maybe(kindSelector)))248 249// R705 integer-type-spec -> INTEGER [kind-selector]250TYPE_PARSER(construct<IntegerTypeSpec>("INTEGER" >> maybe(kindSelector)))251 252// R706 kind-selector -> ( [KIND =] scalar-int-constant-expr )253// Legacy extension: kind-selector -> * digit-string254TYPE_PARSER(construct<KindSelector>(255 parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) ||256 extension<LanguageFeature::StarKind>(257 "nonstandard usage: TYPE*KIND syntax"_port_en_US,258 construct<KindSelector>(construct<KindSelector::StarSize>(259 "*" >> digitString64 / spaceCheck))))260 261constexpr auto noSpace{262 recovery(withMessage("invalid space"_err_en_US, !" "_ch), space)};263 264// R707 signed-int-literal-constant -> [sign] int-literal-constant265TYPE_PARSER(sourced(266 construct<SignedIntLiteralConstant>(SignedIntLiteralConstantWithoutKind{},267 maybe(noSpace >> underscore >> noSpace >> kindParam))))268 269// R708 int-literal-constant -> digit-string [_ kind-param]270// The negated look-ahead for a trailing underscore prevents misrecognition271// when the digit string is a numeric kind parameter of a character literal.272TYPE_PARSER(construct<IntLiteralConstant>(space >> digitString / !"u"_ch,273 maybe(underscore >> noSpace >> kindParam) / !underscore))274 275// unsigned-literal-constant -> digit-string U [_ kind-param]276TYPE_PARSER(construct<UnsignedLiteralConstant>(space >> digitString / "u"_ch,277 maybe(underscore >> noSpace >> kindParam) / !underscore))278 279// R709 kind-param -> digit-string | scalar-int-constant-name280TYPE_PARSER(construct<KindParam>(digitString64) ||281 construct<KindParam>(282 scalar(integer(constant(sourced(rawName >> construct<Name>()))))))283 284// R712 sign -> + | -285// N.B. A sign constitutes a whole token, so a space is allowed in free form286// after the sign and before a real-literal-constant or287// complex-literal-constant. A sign is not a unary operator in these contexts.288constexpr auto sign{289 "+"_tok >> pure(Sign::Positive) || "-"_tok >> pure(Sign::Negative)};290 291// R713 signed-real-literal-constant -> [sign] real-literal-constant292constexpr auto signedRealLiteralConstant{293 construct<SignedRealLiteralConstant>(maybe(sign), realLiteralConstant)};294 295// R714 real-literal-constant ->296// significand [exponent-letter exponent] [_ kind-param] |297// digit-string exponent-letter exponent [_ kind-param]298// R715 significand -> digit-string . [digit-string] | . digit-string299// R716 exponent-letter -> E | D300// Extension: Q301// R717 exponent -> signed-digit-string302constexpr auto exponentPart{303 ("ed"_ch ||304 extension<LanguageFeature::QuadPrecision>(305 "nonstandard usage: Q exponent"_port_en_US, "q"_ch)) >>306 SignedDigitString{}};307 308TYPE_CONTEXT_PARSER("REAL literal constant"_en_US,309 space >>310 construct<RealLiteralConstant>(311 sourced((digitString >> "."_ch >>312 !(some(letter) >>313 "."_ch /* don't misinterpret 1.AND. */) >>314 maybe(digitString) >> maybe(exponentPart) >> ok ||315 "."_ch >> digitString >> maybe(exponentPart) >> ok ||316 digitString >> exponentPart >> ok) >>317 construct<RealLiteralConstant::Real>()),318 maybe(noSpace >> underscore >> noSpace >> kindParam)))319 320// R718 complex-literal-constant -> ( real-part , imag-part )321TYPE_CONTEXT_PARSER("COMPLEX literal constant"_en_US,322 parenthesized(construct<ComplexLiteralConstant>(323 Parser<ComplexPart>{} / ",", Parser<ComplexPart>{})))324 325// PGI/Intel extension: signed complex literal constant326TYPE_PARSER(construct<SignedComplexLiteralConstant>(327 sign, Parser<ComplexLiteralConstant>{}))328 329// R719 real-part ->330// signed-int-literal-constant | signed-real-literal-constant |331// named-constant332// R720 imag-part ->333// signed-int-literal-constant | signed-real-literal-constant |334// named-constant335TYPE_PARSER(construct<ComplexPart>(signedRealLiteralConstant) ||336 construct<ComplexPart>(signedIntLiteralConstant) ||337 construct<ComplexPart>(namedConstant))338 339// R721 char-selector ->340// length-selector |341// ( LEN = type-param-value , KIND = scalar-int-constant-expr ) |342// ( type-param-value , [KIND =] scalar-int-constant-expr ) |343// ( KIND = scalar-int-constant-expr [, LEN = type-param-value] )344TYPE_PARSER(construct<CharSelector>(Parser<LengthSelector>{}) ||345 parenthesized(construct<CharSelector>(346 "LEN =" >> typeParamValue, ", KIND =" >> scalarIntConstantExpr)) ||347 parenthesized(construct<CharSelector>(348 typeParamValue / ",", maybe("KIND ="_tok) >> scalarIntConstantExpr)) ||349 parenthesized(construct<CharSelector>(350 "KIND =" >> scalarIntConstantExpr, maybe(", LEN =" >> typeParamValue))))351 352// R722 length-selector -> ( [LEN =] type-param-value ) | * char-length [,]353// N.B. The trailing [,] in the production is permitted by the Standard354// only in the context of a type-declaration-stmt, but even with that355// limitation, it would seem to be unnecessary and buggy to consume the comma356// here.357TYPE_PARSER(construct<LengthSelector>(358 parenthesized(maybe("LEN ="_tok) >> typeParamValue)) ||359 construct<LengthSelector>("*" >> charLength /* / maybe(","_tok) */))360 361// R723 char-length -> ( type-param-value ) | digit-string362TYPE_PARSER(construct<CharLength>(parenthesized(typeParamValue)) ||363 construct<CharLength>(space >> digitString64 / spaceCheck))364 365// R724 char-literal-constant ->366// [kind-param _] ' [rep-char]... ' |367// [kind-param _] " [rep-char]... "368// "rep-char" is any non-control character. Doubled interior quotes are369// combined. Backslash escapes can be enabled.370// N.B. the parsing of "kind-param" takes care to not consume the '_'.371TYPE_CONTEXT_PARSER("CHARACTER literal constant"_en_US,372 construct<CharLiteralConstant>(373 kindParam / underscore, charLiteralConstantWithoutKind) ||374 construct<CharLiteralConstant>(construct<std::optional<KindParam>>(),375 space >> charLiteralConstantWithoutKind))376 377TYPE_CONTEXT_PARSER(378 "Hollerith"_en_US, construct<HollerithLiteralConstant>(rawHollerithLiteral))379 380// R725 logical-literal-constant ->381// .TRUE. [_ kind-param] | .FALSE. [_ kind-param]382// Also accept .T. and .F. as extensions.383TYPE_PARSER(construct<LogicalLiteralConstant>(logicalTRUE,384 maybe(noSpace >> underscore >> noSpace >> kindParam)) ||385 construct<LogicalLiteralConstant>(386 logicalFALSE, maybe(noSpace >> underscore >> noSpace >> kindParam)))387 388// R726 derived-type-def ->389// derived-type-stmt [type-param-def-stmt]...390// [private-or-sequence]... [component-part]391// [type-bound-procedure-part] end-type-stmt392// R735 component-part -> [component-def-stmt]...393TYPE_CONTEXT_PARSER("derived type definition"_en_US,394 construct<DerivedTypeDef>(statement(Parser<DerivedTypeStmt>{}),395 many(unambiguousStatement(Parser<TypeParamDefStmt>{})),396 many(statement(Parser<PrivateOrSequence>{})),397 many(inContext("component"_en_US,398 unambiguousStatement(Parser<ComponentDefStmt>{}))),399 maybe(Parser<TypeBoundProcedurePart>{}),400 statement(Parser<EndTypeStmt>{})))401 402// R727 derived-type-stmt ->403// TYPE [[, type-attr-spec-list] ::] type-name [(404// type-param-name-list )]405TYPE_CONTEXT_PARSER("TYPE statement"_en_US,406 construct<DerivedTypeStmt>(407 "TYPE" >> optionalListBeforeColons(Parser<TypeAttrSpec>{}), name,408 defaulted(parenthesized(nonemptyList(name)))))409 410// R728 type-attr-spec ->411// ABSTRACT | access-spec | BIND(C) | EXTENDS ( parent-type-name )412TYPE_PARSER(construct<TypeAttrSpec>(construct<Abstract>("ABSTRACT"_tok)) ||413 construct<TypeAttrSpec>(construct<TypeAttrSpec::BindC>("BIND ( C )"_tok)) ||414 construct<TypeAttrSpec>(415 construct<TypeAttrSpec::Extends>("EXTENDS" >> parenthesized(name))) ||416 construct<TypeAttrSpec>(accessSpec))417 418// R729 private-or-sequence -> private-components-stmt | sequence-stmt419TYPE_PARSER(construct<PrivateOrSequence>(Parser<PrivateStmt>{}) ||420 construct<PrivateOrSequence>(Parser<SequenceStmt>{}))421 422// R730 end-type-stmt -> END TYPE [type-name]423TYPE_PARSER(construct<EndTypeStmt>(424 recovery("END TYPE" >> maybe(name), namedConstructEndStmtErrorRecovery)))425 426// R731 sequence-stmt -> SEQUENCE427TYPE_PARSER(construct<SequenceStmt>("SEQUENCE"_tok))428 429// R732 type-param-def-stmt ->430// integer-type-spec , type-param-attr-spec :: type-param-decl-list431// R734 type-param-attr-spec -> KIND | LEN432constexpr auto kindOrLen{"KIND" >> pure(common::TypeParamAttr::Kind) ||433 "LEN" >> pure(common::TypeParamAttr::Len)};434TYPE_PARSER(construct<TypeParamDefStmt>(integerTypeSpec / ",", kindOrLen,435 "::" >> nonemptyList("expected type parameter declarations"_err_en_US,436 Parser<TypeParamDecl>{})))437 438// R733 type-param-decl -> type-param-name [= scalar-int-constant-expr]439TYPE_PARSER(construct<TypeParamDecl>(name, maybe("=" >> scalarIntConstantExpr)))440 441// R736 component-def-stmt -> data-component-def-stmt |442// proc-component-def-stmt443// Accidental extension not enabled here: PGI accepts type-param-def-stmt in444// component-part of derived-type-def.445TYPE_PARSER(recovery(446 withMessage("expected component definition"_err_en_US,447 first(construct<ComponentDefStmt>(Parser<DataComponentDefStmt>{}),448 construct<ComponentDefStmt>(Parser<ProcComponentDefStmt>{}),449 construct<ComponentDefStmt>(indirect(compilerDirective)))),450 construct<ComponentDefStmt>(inStmtErrorRecovery)))451 452// R737 data-component-def-stmt ->453// declaration-type-spec [[, component-attr-spec-list] ::]454// component-decl-list455// N.B. The standard requires double colons if there's an initializer.456TYPE_PARSER(construct<DataComponentDefStmt>(declarationTypeSpec,457 optionalListBeforeColons(Parser<ComponentAttrSpec>{}),458 nonemptyList("expected component declarations"_err_en_US,459 Parser<ComponentOrFill>{})))460 461// R738 component-attr-spec ->462// access-spec | ALLOCATABLE |463// CODIMENSION lbracket coarray-spec rbracket |464// CONTIGUOUS | DIMENSION ( component-array-spec ) | POINTER |465// CUDA-data-attr466TYPE_PARSER(construct<ComponentAttrSpec>(accessSpec) ||467 construct<ComponentAttrSpec>(allocatable) ||468 construct<ComponentAttrSpec>("CODIMENSION" >> coarraySpec) ||469 construct<ComponentAttrSpec>(contiguous) ||470 construct<ComponentAttrSpec>("DIMENSION" >> componentArraySpec) ||471 construct<ComponentAttrSpec>(pointer) ||472 extension<LanguageFeature::CUDA>(473 construct<ComponentAttrSpec>(Parser<common::CUDADataAttr>{})) ||474 construct<ComponentAttrSpec>(recovery(475 fail<ErrorRecovery>(476 "type parameter definitions must appear before component declarations"_err_en_US),477 kindOrLen >> construct<ErrorRecovery>())))478 479// R739 component-decl ->480// component-name [( component-array-spec )]481// [lbracket coarray-spec rbracket] [* char-length]482// [component-initialization] |483// (ext.) component-name *char-length [(component-array-spec)]484// [lbracket coarray-spec rbracket] [* char-length]485// [component-initialization]486TYPE_CONTEXT_PARSER("component declaration"_en_US,487 construct<ComponentDecl>(name, "*" >> charLength, maybe(componentArraySpec),488 maybe(coarraySpec), maybe(initialization)) ||489 construct<ComponentDecl>(name, maybe(componentArraySpec),490 maybe(coarraySpec), maybe("*" >> charLength),491 maybe(initialization)))492// The source field of the Name will be replaced with a distinct generated name.493TYPE_CONTEXT_PARSER("%FILL item"_en_US,494 extension<LanguageFeature::DECStructures>(495 "nonstandard usage: %FILL"_port_en_US,496 construct<FillDecl>(space >> sourced("%FILL" >> construct<Name>()),497 maybe(componentArraySpec), maybe("*" >> charLength))))498TYPE_PARSER(construct<ComponentOrFill>(Parser<ComponentDecl>{}) ||499 construct<ComponentOrFill>(Parser<FillDecl>{}))500 501// R740 component-array-spec ->502// explicit-shape-spec-list | deferred-shape-spec-list503// N.B. Parenthesized here rather than around references to this production.504TYPE_PARSER(construct<ComponentArraySpec>(parenthesized(505 nonemptyList("expected explicit shape specifications"_err_en_US,506 explicitShapeSpec))) ||507 construct<ComponentArraySpec>(parenthesized(deferredShapeSpecList)))508 509// R741 proc-component-def-stmt ->510// PROCEDURE ( [proc-interface] ) , proc-component-attr-spec-list511// :: proc-decl-list512TYPE_CONTEXT_PARSER("PROCEDURE component definition statement"_en_US,513 construct<ProcComponentDefStmt>(514 "PROCEDURE" >> parenthesized(maybe(procInterface)),515 localRecovery("expected PROCEDURE component attributes"_err_en_US,516 "," >> nonemptyList(Parser<ProcComponentAttrSpec>{}), ok),517 localRecovery("expected PROCEDURE declarations"_err_en_US,518 "::" >> nonemptyList(procDecl), SkipTo<'\n'>{})))519 520// R742 proc-component-attr-spec ->521// access-spec | NOPASS | PASS [(arg-name)] | POINTER522constexpr auto noPass{construct<NoPass>("NOPASS"_tok)};523constexpr auto pass{construct<Pass>("PASS" >> maybe(parenthesized(name)))};524TYPE_PARSER(construct<ProcComponentAttrSpec>(accessSpec) ||525 construct<ProcComponentAttrSpec>(noPass) ||526 construct<ProcComponentAttrSpec>(pass) ||527 construct<ProcComponentAttrSpec>(pointer))528 529// R744 initial-data-target -> designator530constexpr auto initialDataTarget{indirect(designator)};531 532// R743 component-initialization ->533// = constant-expr | => null-init | => initial-data-target534// R805 initialization ->535// = constant-expr | => null-init | => initial-data-target536// Universal extension: initialization -> / data-stmt-value-list /537TYPE_PARSER(construct<Initialization>("=>" >> nullInit) ||538 construct<Initialization>("=>" >> initialDataTarget) ||539 construct<Initialization>("=" >> constantExpr) ||540 extension<LanguageFeature::SlashInitialization>(541 "nonstandard usage: /initialization/"_port_en_US,542 construct<Initialization>(543 "/" >> nonemptyList("expected values"_err_en_US,544 indirect(Parser<DataStmtValue>{})) /545 "/")))546 547// R745 private-components-stmt -> PRIVATE548// R747 binding-private-stmt -> PRIVATE549TYPE_PARSER(construct<PrivateStmt>("PRIVATE"_tok))550 551// R746 type-bound-procedure-part ->552// contains-stmt [binding-private-stmt] [type-bound-proc-binding]...553TYPE_CONTEXT_PARSER("type bound procedure part"_en_US,554 construct<TypeBoundProcedurePart>(statement(containsStmt),555 maybe(statement(Parser<PrivateStmt>{})),556 many(statement(Parser<TypeBoundProcBinding>{}))))557 558// R748 type-bound-proc-binding ->559// type-bound-procedure-stmt | type-bound-generic-stmt |560// final-procedure-stmt561TYPE_CONTEXT_PARSER("type bound procedure binding"_en_US,562 recovery(563 first(construct<TypeBoundProcBinding>(Parser<TypeBoundProcedureStmt>{}),564 construct<TypeBoundProcBinding>(Parser<TypeBoundGenericStmt>{}),565 construct<TypeBoundProcBinding>(Parser<FinalProcedureStmt>{})),566 construct<TypeBoundProcBinding>(567 !"END"_tok >> SkipTo<'\n'>{} >> construct<ErrorRecovery>())))568 569// R749 type-bound-procedure-stmt ->570// PROCEDURE [[, bind-attr-list] ::] type-bound-proc-decl-list |571// PROCEDURE ( interface-name ) , bind-attr-list :: binding-name-list572// The "::" is required by the standard (C768) in the first production if573// any type-bound-proc-decl has a "=>', but it's not strictly necessary to574// avoid a bad parse.575TYPE_CONTEXT_PARSER("type bound PROCEDURE statement"_en_US,576 "PROCEDURE" >>577 (construct<TypeBoundProcedureStmt>(578 construct<TypeBoundProcedureStmt::WithInterface>(579 parenthesized(name),580 localRecovery("expected list of binding attributes"_err_en_US,581 "," >> nonemptyList(Parser<BindAttr>{}), ok),582 localRecovery("expected list of binding names"_err_en_US,583 "::" >> listOfNames, SkipTo<'\n'>{}))) ||584 construct<TypeBoundProcedureStmt>(construct<585 TypeBoundProcedureStmt::WithoutInterface>(586 pure<std::list<BindAttr>>(),587 nonemptyList(588 "expected type bound procedure declarations"_err_en_US,589 construct<TypeBoundProcDecl>(name,590 maybe(extension<LanguageFeature::MissingColons>(591 "type-bound procedure statement should have '::' if it has '=>'"_port_en_US,592 "=>" >> name)))))) ||593 construct<TypeBoundProcedureStmt>(594 construct<TypeBoundProcedureStmt::WithoutInterface>(595 optionalListBeforeColons(Parser<BindAttr>{}),596 nonemptyList(597 "expected type bound procedure declarations"_err_en_US,598 Parser<TypeBoundProcDecl>{})))))599 600// R750 type-bound-proc-decl -> binding-name [=> procedure-name]601TYPE_PARSER(construct<TypeBoundProcDecl>(name, maybe("=>" >> name)))602 603// R751 type-bound-generic-stmt ->604// GENERIC [, access-spec] :: generic-spec => binding-name-list605TYPE_CONTEXT_PARSER("type bound GENERIC statement"_en_US,606 construct<TypeBoundGenericStmt>("GENERIC" >> maybe("," >> accessSpec),607 "::" >> indirect(genericSpec), "=>" >> listOfNames))608 609// R752 bind-attr ->610// access-spec | DEFERRED | NON_OVERRIDABLE | NOPASS | PASS [(arg-name)]611TYPE_PARSER(construct<BindAttr>(accessSpec) ||612 construct<BindAttr>(construct<BindAttr::Deferred>("DEFERRED"_tok)) ||613 construct<BindAttr>(614 construct<BindAttr::Non_Overridable>("NON_OVERRIDABLE"_tok)) ||615 construct<BindAttr>(noPass) || construct<BindAttr>(pass))616 617// R753 final-procedure-stmt -> FINAL [::] final-subroutine-name-list618TYPE_CONTEXT_PARSER("FINAL statement"_en_US,619 construct<FinalProcedureStmt>("FINAL" >> maybe("::"_tok) >> listOfNames))620 621// R754 derived-type-spec -> type-name [(type-param-spec-list)]622TYPE_PARSER(construct<DerivedTypeSpec>(name,623 defaulted(parenthesized(nonemptyList(624 "expected type parameters"_err_en_US, Parser<TypeParamSpec>{})))))625 626// R755 type-param-spec -> [keyword =] type-param-value627TYPE_PARSER(construct<TypeParamSpec>(maybe(keyword / "="), typeParamValue))628 629// R756 structure-constructor -> derived-type-spec ( [component-spec-list] )630TYPE_PARSER((construct<StructureConstructor>(derivedTypeSpec,631 parenthesized(optionalList(Parser<ComponentSpec>{}))) ||632 // This alternative corrects misrecognition of the633 // component-spec-list as the type-param-spec-list in634 // derived-type-spec.635 construct<StructureConstructor>(636 construct<DerivedTypeSpec>(637 name, construct<std::list<TypeParamSpec>>()),638 parenthesized(optionalList(Parser<ComponentSpec>{})))) /639 !"("_tok)640 641// R757 component-spec -> [keyword =] component-data-source642TYPE_PARSER(construct<ComponentSpec>(643 maybe(keyword / "="), Parser<ComponentDataSource>{}))644 645// R758 component-data-source -> expr | data-target | proc-target646TYPE_PARSER(construct<ComponentDataSource>(indirect(expr)))647 648// R759 enum-def ->649// enum-def-stmt enumerator-def-stmt [enumerator-def-stmt]...650// end-enum-stmt651TYPE_CONTEXT_PARSER("enum definition"_en_US,652 construct<EnumDef>(statement(Parser<EnumDefStmt>{}),653 some(unambiguousStatement(Parser<EnumeratorDefStmt>{})),654 statement(Parser<EndEnumStmt>{})))655 656// R760 enum-def-stmt -> ENUM, BIND(C)657TYPE_PARSER(construct<EnumDefStmt>("ENUM , BIND ( C )"_tok))658 659// R761 enumerator-def-stmt -> ENUMERATOR [::] enumerator-list660TYPE_CONTEXT_PARSER("ENUMERATOR statement"_en_US,661 construct<EnumeratorDefStmt>("ENUMERATOR" >> maybe("::"_tok) >>662 nonemptyList("expected enumerators"_err_en_US, Parser<Enumerator>{})))663 664// R762 enumerator -> named-constant [= scalar-int-constant-expr]665TYPE_PARSER(666 construct<Enumerator>(namedConstant, maybe("=" >> scalarIntConstantExpr)))667 668// R763 end-enum-stmt -> END ENUM669TYPE_PARSER(recovery("END ENUM"_tok, constructEndStmtErrorRecovery) >>670 construct<EndEnumStmt>())671 672// R801 type-declaration-stmt ->673// declaration-type-spec [[, attr-spec]... ::] entity-decl-list674constexpr auto entityDeclWithoutEqInit{675 construct<EntityDecl>(name, "*" >> charLength, maybe(arraySpec),676 maybe(coarraySpec), !"="_tok >> maybe(initialization)) ||677 construct<EntityDecl>(name, maybe(arraySpec), maybe(coarraySpec),678 maybe("*" >> charLength),679 !"="_tok >>680 maybe(initialization) /* old-style REAL A/0/ still works */)};681TYPE_PARSER(682 construct<TypeDeclarationStmt>(declarationTypeSpec,683 defaulted("," >> nonemptyList(Parser<AttrSpec>{})) / "::",684 nonemptyList("expected entity declarations"_err_en_US, entityDecl)) ||685 // C806: no initializers allowed without colons ("REALA=1" is ambiguous)686 construct<TypeDeclarationStmt>(declarationTypeSpec,687 construct<std::list<AttrSpec>>(),688 nonemptyList("expected entity declarations"_err_en_US,689 entityDeclWithoutEqInit)) ||690 // PGI-only extension: comma in place of doubled colons691 extension<LanguageFeature::MissingColons>(692 "nonstandard usage: ',' in place of '::'"_port_en_US,693 construct<TypeDeclarationStmt>(declarationTypeSpec,694 defaulted("," >> nonemptyList(Parser<AttrSpec>{})),695 withMessage("expected entity declarations"_err_en_US,696 "," >> nonemptyList(entityDecl)))))697 698// R802 attr-spec ->699// access-spec | ALLOCATABLE | ASYNCHRONOUS |700// CODIMENSION lbracket coarray-spec rbracket | CONTIGUOUS |701// DIMENSION ( array-spec ) | EXTERNAL | INTENT ( intent-spec ) |702// INTRINSIC | language-binding-spec | OPTIONAL | PARAMETER | POINTER |703// PROTECTED | SAVE | TARGET | VALUE | VOLATILE |704// CUDA-data-attr705TYPE_PARSER(construct<AttrSpec>(accessSpec) ||706 construct<AttrSpec>(allocatable) ||707 construct<AttrSpec>(construct<Asynchronous>("ASYNCHRONOUS"_tok)) ||708 construct<AttrSpec>("CODIMENSION" >> coarraySpec) ||709 construct<AttrSpec>(contiguous) ||710 construct<AttrSpec>("DIMENSION" >> arraySpec) ||711 construct<AttrSpec>(construct<External>("EXTERNAL"_tok)) ||712 construct<AttrSpec>("INTENT" >> parenthesized(intentSpec)) ||713 construct<AttrSpec>(construct<Intrinsic>("INTRINSIC"_tok)) ||714 construct<AttrSpec>(languageBindingSpec) || construct<AttrSpec>(optional) ||715 construct<AttrSpec>(construct<Parameter>("PARAMETER"_tok)) ||716 construct<AttrSpec>(pointer) || construct<AttrSpec>(protectedAttr) ||717 construct<AttrSpec>(save) ||718 construct<AttrSpec>(construct<Target>("TARGET"_tok)) ||719 construct<AttrSpec>(construct<Value>("VALUE"_tok)) ||720 construct<AttrSpec>(construct<Volatile>("VOLATILE"_tok)) ||721 extension<LanguageFeature::CUDA>(722 construct<AttrSpec>(Parser<common::CUDADataAttr>{})))723 724// CUDA-data-attr ->725// CONSTANT | DEVICE | MANAGED | PINNED | SHARED | TEXTURE | UNIFIED726TYPE_PARSER("CONSTANT" >> pure(common::CUDADataAttr::Constant) ||727 "DEVICE" >> pure(common::CUDADataAttr::Device) ||728 "MANAGED" >> pure(common::CUDADataAttr::Managed) ||729 "PINNED" >> pure(common::CUDADataAttr::Pinned) ||730 "SHARED" >> pure(common::CUDADataAttr::Shared) ||731 "TEXTURE" >> pure(common::CUDADataAttr::Texture) ||732 "UNIFIED" >> pure(common::CUDADataAttr::Unified))733 734// R804 object-name -> name735constexpr auto objectName{name};736 737// R803 entity-decl ->738// object-name [( array-spec )] [lbracket coarray-spec rbracket]739// [* char-length] [initialization] |740// function-name [* char-length] |741// (ext.) object-name *char-length [(array-spec)]742// [lbracket coarray-spec rbracket] [initialization]743TYPE_PARSER(construct<EntityDecl>(objectName, "*" >> charLength,744 maybe(arraySpec), maybe(coarraySpec), maybe(initialization)) ||745 construct<EntityDecl>(objectName, maybe(arraySpec), maybe(coarraySpec),746 maybe("*" >> charLength), maybe(initialization)))747 748// R806 null-init -> function-reference ... which must resolve to NULL()749TYPE_PARSER(lookAhead(name / "( )") >> construct<NullInit>(expr))750 751// R807 access-spec -> PUBLIC | PRIVATE752TYPE_PARSER(construct<AccessSpec>("PUBLIC" >> pure(AccessSpec::Kind::Public)) ||753 construct<AccessSpec>("PRIVATE" >> pure(AccessSpec::Kind::Private)))754 755// R808 language-binding-spec ->756// BIND ( C [, NAME = scalar-default-char-constant-expr] )757// R1528 proc-language-binding-spec -> language-binding-spec758TYPE_PARSER(construct<LanguageBindingSpec>(759 "BIND ( C" >> maybe(", NAME =" >> scalarDefaultCharConstantExpr),760 (", CDEFINED" >> pure(true) || pure(false)) / ")"))761 762// R809 coarray-spec -> deferred-coshape-spec-list | explicit-coshape-spec763// N.B. Bracketed here rather than around references, for consistency with764// array-spec.765TYPE_PARSER(766 construct<CoarraySpec>(bracketed(Parser<DeferredCoshapeSpecList>{})) ||767 construct<CoarraySpec>(bracketed(Parser<ExplicitCoshapeSpec>{})))768 769// R810 deferred-coshape-spec -> :770// deferred-coshape-spec-list - just a list of colons771inline int listLength(std::list<Success> &&xs) { return xs.size(); }772 773TYPE_PARSER(construct<DeferredCoshapeSpecList>(774 applyFunction(listLength, nonemptyList(":"_tok))))775 776// R811 explicit-coshape-spec ->777// [[lower-cobound :] upper-cobound ,]... [lower-cobound :] *778// R812 lower-cobound -> specification-expr779// R813 upper-cobound -> specification-expr780TYPE_PARSER(construct<ExplicitCoshapeSpec>(781 many(explicitShapeSpec / ","), maybe(specificationExpr / ":") / "*"))782 783// R815 array-spec ->784// explicit-shape-spec-list | assumed-shape-spec-list |785// deferred-shape-spec-list | assumed-size-spec | implied-shape-spec |786// implied-shape-or-assumed-size-spec | assumed-rank-spec787// N.B. Parenthesized here rather than around references to avoid788// a need for forced look-ahead.789// Shape specs that could be deferred-shape-spec or assumed-shape-spec790// (e.g. '(:,:)') are parsed as the former.791TYPE_PARSER(792 construct<ArraySpec>(parenthesized(nonemptyList(explicitShapeSpec))) ||793 construct<ArraySpec>(parenthesized(deferredShapeSpecList)) ||794 construct<ArraySpec>(795 parenthesized(nonemptyList(Parser<AssumedShapeSpec>{}))) ||796 construct<ArraySpec>(parenthesized(Parser<AssumedSizeSpec>{})) ||797 construct<ArraySpec>(parenthesized(Parser<ImpliedShapeSpec>{})) ||798 construct<ArraySpec>(parenthesized(Parser<AssumedRankSpec>{})))799 800// R816 explicit-shape-spec -> [lower-bound :] upper-bound801// R817 lower-bound -> specification-expr802// R818 upper-bound -> specification-expr803TYPE_PARSER(construct<ExplicitShapeSpec>(804 maybe(specificationExpr / ":"), specificationExpr))805 806// R819 assumed-shape-spec -> [lower-bound] :807TYPE_PARSER(construct<AssumedShapeSpec>(maybe(specificationExpr) / ":"))808 809// R820 deferred-shape-spec -> :810// deferred-shape-spec-list - just a list of colons811TYPE_PARSER(construct<DeferredShapeSpecList>(812 applyFunction(listLength, nonemptyList(":"_tok))))813 814// R821 assumed-implied-spec -> [lower-bound :] *815TYPE_PARSER(construct<AssumedImpliedSpec>(maybe(specificationExpr / ":") / "*"))816 817// R822 assumed-size-spec -> explicit-shape-spec-list , assumed-implied-spec818TYPE_PARSER(construct<AssumedSizeSpec>(819 nonemptyList(explicitShapeSpec) / ",", assumedImpliedSpec))820 821// R823 implied-shape-or-assumed-size-spec -> assumed-implied-spec822// R824 implied-shape-spec -> assumed-implied-spec , assumed-implied-spec-list823// I.e., when the assumed-implied-spec-list has a single item, it constitutes an824// implied-shape-or-assumed-size-spec; otherwise, an implied-shape-spec.825TYPE_PARSER(construct<ImpliedShapeSpec>(nonemptyList(assumedImpliedSpec)))826 827// R825 assumed-rank-spec -> ..828TYPE_PARSER(construct<AssumedRankSpec>(".."_tok))829 830// R826 intent-spec -> IN | OUT | INOUT831TYPE_PARSER(construct<IntentSpec>("IN OUT" >> pure(IntentSpec::Intent::InOut) ||832 "IN" >> pure(IntentSpec::Intent::In) ||833 "OUT" >> pure(IntentSpec::Intent::Out)))834 835// R827 access-stmt -> access-spec [[::] access-id-list]836TYPE_PARSER(construct<AccessStmt>(accessSpec,837 defaulted(maybe("::"_tok) >>838 nonemptyList("expected names and generic specifications"_err_en_US,839 Parser<AccessId>{}))))840 841// R828 access-id -> access-name | generic-spec842// "access-name" is ambiguous with "generic-spec"843TYPE_PARSER(construct<AccessId>(indirect(genericSpec)))844 845// R829 allocatable-stmt -> ALLOCATABLE [::] allocatable-decl-list846TYPE_PARSER(construct<AllocatableStmt>("ALLOCATABLE" >> maybe("::"_tok) >>847 nonemptyList(848 "expected object declarations"_err_en_US, Parser<ObjectDecl>{})))849 850// R830 allocatable-decl ->851// object-name [( array-spec )] [lbracket coarray-spec rbracket]852// R860 target-decl ->853// object-name [( array-spec )] [lbracket coarray-spec rbracket]854TYPE_PARSER(855 construct<ObjectDecl>(objectName, maybe(arraySpec), maybe(coarraySpec)))856 857// R831 asynchronous-stmt -> ASYNCHRONOUS [::] object-name-list858TYPE_PARSER(construct<AsynchronousStmt>("ASYNCHRONOUS" >> maybe("::"_tok) >>859 nonemptyList("expected object names"_err_en_US, objectName)))860 861// R832 bind-stmt -> language-binding-spec [::] bind-entity-list862TYPE_PARSER(construct<BindStmt>(languageBindingSpec / maybe("::"_tok),863 nonemptyList("expected bind entities"_err_en_US, Parser<BindEntity>{})))864 865// R833 bind-entity -> entity-name | / common-block-name /866TYPE_PARSER(construct<BindEntity>(pure(BindEntity::Kind::Object), name) ||867 construct<BindEntity>("/" >> pure(BindEntity::Kind::Common), name / "/"))868 869// R834 codimension-stmt -> CODIMENSION [::] codimension-decl-list870TYPE_PARSER(construct<CodimensionStmt>("CODIMENSION" >> maybe("::"_tok) >>871 nonemptyList("expected codimension declarations"_err_en_US,872 Parser<CodimensionDecl>{})))873 874// R835 codimension-decl -> coarray-name lbracket coarray-spec rbracket875TYPE_PARSER(construct<CodimensionDecl>(name, coarraySpec))876 877// R836 contiguous-stmt -> CONTIGUOUS [::] object-name-list878TYPE_PARSER(construct<ContiguousStmt>("CONTIGUOUS" >> maybe("::"_tok) >>879 nonemptyList("expected object names"_err_en_US, objectName)))880 881// R837 data-stmt -> DATA data-stmt-set [[,] data-stmt-set]...882TYPE_CONTEXT_PARSER("DATA statement"_en_US,883 construct<DataStmt>(884 "DATA" >> nonemptySeparated(Parser<DataStmtSet>{}, maybe(","_tok))))885 886// R838 data-stmt-set -> data-stmt-object-list / data-stmt-value-list /887TYPE_PARSER(construct<DataStmtSet>(888 nonemptyList(889 "expected DATA statement objects"_err_en_US, Parser<DataStmtObject>{}),890 withMessage("expected DATA statement value list"_err_en_US,891 "/"_tok >> nonemptyList("expected DATA statement values"_err_en_US,892 Parser<DataStmtValue>{})) /893 "/"))894 895// R839 data-stmt-object -> variable | data-implied-do896TYPE_PARSER(construct<DataStmtObject>(indirect(variable)) ||897 construct<DataStmtObject>(dataImpliedDo))898 899// R840 data-implied-do ->900// ( data-i-do-object-list , [integer-type-spec ::] data-i-do-variable901// = scalar-int-constant-expr , scalar-int-constant-expr902// [, scalar-int-constant-expr] )903// R842 data-i-do-variable -> do-variable904TYPE_PARSER(parenthesized(construct<DataImpliedDo>(905 nonemptyList(Parser<DataIDoObject>{} / lookAhead(","_tok)) / ",",906 maybe(integerTypeSpec / "::"), loopBounds(scalarIntConstantExpr))))907 908// R841 data-i-do-object ->909// array-element | scalar-structure-component | data-implied-do910TYPE_PARSER(construct<DataIDoObject>(scalar(indirect(designator))) ||911 construct<DataIDoObject>(indirect(dataImpliedDo)))912 913// R843 data-stmt-value -> [data-stmt-repeat *] data-stmt-constant914TYPE_PARSER(construct<DataStmtValue>(915 maybe(Parser<DataStmtRepeat>{} / "*"), Parser<DataStmtConstant>{}))916 917// R847 constant-subobject -> designator918// R846 int-constant-subobject -> constant-subobject919constexpr auto constantSubobject{constant(indirect(designator))};920 921// R844 data-stmt-repeat -> scalar-int-constant | scalar-int-constant-subobject922// R607 int-constant -> constant923// Factored into: constant -> literal-constant -> int-literal-constant924// The named-constant alternative of constant is subsumed by constant-subobject925TYPE_PARSER(construct<DataStmtRepeat>(intLiteralConstant) ||926 construct<DataStmtRepeat>(scalar(integer(constantSubobject))))927 928// R845 data-stmt-constant ->929// scalar-constant | scalar-constant-subobject |930// signed-int-literal-constant | signed-real-literal-constant |931// null-init | initial-data-target |932// constant-structure-constructor933// N.B. scalar-constant and scalar-constant-subobject are ambiguous with934// initial-data-target; null-init and structure-constructor are ambiguous935// in the absence of parameters and components; structure-constructor with936// components can be ambiguous with a scalar-constant-subobject.937// So we parse literal constants, designator, null-init, and938// structure-constructor, so that semantics can figure things out later939// with the symbol table. A literal constant substring must be attempted940// first to avoid a partial match with a literal constant.941TYPE_PARSER(sourced(first(942 construct<DataStmtConstant>(indirect(charLiteralConstantSubstring)),943 construct<DataStmtConstant>(literalConstant),944 construct<DataStmtConstant>(signedRealLiteralConstant),945 construct<DataStmtConstant>(signedIntLiteralConstant),946 extension<LanguageFeature::SignedComplexLiteral>(947 "nonstandard usage: signed COMPLEX literal"_port_en_US,948 construct<DataStmtConstant>(Parser<SignedComplexLiteralConstant>{})),949 construct<DataStmtConstant>(nullInit),950 construct<DataStmtConstant>(indirect(designator) / !"("_tok),951 construct<DataStmtConstant>(Parser<StructureConstructor>{}))))952 953// R848 dimension-stmt ->954// DIMENSION [::] array-name ( array-spec )955// [, array-name ( array-spec )]...956TYPE_CONTEXT_PARSER("DIMENSION statement"_en_US,957 construct<DimensionStmt>("DIMENSION" >> maybe("::"_tok) >>958 nonemptyList("expected array specifications"_err_en_US,959 construct<DimensionStmt::Declaration>(name, arraySpec))))960 961// R849 intent-stmt -> INTENT ( intent-spec ) [::] dummy-arg-name-list962TYPE_CONTEXT_PARSER("INTENT statement"_en_US,963 construct<IntentStmt>(964 "INTENT" >> parenthesized(intentSpec) / maybe("::"_tok), listOfNames))965 966// R850 optional-stmt -> OPTIONAL [::] dummy-arg-name-list967TYPE_PARSER(968 construct<OptionalStmt>("OPTIONAL" >> maybe("::"_tok) >> listOfNames))969 970// R851 parameter-stmt -> PARAMETER ( named-constant-def-list )971// Legacy extension: omitted parentheses, no implicit typing from names972TYPE_CONTEXT_PARSER("PARAMETER statement"_en_US,973 construct<ParameterStmt>(974 "PARAMETER" >> parenthesized(nonemptyList(Parser<NamedConstantDef>{}))))975TYPE_CONTEXT_PARSER("old style PARAMETER statement"_en_US,976 extension<LanguageFeature::OldStyleParameter>(977 "nonstandard usage: PARAMETER without parentheses"_port_en_US,978 construct<OldParameterStmt>(979 "PARAMETER" >> nonemptyList(Parser<NamedConstantDef>{}))))980 981// R852 named-constant-def -> named-constant = constant-expr982TYPE_PARSER(construct<NamedConstantDef>(namedConstant, "=" >> constantExpr))983 984// R853 pointer-stmt -> POINTER [::] pointer-decl-list985TYPE_PARSER(construct<PointerStmt>("POINTER" >> maybe("::"_tok) >>986 nonemptyList(987 "expected pointer declarations"_err_en_US, Parser<PointerDecl>{})))988 989// R854 pointer-decl ->990// object-name [( deferred-shape-spec-list )] | proc-entity-name991TYPE_PARSER(992 construct<PointerDecl>(name, maybe(parenthesized(deferredShapeSpecList))))993 994// R855 protected-stmt -> PROTECTED [::] entity-name-list995TYPE_PARSER(996 construct<ProtectedStmt>("PROTECTED" >> maybe("::"_tok) >> listOfNames))997 998// R856 save-stmt -> SAVE [[::] saved-entity-list]999TYPE_PARSER(construct<SaveStmt>(1000 "SAVE" >> defaulted(maybe("::"_tok) >>1001 nonemptyList("expected SAVE entities"_err_en_US,1002 Parser<SavedEntity>{}))))1003 1004// R857 saved-entity -> object-name | proc-pointer-name | / common-block-name /1005// R858 proc-pointer-name -> name1006TYPE_PARSER(construct<SavedEntity>(pure(SavedEntity::Kind::Entity), name) ||1007 construct<SavedEntity>("/" >> pure(SavedEntity::Kind::Common), name / "/"))1008 1009// R859 target-stmt -> TARGET [::] target-decl-list1010TYPE_PARSER(construct<TargetStmt>("TARGET" >> maybe("::"_tok) >>1011 nonemptyList("expected objects"_err_en_US, Parser<ObjectDecl>{})))1012 1013// R861 value-stmt -> VALUE [::] dummy-arg-name-list1014TYPE_PARSER(construct<ValueStmt>("VALUE" >> maybe("::"_tok) >> listOfNames))1015 1016// R862 volatile-stmt -> VOLATILE [::] object-name-list1017TYPE_PARSER(construct<VolatileStmt>("VOLATILE" >> maybe("::"_tok) >>1018 nonemptyList("expected object names"_err_en_US, objectName)))1019 1020// R866 implicit-name-spec -> EXTERNAL | TYPE1021constexpr auto implicitNameSpec{1022 "EXTERNAL" >> pure(ImplicitStmt::ImplicitNoneNameSpec::External) ||1023 "TYPE" >> pure(ImplicitStmt::ImplicitNoneNameSpec::Type)};1024 1025// R863 implicit-stmt ->1026// IMPLICIT implicit-spec-list |1027// IMPLICIT NONE [( [implicit-name-spec-list] )]1028TYPE_CONTEXT_PARSER("IMPLICIT statement"_en_US,1029 construct<ImplicitStmt>(1030 "IMPLICIT" >> nonemptyList("expected IMPLICIT specifications"_err_en_US,1031 Parser<ImplicitSpec>{})) ||1032 construct<ImplicitStmt>("IMPLICIT NONE"_sptok >>1033 defaulted(parenthesized(optionalList(implicitNameSpec)))))1034 1035// R864 implicit-spec -> declaration-type-spec ( letter-spec-list )1036// The variant form of declarationTypeSpec is meant to avoid misrecognition1037// of a letter-spec as a simple parenthesized expression for kind or character1038// length, e.g., PARAMETER(I=5,N=1); IMPLICIT REAL(I-N)(O-Z) vs.1039// IMPLICIT REAL(I-N). The variant form needs to attempt to reparse only1040// types with optional parenthesized kind/length expressions, so derived1041// type specs, DOUBLE PRECISION, and DOUBLE COMPLEX need not be considered.1042constexpr auto noKindSelector{construct<std::optional<KindSelector>>()};1043constexpr auto implicitSpecDeclarationTypeSpecRetry{1044 construct<DeclarationTypeSpec>(first(1045 construct<IntrinsicTypeSpec>(1046 construct<IntegerTypeSpec>("INTEGER" >> noKindSelector)),1047 construct<IntrinsicTypeSpec>(1048 construct<IntrinsicTypeSpec::Real>("REAL" >> noKindSelector)),1049 construct<IntrinsicTypeSpec>(1050 construct<IntrinsicTypeSpec::Complex>("COMPLEX" >> noKindSelector)),1051 construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Character>(1052 "CHARACTER" >> construct<std::optional<CharSelector>>())),1053 construct<IntrinsicTypeSpec>(1054 construct<IntrinsicTypeSpec::Logical>("LOGICAL" >> noKindSelector)),1055 construct<IntrinsicTypeSpec>(1056 construct<UnsignedTypeSpec>("UNSIGNED" >> noKindSelector))))};1057 1058TYPE_PARSER(construct<ImplicitSpec>(declarationTypeSpec,1059 parenthesized(nonemptyList(Parser<LetterSpec>{}))) ||1060 construct<ImplicitSpec>(implicitSpecDeclarationTypeSpecRetry,1061 parenthesized(nonemptyList(Parser<LetterSpec>{}))))1062 1063// R865 letter-spec -> letter [- letter]1064TYPE_PARSER(space >> (construct<LetterSpec>(letter, maybe("-" >> letter)) ||1065 construct<LetterSpec>(otherIdChar,1066 construct<std::optional<const char *>>())))1067 1068// R867 import-stmt ->1069// IMPORT [[::] import-name-list] |1070// IMPORT , ONLY : import-name-list | IMPORT , NONE | IMPORT , ALL1071TYPE_CONTEXT_PARSER("IMPORT statement"_en_US,1072 construct<ImportStmt>(1073 "IMPORT , ONLY :" >> pure(common::ImportKind::Only), listOfNames) ||1074 construct<ImportStmt>(1075 "IMPORT , NONE" >> pure(common::ImportKind::None)) ||1076 construct<ImportStmt>(1077 "IMPORT , ALL" >> pure(common::ImportKind::All)) ||1078 construct<ImportStmt>(1079 "IMPORT" >> maybe("::"_tok) >> optionalList(name)))1080 1081// R868 namelist-stmt ->1082// NAMELIST / namelist-group-name / namelist-group-object-list1083// [[,] / namelist-group-name / namelist-group-object-list]...1084// R869 namelist-group-object -> variable-name1085TYPE_PARSER(construct<NamelistStmt>("NAMELIST" >>1086 nonemptySeparated(1087 construct<NamelistStmt::Group>("/" >> name / "/", listOfNames),1088 maybe(","_tok))))1089 1090// R870 equivalence-stmt -> EQUIVALENCE equivalence-set-list1091// R871 equivalence-set -> ( equivalence-object , equivalence-object-list )1092TYPE_PARSER(construct<EquivalenceStmt>("EQUIVALENCE" >>1093 nonemptyList(1094 parenthesized(nonemptyList("expected EQUIVALENCE objects"_err_en_US,1095 Parser<EquivalenceObject>{})))))1096 1097// R872 equivalence-object -> variable-name | array-element | substring1098TYPE_PARSER(construct<EquivalenceObject>(indirect(designator)))1099 1100// R873 common-stmt ->1101// COMMON [/ [common-block-name] /] common-block-object-list1102// [[,] / [common-block-name] / common-block-object-list]...1103TYPE_PARSER(sourced(1104 construct<CommonStmt>("COMMON" >> defaulted("/" >> maybe(name) / "/"),1105 nonemptyList("expected COMMON block objects"_err_en_US,1106 Parser<CommonBlockObject>{}),1107 many(maybe(","_tok) >>1108 construct<CommonStmt::Block>("/" >> maybe(name) / "/",1109 nonemptyList("expected COMMON block objects"_err_en_US,1110 Parser<CommonBlockObject>{}))))))1111 1112// R874 common-block-object -> variable-name [( array-spec )]1113TYPE_PARSER(construct<CommonBlockObject>(name, maybe(arraySpec)))1114 1115// R901 designator -> object-name | array-element | array-section |1116// coindexed-named-object | complex-part-designator |1117// structure-component | substring1118// The Standard's productions for designator and its alternatives are1119// ambiguous without recourse to a symbol table. Many of the alternatives1120// for designator (viz., array-element, coindexed-named-object,1121// and structure-component) are all syntactically just data-ref.1122// What designator boils down to is this:1123// It starts with either a name or a character literal.1124// If it starts with a character literal, it must be a substring.1125// If it starts with a name, it's a sequence of %-separated parts;1126// each part is a name, maybe a (section-subscript-list), and1127// maybe an [image-selector].1128// If it's a substring, it ends with (substring-range).1129TYPE_CONTEXT_PARSER("designator"_en_US,1130 sourced(construct<Designator>(substring) || construct<Designator>(dataRef)))1131 1132constexpr auto percentOrDot{"%"_tok ||1133 // legacy VAX extension for RECORD field access1134 extension<LanguageFeature::DECStructures>(1135 "nonstandard usage: component access with '.' in place of '%'"_port_en_US,1136 "."_tok / lookAhead(OldStructureComponentName{}))};1137 1138// R902 variable -> designator | function-reference1139// This production appears to be left-recursive in the grammar via1140// function-reference -> procedure-designator -> proc-component-ref ->1141// scalar-variable1142// and would be so if we were to allow functions to be called via procedure1143// pointer components within derived type results of other function references1144// (a reasonable extension, esp. in the case of procedure pointer components1145// that are NOPASS). However, Fortran constrains the use of a variable in a1146// proc-component-ref to be a data-ref without coindices (C1027).1147// Some array element references will be misrecognized as function references.1148constexpr auto noMoreAddressing{!"("_tok >> !"["_tok >> !percentOrDot};1149TYPE_CONTEXT_PARSER("variable"_en_US,1150 construct<Variable>(indirect(functionReference / noMoreAddressing)) ||1151 construct<Variable>(indirect(designator)))1152 1153// R908 substring -> parent-string ( substring-range )1154// R909 parent-string ->1155// scalar-variable-name | array-element | coindexed-named-object |1156// scalar-structure-component | scalar-char-literal-constant |1157// scalar-named-constant1158TYPE_PARSER(1159 construct<Substring>(dataRef, parenthesized(Parser<SubstringRange>{})))1160 1161TYPE_PARSER(construct<CharLiteralConstantSubstring>(1162 charLiteralConstant, parenthesized(Parser<SubstringRange>{})))1163 1164TYPE_PARSER(sourced(construct<SubstringInquiry>(Parser<Substring>{}) /1165 ("%LEN"_tok || "%KIND"_tok)))1166 1167// R910 substring-range -> [scalar-int-expr] : [scalar-int-expr]1168TYPE_PARSER(construct<SubstringRange>(1169 maybe(scalarIntExpr), ":" >> maybe(scalarIntExpr)))1170 1171// R911 data-ref -> part-ref [% part-ref]...1172// R914 coindexed-named-object -> data-ref1173// R917 array-element -> data-ref1174TYPE_PARSER(1175 construct<DataRef>(nonemptySeparated(Parser<PartRef>{}, percentOrDot)))1176 1177// R912 part-ref -> part-name [( section-subscript-list )] [image-selector]1178TYPE_PARSER(construct<PartRef>(name,1179 defaulted(1180 parenthesized(nonemptyList(Parser<SectionSubscript>{})) / !"=>"_tok),1181 maybe(Parser<ImageSelector>{})))1182 1183// R913 structure-component -> data-ref1184// The final part-ref in the data-ref is not allowed to have subscripts.1185TYPE_CONTEXT_PARSER("component"_en_US,1186 construct<StructureComponent>(1187 construct<DataRef>(some(Parser<PartRef>{} / percentOrDot)), name))1188 1189// R919 subscript -> scalar-int-expr1190constexpr auto subscript{scalarIntExpr};1191 1192// R920 section-subscript -> subscript | subscript-triplet | vector-subscript1193// R923 vector-subscript -> int-expr1194// N.B. The distinction that needs to be made between "subscript" and1195// "vector-subscript" is deferred to semantic analysis.1196TYPE_PARSER(construct<SectionSubscript>(Parser<SubscriptTriplet>{}) ||1197 construct<SectionSubscript>(intExpr))1198 1199// R921 subscript-triplet -> [subscript] : [subscript] [: stride]1200TYPE_PARSER(construct<SubscriptTriplet>(1201 maybe(subscript), ":" >> maybe(subscript), maybe(":" >> subscript)))1202 1203// R925 cosubscript -> scalar-int-expr1204constexpr auto cosubscript{scalarIntExpr};1205 1206// R924 image-selector ->1207// lbracket cosubscript-list [, image-selector-spec-list] rbracket1208TYPE_CONTEXT_PARSER("image selector"_en_US,1209 construct<ImageSelector>(1210 "[" >> nonemptyList(cosubscript / lookAhead(space / ",]"_ch)),1211 defaulted("," >> nonemptyList(Parser<ImageSelectorSpec>{})) / "]"))1212 1213// R926 image-selector-spec ->1214// STAT = stat-variable | TEAM = team-value |1215// TEAM_NUMBER = scalar-int-expr |1216// NOTIFY = notify-variable1217TYPE_PARSER(construct<ImageSelectorSpec>(construct<ImageSelectorSpec::Stat>(1218 "STAT =" >> scalar(integer(indirect(variable))))) ||1219 construct<ImageSelectorSpec>(construct<TeamValue>("TEAM =" >> teamValue)) ||1220 construct<ImageSelectorSpec>(construct<ImageSelectorSpec::Team_Number>(1221 "TEAM_NUMBER =" >> scalarIntExpr)) ||1222 construct<ImageSelectorSpec>(construct<ImageSelectorSpec::Notify>(1223 "NOTIFY =" >> scalar(indirect(variable)))))1224 1225// R927 allocate-stmt ->1226// ALLOCATE ( [type-spec ::] allocation-list [, alloc-opt-list] )1227TYPE_CONTEXT_PARSER("ALLOCATE statement"_en_US,1228 construct<AllocateStmt>("ALLOCATE (" >> maybe(typeSpec / "::"),1229 nonemptyList(Parser<Allocation>{}),1230 defaulted("," >> nonemptyList(Parser<AllocOpt>{})) / ")"))1231 1232// R928 alloc-opt ->1233// ERRMSG = errmsg-variable | MOLD = source-expr |1234// SOURCE = source-expr | STAT = stat-variable |1235// (CUDA) STREAM = scalar-int-expr1236// PINNED = scalar-logical-variable1237// R931 source-expr -> expr1238TYPE_PARSER(construct<AllocOpt>(1239 construct<AllocOpt::Mold>("MOLD =" >> indirect(expr))) ||1240 construct<AllocOpt>(1241 construct<AllocOpt::Source>("SOURCE =" >> indirect(expr))) ||1242 construct<AllocOpt>(statOrErrmsg) ||1243 extension<LanguageFeature::CUDA>(1244 construct<AllocOpt>(construct<AllocOpt::Stream>(1245 "STREAM =" >> indirect(scalarIntExpr))) ||1246 construct<AllocOpt>(construct<AllocOpt::Pinned>(1247 "PINNED =" >> indirect(scalarLogicalVariable)))))1248 1249// R929 stat-variable -> scalar-int-variable1250TYPE_PARSER(construct<StatVariable>(scalar(integer(variable))))1251 1252// R932 allocation ->1253// allocate-object [( allocate-shape-spec-list )]1254// [lbracket allocate-coarray-spec rbracket]1255TYPE_PARSER(construct<Allocation>(Parser<AllocateObject>{},1256 defaulted(parenthesized(nonemptyList(Parser<AllocateShapeSpec>{}))),1257 maybe(bracketed(Parser<AllocateCoarraySpec>{}))))1258 1259// R933 allocate-object -> variable-name | structure-component1260TYPE_PARSER(construct<AllocateObject>(structureComponent) ||1261 construct<AllocateObject>(name / !"="_tok))1262 1263// R934 allocate-shape-spec -> [lower-bound-expr :] upper-bound-expr1264// R938 allocate-coshape-spec -> [lower-bound-expr :] upper-bound-expr1265TYPE_PARSER(construct<AllocateShapeSpec>(maybe(boundExpr / ":"), boundExpr))1266 1267// R937 allocate-coarray-spec ->1268// [allocate-coshape-spec-list ,] [lower-bound-expr :] *1269TYPE_PARSER(construct<AllocateCoarraySpec>(1270 defaulted(nonemptyList(Parser<AllocateShapeSpec>{}) / ","),1271 maybe(boundExpr / ":") / "*"))1272 1273// R939 nullify-stmt -> NULLIFY ( pointer-object-list )1274TYPE_CONTEXT_PARSER("NULLIFY statement"_en_US,1275 "NULLIFY" >> parenthesized(construct<NullifyStmt>(1276 nonemptyList(Parser<PointerObject>{}))))1277 1278// R940 pointer-object ->1279// variable-name | structure-component | proc-pointer-name1280TYPE_PARSER(construct<PointerObject>(structureComponent) ||1281 construct<PointerObject>(name))1282 1283// R941 deallocate-stmt ->1284// DEALLOCATE ( allocate-object-list [, dealloc-opt-list] )1285TYPE_CONTEXT_PARSER("DEALLOCATE statement"_en_US,1286 construct<DeallocateStmt>(1287 "DEALLOCATE (" >> nonemptyList(Parser<AllocateObject>{}),1288 defaulted("," >> nonemptyList(statOrErrmsg)) / ")"))1289 1290// R942 dealloc-opt -> STAT = stat-variable | ERRMSG = errmsg-variable1291// R1165 sync-stat -> STAT = stat-variable | ERRMSG = errmsg-variable1292TYPE_PARSER(construct<StatOrErrmsg>("STAT =" >> statVariable) ||1293 construct<StatOrErrmsg>("ERRMSG =" >> msgVariable))1294 1295// Directives, extensions, and deprecated statements1296// !DIR$ IGNORE_TKR [ [(tkrdmac...)] name ]...1297// !DIR$ LOOP COUNT (n1[, n2]...)1298// !DIR$ name[=value] [, name[=value]]...1299// !DIR$ UNROLL [n]1300// !DIR$ PREFETCH designator[, designator]...1301// !DIR$ IVDEP1302// !DIR$ <anything else>1303constexpr auto ignore_tkr{1304 "IGNORE_TKR" >> optionalList(construct<CompilerDirective::IgnoreTKR>(1305 maybe(parenthesized(many(letter))), name))};1306constexpr auto loopCount{1307 "LOOP COUNT" >> construct<CompilerDirective::LoopCount>(1308 parenthesized(nonemptyList(digitString64)))};1309constexpr auto assumeAligned{"ASSUME_ALIGNED" >>1310 optionalList(construct<CompilerDirective::AssumeAligned>(1311 indirect(designator), ":"_tok >> digitString64))};1312constexpr auto vectorAlways{1313 "VECTOR ALWAYS" >> construct<CompilerDirective::VectorAlways>()};1314constexpr auto unroll{1315 "UNROLL" >> construct<CompilerDirective::Unroll>(maybe(digitString64))};1316constexpr auto prefetch{"PREFETCH" >>1317 construct<CompilerDirective::Prefetch>(nonemptyList(indirect(designator)))};1318constexpr auto unrollAndJam{"UNROLL_AND_JAM" >>1319 construct<CompilerDirective::UnrollAndJam>(maybe(digitString64))};1320constexpr auto novector{"NOVECTOR" >> construct<CompilerDirective::NoVector>()};1321constexpr auto nounroll{"NOUNROLL" >> construct<CompilerDirective::NoUnroll>()};1322constexpr auto nounrollAndJam{1323 "NOUNROLL_AND_JAM" >> construct<CompilerDirective::NoUnrollAndJam>()};1324constexpr auto forceinlineDir{1325 "FORCEINLINE" >> construct<CompilerDirective::ForceInline>()};1326constexpr auto noinlineDir{1327 "NOINLINE" >> construct<CompilerDirective::NoInline>()};1328constexpr auto inlineDir{"INLINE" >> construct<CompilerDirective::Inline>()};1329constexpr auto ivdep{"IVDEP" >> construct<CompilerDirective::IVDep>()};1330TYPE_PARSER(beginDirective >> "DIR$ "_tok >>1331 sourced((construct<CompilerDirective>(ignore_tkr) ||1332 construct<CompilerDirective>(loopCount) ||1333 construct<CompilerDirective>(assumeAligned) ||1334 construct<CompilerDirective>(vectorAlways) ||1335 construct<CompilerDirective>(unrollAndJam) ||1336 construct<CompilerDirective>(unroll) ||1337 construct<CompilerDirective>(prefetch) ||1338 construct<CompilerDirective>(novector) ||1339 construct<CompilerDirective>(nounrollAndJam) ||1340 construct<CompilerDirective>(nounroll) ||1341 construct<CompilerDirective>(noinlineDir) ||1342 construct<CompilerDirective>(forceinlineDir) ||1343 construct<CompilerDirective>(inlineDir) ||1344 construct<CompilerDirective>(ivdep) ||1345 construct<CompilerDirective>(1346 many(construct<CompilerDirective::NameValue>(1347 name, maybe(("="_tok || ":"_tok) >> digitString64))))) /1348 endOfStmt ||1349 construct<CompilerDirective>(pure<CompilerDirective::Unrecognized>()) /1350 SkipTo<'\n'>{}))1351 1352TYPE_PARSER(extension<LanguageFeature::CrayPointer>(1353 "nonstandard usage: based POINTER"_port_en_US,1354 construct<BasedPointerStmt>(1355 "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US,1356 construct<BasedPointer>("(" >> objectName / ",",1357 objectName, maybe(Parser<ArraySpec>{}) / ")")))))1358 1359// CUDA-attributes-stmt -> ATTRIBUTES (CUDA-data-attr) [::] name-list1360TYPE_PARSER(extension<LanguageFeature::CUDA>(construct<CUDAAttributesStmt>(1361 "ATTRIBUTES" >> parenthesized(Parser<common::CUDADataAttr>{}),1362 defaulted(1363 maybe("::"_tok) >> nonemptyList("expected names"_err_en_US, name)))))1364 1365// Subtle: A structure's name includes the surrounding slashes, which avoids1366// clashes with other uses of the name in the same scope.1367constexpr auto structureName{maybe(sourced("/" >> name / "/"))};1368 1369// Note that Parser<StructureStmt>{} has a mandatory list of entity-decls1370// and is used only by NestedStructureStmt{}.Parse() in user-state.cpp.1371TYPE_PARSER(construct<StructureStmt>("STRUCTURE" >> structureName,1372 localRecovery(1373 "entity declarations are required on a nested structure"_err_en_US,1374 nonemptyList(entityDecl), ok)))1375 1376constexpr auto nestedStructureDef{1377 CONTEXT_PARSER("nested STRUCTURE definition"_en_US,1378 construct<StructureDef>(statement(NestedStructureStmt{}),1379 many(Parser<StructureField>{}),1380 statement(construct<StructureDef::EndStructureStmt>(1381 "END STRUCTURE"_tok))))};1382 1383TYPE_PARSER(construct<StructureField>(statement(StructureComponents{})) ||1384 construct<StructureField>(indirect(Parser<Union>{})) ||1385 construct<StructureField>(indirect(nestedStructureDef)))1386 1387TYPE_CONTEXT_PARSER("STRUCTURE definition"_en_US,1388 extension<LanguageFeature::DECStructures>(1389 "nonstandard usage: STRUCTURE"_port_en_US,1390 construct<StructureDef>(1391 statement(construct<StructureStmt>(1392 "STRUCTURE" >> structureName, optionalList(entityDecl))),1393 many(Parser<StructureField>{}),1394 statement(construct<StructureDef::EndStructureStmt>(1395 "END STRUCTURE"_tok)))))1396 1397TYPE_CONTEXT_PARSER("UNION definition"_en_US,1398 construct<Union>(statement(construct<Union::UnionStmt>("UNION"_tok)),1399 many(Parser<Map>{}),1400 statement(construct<Union::EndUnionStmt>("END UNION"_tok))))1401 1402TYPE_CONTEXT_PARSER("MAP definition"_en_US,1403 construct<Map>(statement(construct<Map::MapStmt>("MAP"_tok)),1404 many(Parser<StructureField>{}),1405 statement(construct<Map::EndMapStmt>("END MAP"_tok))))1406 1407TYPE_CONTEXT_PARSER("arithmetic IF statement"_en_US,1408 deprecated<LanguageFeature::ArithmeticIF>(construct<ArithmeticIfStmt>(1409 "IF" >> parenthesized(expr), label / ",", label / ",", label)))1410 1411TYPE_CONTEXT_PARSER("ASSIGN statement"_en_US,1412 deprecated<LanguageFeature::Assign>(1413 construct<AssignStmt>("ASSIGN" >> label, "TO" >> name)))1414 1415TYPE_CONTEXT_PARSER("assigned GOTO statement"_en_US,1416 deprecated<LanguageFeature::AssignedGOTO>(construct<AssignedGotoStmt>(1417 "GO TO" >> name,1418 defaulted(maybe(","_tok) >>1419 parenthesized(nonemptyList("expected labels"_err_en_US, label))))))1420 1421TYPE_CONTEXT_PARSER("PAUSE statement"_en_US,1422 deprecated<LanguageFeature::Pause>(1423 construct<PauseStmt>("PAUSE" >> maybe(Parser<StopCode>{}))))1424 1425// These requirement productions are defined by the Fortran standard but never1426// used directly by the grammar:1427// R620 delimiter -> ( | ) | / | [ | ] | (/ | /)1428// R1027 numeric-expr -> expr1429// R1031 int-constant-expr -> int-expr1430// R1221 dtv-type-spec -> TYPE ( derived-type-spec ) |1431// CLASS ( derived-type-spec )1432//1433// These requirement productions are defined and used, but need not be1434// defined independently here in this file:1435// R771 lbracket -> [1436// R772 rbracket -> ]1437//1438// Further note that:1439// R607 int-constant -> constant1440// is used only once via R844 scalar-int-constant1441// R904 logical-variable -> variable1442// is used only via scalar-logical-variable1443// R906 default-char-variable -> variable1444// is used only via scalar-default-char-variable1445// R907 int-variable -> variable1446// is used only via scalar-int-variable1447// R915 complex-part-designator -> designator % RE | designator % IM1448// %RE and %IM are initially recognized as structure components1449// R916 type-param-inquiry -> designator % type-param-name1450// is occulted by structure component designators1451// R918 array-section ->1452// data-ref [( substring-range )] | complex-part-designator1453// is not used because parsing is not sensitive to rank1454// R1030 default-char-constant-expr -> default-char-expr1455// is only used via scalar-default-char-constant-expr1456} // namespace Fortran::parser1457