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-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 // Top-level grammar specification for Fortran. These parsers drive 10 // 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 combinator 13 // library used here to implement an LL recursive descent recognizer. 14 15 // The productions that follow are derived from the draft Fortran 2018 16 // standard, with some necessary modifications to remove left recursion 17 // and some generalization in order to defer cases where parses depend 18 // on the definitions of symbols. The "Rxxx" numbers that appear in 19 // 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 current 23 // C++ compilers than some people were willing to accept, so now the 24 // various per-type parsers are partitioned into several C++ source 25 // 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 statements 28 // expr-parsers.cpp Expressions 29 // io-parsers.cpp I/O statements and FORMAT 30 // openmp-parsers.cpp OpenMP directives 31 // program-parsers.cpp Program units 32 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 42 namespace Fortran::parser { 43 44 // R601 alphanumeric-character -> letter | digit | underscore 45 // R603 name -> letter [alphanumeric-character]... 46 constexpr auto nonDigitIdChar{letter || otherIdChar}; 47 constexpr auto rawName{nonDigitIdChar >> many(nonDigitIdChar || digit)}; 48 TYPE_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-op 53 // R610 extended-intrinsic-op -> intrinsic-operator 54 // These parsers must be ordered carefully to avoid misrecognition. 55 constexpr 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 79 constexpr 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-op 99 TYPE_PARSER(construct<DefinedOperator>(intrinsicOperator) || 100 construct<DefinedOperator>(definedOpName)) 101 102 // R505 implicit-part -> [implicit-part-stmt]... implicit-stmt 103 // N.B. PARAMETER, FORMAT, & ENTRY statements that appear before any 104 // other kind of declaration-construct will be parsed into the 105 // implicit-part. 106 TYPE_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-stmt 111 TYPE_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-subprogram 121 // Internal subprograms are not program units, so their END statements 122 // can be followed by ';' and another statement on the same line. 123 TYPE_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]... 130 TYPE_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-constant 139 TYPE_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 -> name 150 TYPE_PARSER(construct<NamedConstant>(name)) 151 152 // R701 type-param-value -> scalar-int-expr | * | : 153 TYPE_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-spec 158 // N.B. This type-spec production is one of two instances in the Fortran 159 // grammar where intrinsic types and bare derived type names can clash; 160 // the other is below in R703 declaration-type-spec. Look-ahead is required 161 // to disambiguate the cases where a derived type name begins with the name 162 // of an intrinsic type, e.g., REALITY. 163 TYPE_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 alternatives 172 // for TYPE (...), rather than putting the alternatives within it, which 173 // would fail on "TYPE(real_derived)" with a misrecognition of "real" as an 174 // intrinsic-type-spec. 175 // N.B. TYPE(x) is a derived type if x is a one-word extension intrinsic 176 // type (BYTE or DOUBLECOMPLEX), not the extension intrinsic type. 177 TYPE_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 of 195 // the structure includes the surrounding slashes to avoid 196 // 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, BYTE 206 TYPE_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 type 228 // VECTOR(intrinsic-type-spec) | __VECTOR_PAIR | __VECTOR_QUAD 229 TYPE_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) | 240 TYPE_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 type 247 TYPE_PARSER(construct<UnsignedTypeSpec>("UNSIGNED" >> maybe(kindSelector))) 248 249 // R705 integer-type-spec -> INTEGER [kind-selector] 250 TYPE_PARSER(construct<IntegerTypeSpec>("INTEGER" >> maybe(kindSelector))) 251 252 // R706 kind-selector -> ( [KIND =] scalar-int-constant-expr ) 253 // Legacy extension: kind-selector -> * digit-string 254 TYPE_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 261 constexpr auto noSpace{ 262 recovery(withMessage("invalid space"_err_en_US, !" "_ch), space)}; 263 264 // R707 signed-int-literal-constant -> [sign] int-literal-constant 265 TYPE_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 misrecognition 271 // when the digit string is a numeric kind parameter of a character literal. 272 TYPE_PARSER(construct<IntLiteralConstant>(space >> digitString / !"u"_ch, 273 maybe(underscore >> noSpace >> kindParam) / !underscore)) 274 275 // unsigned-literal-constant -> digit-string U [_ kind-param] 276 TYPE_PARSER(construct<UnsignedLiteralConstant>(space >> digitString / "u"_ch, 277 maybe(underscore >> noSpace >> kindParam) / !underscore)) 278 279 // R709 kind-param -> digit-string | scalar-int-constant-name 280 TYPE_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 form 286 // after the sign and before a real-literal-constant or 287 // complex-literal-constant. A sign is not a unary operator in these contexts. 288 constexpr auto sign{ 289 "+"_tok >> pure(Sign::Positive) || "-"_tok >> pure(Sign::Negative)}; 290 291 // R713 signed-real-literal-constant -> [sign] real-literal-constant 292 constexpr 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-string 299 // R716 exponent-letter -> E | D 300 // Extension: Q 301 // R717 exponent -> signed-digit-string 302 constexpr auto exponentPart{ 303 ("ed"_ch || 304 extension<LanguageFeature::QuadPrecision>( 305 "nonstandard usage: Q exponent"_port_en_US, "q"_ch)) >> 306 SignedDigitString{}}; 307 308 TYPE_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 ) 321 TYPE_CONTEXT_PARSER("COMPLEX literal constant"_en_US, 322 parenthesized(construct<ComplexLiteralConstant>( 323 Parser<ComplexPart>{} / ",", Parser<ComplexPart>{}))) 324 325 // PGI/Intel extension: signed complex literal constant 326 TYPE_PARSER(construct<SignedComplexLiteralConstant>( 327 sign, Parser<ComplexLiteralConstant>{})) 328 329 // R719 real-part -> 330 // signed-int-literal-constant | signed-real-literal-constant | 331 // named-constant 332 // R720 imag-part -> 333 // signed-int-literal-constant | signed-real-literal-constant | 334 // named-constant 335 TYPE_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] ) 344 TYPE_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 Standard 354 // only in the context of a type-declaration-stmt, but even with that 355 // limitation, it would seem to be unnecessary and buggy to consume the comma 356 // here. 357 TYPE_PARSER(construct<LengthSelector>( 358 parenthesized(maybe("LEN ="_tok) >> typeParamValue)) || 359 construct<LengthSelector>("*" >> charLength /* / maybe(","_tok) */)) 360 361 // R723 char-length -> ( type-param-value ) | digit-string 362 TYPE_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 are 369 // combined. Backslash escapes can be enabled. 370 // N.B. the parsing of "kind-param" takes care to not consume the '_'. 371 TYPE_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 377 TYPE_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. 383 TYPE_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-stmt 392 // R735 component-part -> [component-def-stmt]... 393 TYPE_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 )] 405 TYPE_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 ) 412 TYPE_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-stmt 419 TYPE_PARSER(construct<PrivateOrSequence>(Parser<PrivateStmt>{}) || 420 construct<PrivateOrSequence>(Parser<SequenceStmt>{})) 421 422 // R730 end-type-stmt -> END TYPE [type-name] 423 TYPE_PARSER(construct<EndTypeStmt>( 424 recovery("END TYPE" >> maybe(name), namedConstructEndStmtErrorRecovery))) 425 426 // R731 sequence-stmt -> SEQUENCE 427 TYPE_PARSER(construct<SequenceStmt>("SEQUENCE"_tok)) 428 429 // R732 type-param-def-stmt -> 430 // integer-type-spec , type-param-attr-spec :: type-param-decl-list 431 // R734 type-param-attr-spec -> KIND | LEN 432 constexpr auto kindOrLen{"KIND" >> pure(common::TypeParamAttr::Kind) || 433 "LEN" >> pure(common::TypeParamAttr::Len)}; 434 TYPE_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] 439 TYPE_PARSER(construct<TypeParamDecl>(name, maybe("=" >> scalarIntConstantExpr))) 440 441 // R736 component-def-stmt -> data-component-def-stmt | 442 // proc-component-def-stmt 443 // Accidental extension not enabled here: PGI accepts type-param-def-stmt in 444 // component-part of derived-type-def. 445 TYPE_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-list 455 // N.B. The standard requires double colons if there's an initializer. 456 TYPE_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-attr 466 TYPE_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] 486 TYPE_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. 493 TYPE_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)))) 498 TYPE_PARSER(construct<ComponentOrFill>(Parser<ComponentDecl>{}) || 499 construct<ComponentOrFill>(Parser<FillDecl>{})) 500 501 // R740 component-array-spec -> 502 // explicit-shape-spec-list | deferred-shape-spec-list 503 // N.B. Parenthesized here rather than around references to this production. 504 TYPE_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-list 511 // :: proc-decl-list 512 TYPE_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)] | POINTER 522 constexpr auto noPass{construct<NoPass>("NOPASS"_tok)}; 523 constexpr auto pass{construct<Pass>("PASS" >> maybe(parenthesized(name)))}; 524 TYPE_PARSER(construct<ProcComponentAttrSpec>(accessSpec) || 525 construct<ProcComponentAttrSpec>(noPass) || 526 construct<ProcComponentAttrSpec>(pass) || 527 construct<ProcComponentAttrSpec>(pointer)) 528 529 // R744 initial-data-target -> designator 530 constexpr auto initialDataTarget{indirect(designator)}; 531 532 // R743 component-initialization -> 533 // = constant-expr | => null-init | => initial-data-target 534 // R805 initialization -> 535 // = constant-expr | => null-init | => initial-data-target 536 // Universal extension: initialization -> / data-stmt-value-list / 537 TYPE_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 -> PRIVATE 548 // R747 binding-private-stmt -> PRIVATE 549 TYPE_PARSER(construct<PrivateStmt>("PRIVATE"_tok)) 550 551 // R746 type-bound-procedure-part -> 552 // contains-stmt [binding-private-stmt] [type-bound-proc-binding]... 553 TYPE_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-stmt 561 TYPE_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-list 572 // The "::" is required by the standard (C768) in the first production if 573 // any type-bound-proc-decl has a "=>', but it's not strictly necessary to 574 // avoid a bad parse. 575 TYPE_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] 601 TYPE_PARSER(construct<TypeBoundProcDecl>(name, maybe("=>" >> name))) 602 603 // R751 type-bound-generic-stmt -> 604 // GENERIC [, access-spec] :: generic-spec => binding-name-list 605 TYPE_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)] 611 TYPE_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-list 618 TYPE_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)] 622 TYPE_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-value 627 TYPE_PARSER(construct<TypeParamSpec>(maybe(keyword / "="), typeParamValue)) 628 629 // R756 structure-constructor -> derived-type-spec ( [component-spec-list] ) 630 TYPE_PARSER((construct<StructureConstructor>(derivedTypeSpec, 631 parenthesized(optionalList(Parser<ComponentSpec>{}))) || 632 // This alternative corrects misrecognition of the 633 // component-spec-list as the type-param-spec-list in 634 // 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-source 642 TYPE_PARSER(construct<ComponentSpec>( 643 maybe(keyword / "="), Parser<ComponentDataSource>{})) 644 645 // R758 component-data-source -> expr | data-target | proc-target 646 TYPE_PARSER(construct<ComponentDataSource>(indirect(expr))) 647 648 // R759 enum-def -> 649 // enum-def-stmt enumerator-def-stmt [enumerator-def-stmt]... 650 // end-enum-stmt 651 TYPE_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) 657 TYPE_PARSER(construct<EnumDefStmt>("ENUM , BIND ( C )"_tok)) 658 659 // R761 enumerator-def-stmt -> ENUMERATOR [::] enumerator-list 660 TYPE_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] 665 TYPE_PARSER( 666 construct<Enumerator>(namedConstant, maybe("=" >> scalarIntConstantExpr))) 667 668 // R763 end-enum-stmt -> END ENUM 669 TYPE_PARSER(recovery("END ENUM"_tok, constructEndStmtErrorRecovery) >> 670 construct<EndEnumStmt>()) 671 672 // R801 type-declaration-stmt -> 673 // declaration-type-spec [[, attr-spec]... ::] entity-decl-list 674 constexpr 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 */)}; 681 TYPE_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 colons 691 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-attr 705 TYPE_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 | UNIFIED 726 TYPE_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 -> name 735 constexpr 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] 743 TYPE_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() 749 TYPE_PARSER(lookAhead(name / "( )") >> construct<NullInit>(expr)) 750 751 // R807 access-spec -> PUBLIC | PRIVATE 752 TYPE_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-spec 758 TYPE_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-spec 763 // N.B. Bracketed here rather than around references, for consistency with 764 // array-spec. 765 TYPE_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 colons 771 inline int listLength(std::list<Success> &&xs) { return xs.size(); } 772 773 TYPE_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-expr 779 // R813 upper-cobound -> specification-expr 780 TYPE_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-spec 787 // N.B. Parenthesized here rather than around references to avoid 788 // a need for forced look-ahead. 789 // Shape specs that could be deferred-shape-spec or assumed-shape-spec 790 // (e.g. '(:,:)') are parsed as the former. 791 TYPE_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-bound 801 // R817 lower-bound -> specification-expr 802 // R818 upper-bound -> specification-expr 803 TYPE_PARSER(construct<ExplicitShapeSpec>( 804 maybe(specificationExpr / ":"), specificationExpr)) 805 806 // R819 assumed-shape-spec -> [lower-bound] : 807 TYPE_PARSER(construct<AssumedShapeSpec>(maybe(specificationExpr) / ":")) 808 809 // R820 deferred-shape-spec -> : 810 // deferred-shape-spec-list - just a list of colons 811 TYPE_PARSER(construct<DeferredShapeSpecList>( 812 applyFunction(listLength, nonemptyList(":"_tok)))) 813 814 // R821 assumed-implied-spec -> [lower-bound :] * 815 TYPE_PARSER(construct<AssumedImpliedSpec>(maybe(specificationExpr / ":") / "*")) 816 817 // R822 assumed-size-spec -> explicit-shape-spec-list , assumed-implied-spec 818 TYPE_PARSER(construct<AssumedSizeSpec>( 819 nonemptyList(explicitShapeSpec) / ",", assumedImpliedSpec)) 820 821 // R823 implied-shape-or-assumed-size-spec -> assumed-implied-spec 822 // R824 implied-shape-spec -> assumed-implied-spec , assumed-implied-spec-list 823 // I.e., when the assumed-implied-spec-list has a single item, it constitutes an 824 // implied-shape-or-assumed-size-spec; otherwise, an implied-shape-spec. 825 TYPE_PARSER(construct<ImpliedShapeSpec>(nonemptyList(assumedImpliedSpec))) 826 827 // R825 assumed-rank-spec -> .. 828 TYPE_PARSER(construct<AssumedRankSpec>(".."_tok)) 829 830 // R826 intent-spec -> IN | OUT | INOUT 831 TYPE_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] 836 TYPE_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-spec 842 // "access-name" is ambiguous with "generic-spec" 843 TYPE_PARSER(construct<AccessId>(indirect(genericSpec))) 844 845 // R829 allocatable-stmt -> ALLOCATABLE [::] allocatable-decl-list 846 TYPE_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] 854 TYPE_PARSER( 855 construct<ObjectDecl>(objectName, maybe(arraySpec), maybe(coarraySpec))) 856 857 // R831 asynchronous-stmt -> ASYNCHRONOUS [::] object-name-list 858 TYPE_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-list 862 TYPE_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 / 866 TYPE_PARSER(construct<BindEntity>(pure(BindEntity::Kind::Object), name) || 867 construct<BindEntity>("/" >> pure(BindEntity::Kind::Common), name / "/")) 868 869 // R834 codimension-stmt -> CODIMENSION [::] codimension-decl-list 870 TYPE_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 rbracket 875 TYPE_PARSER(construct<CodimensionDecl>(name, coarraySpec)) 876 877 // R836 contiguous-stmt -> CONTIGUOUS [::] object-name-list 878 TYPE_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]... 882 TYPE_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 / 887 TYPE_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-do 896 TYPE_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-variable 901 // = scalar-int-constant-expr , scalar-int-constant-expr 902 // [, scalar-int-constant-expr] ) 903 // R842 data-i-do-variable -> do-variable 904 TYPE_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-do 910 TYPE_PARSER(construct<DataIDoObject>(scalar(indirect(designator))) || 911 construct<DataIDoObject>(indirect(dataImpliedDo))) 912 913 // R843 data-stmt-value -> [data-stmt-repeat *] data-stmt-constant 914 TYPE_PARSER(construct<DataStmtValue>( 915 maybe(Parser<DataStmtRepeat>{} / "*"), Parser<DataStmtConstant>{})) 916 917 // R847 constant-subobject -> designator 918 // R846 int-constant-subobject -> constant-subobject 919 constexpr auto constantSubobject{constant(indirect(designator))}; 920 921 // R844 data-stmt-repeat -> scalar-int-constant | scalar-int-constant-subobject 922 // R607 int-constant -> constant 923 // Factored into: constant -> literal-constant -> int-literal-constant 924 // The named-constant alternative of constant is subsumed by constant-subobject 925 TYPE_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-constructor 933 // N.B. scalar-constant and scalar-constant-subobject are ambiguous with 934 // initial-data-target; null-init and structure-constructor are ambiguous 935 // in the absence of parameters and components; structure-constructor with 936 // components can be ambiguous with a scalar-constant-subobject. 937 // So we parse literal constants, designator, null-init, and 938 // structure-constructor, so that semantics can figure things out later 939 // with the symbol table. A literal constant substring must be attempted 940 // first to avoid a partial match with a literal constant. 941 TYPE_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 )]... 956 TYPE_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-list 962 TYPE_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-list 967 TYPE_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 names 972 TYPE_CONTEXT_PARSER("PARAMETER statement"_en_US, 973 construct<ParameterStmt>( 974 "PARAMETER" >> parenthesized(nonemptyList(Parser<NamedConstantDef>{})))) 975 TYPE_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-expr 982 TYPE_PARSER(construct<NamedConstantDef>(namedConstant, "=" >> constantExpr)) 983 984 // R853 pointer-stmt -> POINTER [::] pointer-decl-list 985 TYPE_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-name 991 TYPE_PARSER( 992 construct<PointerDecl>(name, maybe(parenthesized(deferredShapeSpecList)))) 993 994 // R855 protected-stmt -> PROTECTED [::] entity-name-list 995 TYPE_PARSER( 996 construct<ProtectedStmt>("PROTECTED" >> maybe("::"_tok) >> listOfNames)) 997 998 // R856 save-stmt -> SAVE [[::] saved-entity-list] 999 TYPE_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 -> name 1006 TYPE_PARSER(construct<SavedEntity>(pure(SavedEntity::Kind::Entity), name) || 1007 construct<SavedEntity>("/" >> pure(SavedEntity::Kind::Common), name / "/")) 1008 1009 // R859 target-stmt -> TARGET [::] target-decl-list 1010 TYPE_PARSER(construct<TargetStmt>("TARGET" >> maybe("::"_tok) >> 1011 nonemptyList("expected objects"_err_en_US, Parser<ObjectDecl>{}))) 1012 1013 // R861 value-stmt -> VALUE [::] dummy-arg-name-list 1014 TYPE_PARSER(construct<ValueStmt>("VALUE" >> maybe("::"_tok) >> listOfNames)) 1015 1016 // R862 volatile-stmt -> VOLATILE [::] object-name-list 1017 TYPE_PARSER(construct<VolatileStmt>("VOLATILE" >> maybe("::"_tok) >> 1018 nonemptyList("expected object names"_err_en_US, objectName))) 1019 1020 // R866 implicit-name-spec -> EXTERNAL | TYPE 1021 constexpr 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] )] 1028 TYPE_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 misrecognition 1037 // of a letter-spec as a simple parenthesized expression for kind or character 1038 // 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 only 1040 // types with optional parenthesized kind/length expressions, so derived 1041 // type specs, DOUBLE PRECISION, and DOUBLE COMPLEX need not be considered. 1042 constexpr auto noKindSelector{construct<std::optional<KindSelector>>()}; 1043 constexpr 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 1058 TYPE_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] 1064 TYPE_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 , ALL 1071 TYPE_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-list 1083 // [[,] / namelist-group-name / namelist-group-object-list]... 1084 // R869 namelist-group-object -> variable-name 1085 TYPE_PARSER(construct<NamelistStmt>("NAMELIST" >> 1086 nonemptySeparated( 1087 construct<NamelistStmt::Group>("/" >> name / "/", listOfNames), 1088 maybe(","_tok)))) 1089 1090 // R870 equivalence-stmt -> EQUIVALENCE equivalence-set-list 1091 // R871 equivalence-set -> ( equivalence-object , equivalence-object-list ) 1092 TYPE_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 | substring 1098 TYPE_PARSER(construct<EquivalenceObject>(indirect(designator))) 1099 1100 // R873 common-stmt -> 1101 // COMMON [/ [common-block-name] /] common-block-object-list 1102 // [[,] / [common-block-name] / common-block-object-list]... 1103 TYPE_PARSER( 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 )] 1113 TYPE_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 | substring 1118 // The Standard's productions for designator and its alternatives are 1119 // ambiguous without recourse to a symbol table. Many of the alternatives 1120 // 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), and 1127 // maybe an [image-selector]. 1128 // If it's a substring, it ends with (substring-range). 1129 TYPE_CONTEXT_PARSER("designator"_en_US, 1130 sourced(construct<Designator>(substring) || construct<Designator>(dataRef))) 1131 1132 constexpr auto percentOrDot{"%"_tok || 1133 // legacy VAX extension for RECORD field access 1134 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-reference 1139 // This production appears to be left-recursive in the grammar via 1140 // function-reference -> procedure-designator -> proc-component-ref -> 1141 // scalar-variable 1142 // and would be so if we were to allow functions to be called via procedure 1143 // pointer components within derived type results of other function references 1144 // (a reasonable extension, esp. in the case of procedure pointer components 1145 // that are NOPASS). However, Fortran constrains the use of a variable in a 1146 // proc-component-ref to be a data-ref without coindices (C1027). 1147 // Some array element references will be misrecognized as function references. 1148 constexpr auto noMoreAddressing{!"("_tok >> !"["_tok >> !percentOrDot}; 1149 TYPE_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-constant 1158 TYPE_PARSER( 1159 construct<Substring>(dataRef, parenthesized(Parser<SubstringRange>{}))) 1160 1161 TYPE_PARSER(construct<CharLiteralConstantSubstring>( 1162 charLiteralConstant, parenthesized(Parser<SubstringRange>{}))) 1163 1164 TYPE_PARSER(sourced(construct<SubstringInquiry>(Parser<Substring>{}) / 1165 ("%LEN"_tok || "%KIND"_tok))) 1166 1167 // R910 substring-range -> [scalar-int-expr] : [scalar-int-expr] 1168 TYPE_PARSER(construct<SubstringRange>( 1169 maybe(scalarIntExpr), ":" >> maybe(scalarIntExpr))) 1170 1171 // R911 data-ref -> part-ref [% part-ref]... 1172 // R914 coindexed-named-object -> data-ref 1173 // R917 array-element -> data-ref 1174 TYPE_PARSER( 1175 construct<DataRef>(nonemptySeparated(Parser<PartRef>{}, percentOrDot))) 1176 1177 // R912 part-ref -> part-name [( section-subscript-list )] [image-selector] 1178 TYPE_PARSER(construct<PartRef>(name, 1179 defaulted( 1180 parenthesized(nonemptyList(Parser<SectionSubscript>{})) / !"=>"_tok), 1181 maybe(Parser<ImageSelector>{}))) 1182 1183 // R913 structure-component -> data-ref 1184 // The final part-ref in the data-ref is not allowed to have subscripts. 1185 TYPE_CONTEXT_PARSER("component"_en_US, 1186 construct<StructureComponent>( 1187 construct<DataRef>(some(Parser<PartRef>{} / percentOrDot)), name)) 1188 1189 // R919 subscript -> scalar-int-expr 1190 constexpr auto subscript{scalarIntExpr}; 1191 1192 // R920 section-subscript -> subscript | subscript-triplet | vector-subscript 1193 // R923 vector-subscript -> int-expr 1194 // N.B. The distinction that needs to be made between "subscript" and 1195 // "vector-subscript" is deferred to semantic analysis. 1196 TYPE_PARSER(construct<SectionSubscript>(Parser<SubscriptTriplet>{}) || 1197 construct<SectionSubscript>(intExpr)) 1198 1199 // R921 subscript-triplet -> [subscript] : [subscript] [: stride] 1200 TYPE_PARSER(construct<SubscriptTriplet>( 1201 maybe(subscript), ":" >> maybe(subscript), maybe(":" >> subscript))) 1202 1203 // R925 cosubscript -> scalar-int-expr 1204 constexpr auto cosubscript{scalarIntExpr}; 1205 1206 // R924 image-selector -> 1207 // lbracket cosubscript-list [, image-selector-spec-list] rbracket 1208 TYPE_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 TYPE_PARSER(construct<ImageSelectorSpec>(construct<ImageSelectorSpec::Stat>( 1217 "STAT =" >> scalar(integer(indirect(variable))))) || 1218 construct<ImageSelectorSpec>(construct<TeamValue>("TEAM =" >> teamValue)) || 1219 construct<ImageSelectorSpec>(construct<ImageSelectorSpec::Team_Number>( 1220 "TEAM_NUMBER =" >> scalarIntExpr))) 1221 1222 // R927 allocate-stmt -> 1223 // ALLOCATE ( [type-spec ::] allocation-list [, alloc-opt-list] ) 1224 TYPE_CONTEXT_PARSER("ALLOCATE statement"_en_US, 1225 construct<AllocateStmt>("ALLOCATE (" >> maybe(typeSpec / "::"), 1226 nonemptyList(Parser<Allocation>{}), 1227 defaulted("," >> nonemptyList(Parser<AllocOpt>{})) / ")")) 1228 1229 // R928 alloc-opt -> 1230 // ERRMSG = errmsg-variable | MOLD = source-expr | 1231 // SOURCE = source-expr | STAT = stat-variable | 1232 // (CUDA) STREAM = scalar-int-expr 1233 // PINNED = scalar-logical-variable 1234 // R931 source-expr -> expr 1235 TYPE_PARSER(construct<AllocOpt>( 1236 construct<AllocOpt::Mold>("MOLD =" >> indirect(expr))) || 1237 construct<AllocOpt>( 1238 construct<AllocOpt::Source>("SOURCE =" >> indirect(expr))) || 1239 construct<AllocOpt>(statOrErrmsg) || 1240 extension<LanguageFeature::CUDA>( 1241 construct<AllocOpt>(construct<AllocOpt::Stream>( 1242 "STREAM =" >> indirect(scalarIntExpr))) || 1243 construct<AllocOpt>(construct<AllocOpt::Pinned>( 1244 "PINNED =" >> indirect(scalarLogicalVariable))))) 1245 1246 // R929 stat-variable -> scalar-int-variable 1247 TYPE_PARSER(construct<StatVariable>(scalar(integer(variable)))) 1248 1249 // R932 allocation -> 1250 // allocate-object [( allocate-shape-spec-list )] 1251 // [lbracket allocate-coarray-spec rbracket] 1252 TYPE_PARSER(construct<Allocation>(Parser<AllocateObject>{}, 1253 defaulted(parenthesized(nonemptyList(Parser<AllocateShapeSpec>{}))), 1254 maybe(bracketed(Parser<AllocateCoarraySpec>{})))) 1255 1256 // R933 allocate-object -> variable-name | structure-component 1257 TYPE_PARSER(construct<AllocateObject>(structureComponent) || 1258 construct<AllocateObject>(name / !"="_tok)) 1259 1260 // R934 allocate-shape-spec -> [lower-bound-expr :] upper-bound-expr 1261 // R938 allocate-coshape-spec -> [lower-bound-expr :] upper-bound-expr 1262 TYPE_PARSER(construct<AllocateShapeSpec>(maybe(boundExpr / ":"), boundExpr)) 1263 1264 // R937 allocate-coarray-spec -> 1265 // [allocate-coshape-spec-list ,] [lower-bound-expr :] * 1266 TYPE_PARSER(construct<AllocateCoarraySpec>( 1267 defaulted(nonemptyList(Parser<AllocateShapeSpec>{}) / ","), 1268 maybe(boundExpr / ":") / "*")) 1269 1270 // R939 nullify-stmt -> NULLIFY ( pointer-object-list ) 1271 TYPE_CONTEXT_PARSER("NULLIFY statement"_en_US, 1272 "NULLIFY" >> parenthesized(construct<NullifyStmt>( 1273 nonemptyList(Parser<PointerObject>{})))) 1274 1275 // R940 pointer-object -> 1276 // variable-name | structure-component | proc-pointer-name 1277 TYPE_PARSER(construct<PointerObject>(structureComponent) || 1278 construct<PointerObject>(name)) 1279 1280 // R941 deallocate-stmt -> 1281 // DEALLOCATE ( allocate-object-list [, dealloc-opt-list] ) 1282 TYPE_CONTEXT_PARSER("DEALLOCATE statement"_en_US, 1283 construct<DeallocateStmt>( 1284 "DEALLOCATE (" >> nonemptyList(Parser<AllocateObject>{}), 1285 defaulted("," >> nonemptyList(statOrErrmsg)) / ")")) 1286 1287 // R942 dealloc-opt -> STAT = stat-variable | ERRMSG = errmsg-variable 1288 // R1165 sync-stat -> STAT = stat-variable | ERRMSG = errmsg-variable 1289 TYPE_PARSER(construct<StatOrErrmsg>("STAT =" >> statVariable) || 1290 construct<StatOrErrmsg>("ERRMSG =" >> msgVariable)) 1291 1292 // Directives, extensions, and deprecated statements 1293 // !DIR$ IGNORE_TKR [ [(tkrdmac...)] name ]... 1294 // !DIR$ LOOP COUNT (n1[, n2]...) 1295 // !DIR$ name[=value] [, name[=value]]... 1296 // !DIR$ UNROLL [n] 1297 // !DIR$ <anything else> 1298 constexpr auto ignore_tkr{ 1299 "IGNORE_TKR" >> optionalList(construct<CompilerDirective::IgnoreTKR>( 1300 maybe(parenthesized(many(letter))), name))}; 1301 constexpr auto loopCount{ 1302 "LOOP COUNT" >> construct<CompilerDirective::LoopCount>( 1303 parenthesized(nonemptyList(digitString64)))}; 1304 constexpr auto assumeAligned{"ASSUME_ALIGNED" >> 1305 optionalList(construct<CompilerDirective::AssumeAligned>( 1306 indirect(designator), ":"_tok >> digitString64))}; 1307 constexpr auto vectorAlways{ 1308 "VECTOR ALWAYS" >> construct<CompilerDirective::VectorAlways>()}; 1309 constexpr auto unroll{ 1310 "UNROLL" >> construct<CompilerDirective::Unroll>(maybe(digitString64))}; 1311 TYPE_PARSER(beginDirective >> "DIR$ "_tok >> 1312 sourced((construct<CompilerDirective>(ignore_tkr) || 1313 construct<CompilerDirective>(loopCount) || 1314 construct<CompilerDirective>(assumeAligned) || 1315 construct<CompilerDirective>(vectorAlways) || 1316 construct<CompilerDirective>(unroll) || 1317 construct<CompilerDirective>( 1318 many(construct<CompilerDirective::NameValue>( 1319 name, maybe(("="_tok || ":"_tok) >> digitString64))))) / 1320 endOfStmt || 1321 construct<CompilerDirective>(pure<CompilerDirective::Unrecognized>()) / 1322 SkipTo<'\n'>{})) 1323 1324 TYPE_PARSER(extension<LanguageFeature::CrayPointer>( 1325 "nonstandard usage: based POINTER"_port_en_US, 1326 construct<BasedPointerStmt>( 1327 "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US, 1328 construct<BasedPointer>("(" >> objectName / ",", 1329 objectName, maybe(Parser<ArraySpec>{}) / ")"))))) 1330 1331 // CUDA-attributes-stmt -> ATTRIBUTES (CUDA-data-attr) [::] name-list 1332 TYPE_PARSER(extension<LanguageFeature::CUDA>(construct<CUDAAttributesStmt>( 1333 "ATTRIBUTES" >> parenthesized(Parser<common::CUDADataAttr>{}), 1334 defaulted( 1335 maybe("::"_tok) >> nonemptyList("expected names"_err_en_US, name))))) 1336 1337 // Subtle: A structure's name includes the surrounding slashes, which avoids 1338 // clashes with other uses of the name in the same scope. 1339 constexpr auto structureName{maybe(sourced("/" >> name / "/"))}; 1340 1341 // Note that Parser<StructureStmt>{} has a mandatory list of entity-decls 1342 // and is used only by NestedStructureStmt{}.Parse() in user-state.cpp. 1343 TYPE_PARSER(construct<StructureStmt>("STRUCTURE" >> structureName, 1344 localRecovery( 1345 "entity declarations are required on a nested structure"_err_en_US, 1346 nonemptyList(entityDecl), ok))) 1347 1348 constexpr auto nestedStructureDef{ 1349 CONTEXT_PARSER("nested STRUCTURE definition"_en_US, 1350 construct<StructureDef>(statement(NestedStructureStmt{}), 1351 many(Parser<StructureField>{}), 1352 statement(construct<StructureDef::EndStructureStmt>( 1353 "END STRUCTURE"_tok))))}; 1354 1355 TYPE_PARSER(construct<StructureField>(statement(StructureComponents{})) || 1356 construct<StructureField>(indirect(Parser<Union>{})) || 1357 construct<StructureField>(indirect(nestedStructureDef))) 1358 1359 TYPE_CONTEXT_PARSER("STRUCTURE definition"_en_US, 1360 extension<LanguageFeature::DECStructures>( 1361 "nonstandard usage: STRUCTURE"_port_en_US, 1362 construct<StructureDef>( 1363 statement(construct<StructureStmt>( 1364 "STRUCTURE" >> structureName, optionalList(entityDecl))), 1365 many(Parser<StructureField>{}), 1366 statement(construct<StructureDef::EndStructureStmt>( 1367 "END STRUCTURE"_tok))))) 1368 1369 TYPE_CONTEXT_PARSER("UNION definition"_en_US, 1370 construct<Union>(statement(construct<Union::UnionStmt>("UNION"_tok)), 1371 many(Parser<Map>{}), 1372 statement(construct<Union::EndUnionStmt>("END UNION"_tok)))) 1373 1374 TYPE_CONTEXT_PARSER("MAP definition"_en_US, 1375 construct<Map>(statement(construct<Map::MapStmt>("MAP"_tok)), 1376 many(Parser<StructureField>{}), 1377 statement(construct<Map::EndMapStmt>("END MAP"_tok)))) 1378 1379 TYPE_CONTEXT_PARSER("arithmetic IF statement"_en_US, 1380 deprecated<LanguageFeature::ArithmeticIF>(construct<ArithmeticIfStmt>( 1381 "IF" >> parenthesized(expr), label / ",", label / ",", label))) 1382 1383 TYPE_CONTEXT_PARSER("ASSIGN statement"_en_US, 1384 deprecated<LanguageFeature::Assign>( 1385 construct<AssignStmt>("ASSIGN" >> label, "TO" >> name))) 1386 1387 TYPE_CONTEXT_PARSER("assigned GOTO statement"_en_US, 1388 deprecated<LanguageFeature::AssignedGOTO>(construct<AssignedGotoStmt>( 1389 "GO TO" >> name, 1390 defaulted(maybe(","_tok) >> 1391 parenthesized(nonemptyList("expected labels"_err_en_US, label)))))) 1392 1393 TYPE_CONTEXT_PARSER("PAUSE statement"_en_US, 1394 deprecated<LanguageFeature::Pause>( 1395 construct<PauseStmt>("PAUSE" >> maybe(Parser<StopCode>{})))) 1396 1397 // These requirement productions are defined by the Fortran standard but never 1398 // used directly by the grammar: 1399 // R620 delimiter -> ( | ) | / | [ | ] | (/ | /) 1400 // R1027 numeric-expr -> expr 1401 // R1031 int-constant-expr -> int-expr 1402 // R1221 dtv-type-spec -> TYPE ( derived-type-spec ) | 1403 // CLASS ( derived-type-spec ) 1404 // 1405 // These requirement productions are defined and used, but need not be 1406 // defined independently here in this file: 1407 // R771 lbracket -> [ 1408 // R772 rbracket -> ] 1409 // 1410 // Further note that: 1411 // R607 int-constant -> constant 1412 // is used only once via R844 scalar-int-constant 1413 // R904 logical-variable -> variable 1414 // is used only via scalar-logical-variable 1415 // R906 default-char-variable -> variable 1416 // is used only via scalar-default-char-variable 1417 // R907 int-variable -> variable 1418 // is used only via scalar-int-variable 1419 // R915 complex-part-designator -> designator % RE | designator % IM 1420 // %RE and %IM are initially recognized as structure components 1421 // R916 type-param-inquiry -> designator % type-param-name 1422 // is occulted by structure component designators 1423 // R918 array-section -> 1424 // data-ref [( substring-range )] | complex-part-designator 1425 // is not used because parsing is not sensitive to rank 1426 // R1030 default-char-constant-expr -> default-char-expr 1427 // is only used via scalar-default-char-constant-expr 1428 } // namespace Fortran::parser 1429