//===-- lib/Parser/Fortran-parsers.cpp ------------------------------------===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// // Top-level grammar specification for Fortran. These parsers drive // the tokenization parsers in cooked-tokens.h to consume characters, // recognize the productions of Fortran, and to construct a parse tree. // See ParserCombinators.md for documentation on the parser combinator // library used here to implement an LL recursive descent recognizer. // The productions that follow are derived from the draft Fortran 2018 // standard, with some necessary modifications to remove left recursion // and some generalization in order to defer cases where parses depend // on the definitions of symbols. The "Rxxx" numbers that appear in // comments refer to these numbered requirements in the Fortran standard. // The whole Fortran grammar originally constituted one header file, // but that turned out to require more memory to compile with current // C++ compilers than some people were willing to accept, so now the // various per-type parsers are partitioned into several C++ source // files. This file contains parsers for constants, types, declarations, // and misfits (mostly clauses 7, 8, & 9 of Fortran 2018). The others: // executable-parsers.cpp Executable statements // expr-parsers.cpp Expressions // io-parsers.cpp I/O statements and FORMAT // openmp-parsers.cpp OpenMP directives // program-parsers.cpp Program units #include "basic-parsers.h" #include "expr-parsers.h" #include "misc-parsers.h" #include "stmt-parser.h" #include "token-parsers.h" #include "type-parser-implementation.h" #include "flang/Parser/parse-tree.h" #include "flang/Parser/user-state.h" namespace Fortran::parser { // R601 alphanumeric-character -> letter | digit | underscore // R603 name -> letter [alphanumeric-character]... constexpr auto nonDigitIdChar{letter || otherIdChar}; constexpr auto rawName{nonDigitIdChar >> many(nonDigitIdChar || digit)}; TYPE_PARSER(space >> sourced(rawName >> construct())) // R608 intrinsic-operator -> // power-op | mult-op | add-op | concat-op | rel-op | // not-op | and-op | or-op | equiv-op // R610 extended-intrinsic-op -> intrinsic-operator // These parsers must be ordered carefully to avoid misrecognition. constexpr auto namedIntrinsicOperator{ ".LT." >> pure(DefinedOperator::IntrinsicOperator::LT) || ".LE." >> pure(DefinedOperator::IntrinsicOperator::LE) || ".EQ." >> pure(DefinedOperator::IntrinsicOperator::EQ) || ".NE." >> pure(DefinedOperator::IntrinsicOperator::NE) || ".GE." >> pure(DefinedOperator::IntrinsicOperator::GE) || ".GT." >> pure(DefinedOperator::IntrinsicOperator::GT) || ".NOT." >> pure(DefinedOperator::IntrinsicOperator::NOT) || ".AND." >> pure(DefinedOperator::IntrinsicOperator::AND) || ".OR." >> pure(DefinedOperator::IntrinsicOperator::OR) || ".EQV." >> pure(DefinedOperator::IntrinsicOperator::EQV) || ".NEQV." >> pure(DefinedOperator::IntrinsicOperator::NEQV) || extension( "nonstandard usage: .XOR. spelling of .NEQV."_port_en_US, ".XOR." >> pure(DefinedOperator::IntrinsicOperator::NEQV)) || extension( "nonstandard usage: abbreviated logical operator"_port_en_US, ".N." >> pure(DefinedOperator::IntrinsicOperator::NOT) || ".A." >> pure(DefinedOperator::IntrinsicOperator::AND) || ".O." >> pure(DefinedOperator::IntrinsicOperator::OR) || extension( "nonstandard usage: .X. spelling of .NEQV."_port_en_US, ".X." >> pure(DefinedOperator::IntrinsicOperator::NEQV)))}; constexpr auto intrinsicOperator{ "**" >> pure(DefinedOperator::IntrinsicOperator::Power) || "*" >> pure(DefinedOperator::IntrinsicOperator::Multiply) || "//" >> pure(DefinedOperator::IntrinsicOperator::Concat) || "/=" >> pure(DefinedOperator::IntrinsicOperator::NE) || "/" >> pure(DefinedOperator::IntrinsicOperator::Divide) || "+" >> pure(DefinedOperator::IntrinsicOperator::Add) || "-" >> pure(DefinedOperator::IntrinsicOperator::Subtract) || "<=" >> pure(DefinedOperator::IntrinsicOperator::LE) || extension( "nonstandard usage: <> spelling of /= or .NE."_port_en_US, "<>" >> pure(DefinedOperator::IntrinsicOperator::NE)) || "<" >> pure(DefinedOperator::IntrinsicOperator::LT) || "==" >> pure(DefinedOperator::IntrinsicOperator::EQ) || ">=" >> pure(DefinedOperator::IntrinsicOperator::GE) || ">" >> pure(DefinedOperator::IntrinsicOperator::GT) || namedIntrinsicOperator}; // R609 defined-operator -> // defined-unary-op | defined-binary-op | extended-intrinsic-op TYPE_PARSER(construct(intrinsicOperator) || construct(definedOpName)) // R505 implicit-part -> [implicit-part-stmt]... implicit-stmt // N.B. PARAMETER, FORMAT, & ENTRY statements that appear before any // other kind of declaration-construct will be parsed into the // implicit-part. TYPE_CONTEXT_PARSER("implicit part"_en_US, construct(many(Parser{}))) // R506 implicit-part-stmt -> // implicit-stmt | parameter-stmt | format-stmt | entry-stmt TYPE_PARSER(first( construct(statement(indirect(Parser{}))), construct(statement(indirect(parameterStmt))), construct(statement(indirect(oldParameterStmt))), construct(statement(indirect(formatStmt))), construct(statement(indirect(entryStmt))), construct(indirect(compilerDirective)), construct(indirect(openaccDeclarativeConstruct)))) // R512 internal-subprogram -> function-subprogram | subroutine-subprogram // Internal subprograms are not program units, so their END statements // can be followed by ';' and another statement on the same line. TYPE_CONTEXT_PARSER("internal subprogram"_en_US, (construct(indirect(functionSubprogram)) || construct(indirect(subroutineSubprogram))) / forceEndOfStmt) // R511 internal-subprogram-part -> contains-stmt [internal-subprogram]... TYPE_CONTEXT_PARSER("internal subprogram part"_en_US, construct(statement(containsStmt), many(StartNewSubprogram{} >> Parser{}))) // R605 literal-constant -> // int-literal-constant | real-literal-constant | // complex-literal-constant | logical-literal-constant | // char-literal-constant | boz-literal-constant TYPE_PARSER( first(construct(Parser{}), construct(realLiteralConstant), construct(intLiteralConstant), construct(Parser{}), construct(Parser{}), construct(charLiteralConstant), construct(Parser{}))) // R606 named-constant -> name TYPE_PARSER(construct(name)) // R701 type-param-value -> scalar-int-expr | * | : TYPE_PARSER(construct(scalarIntExpr) || construct(star) || construct(construct(":"_tok))) // R702 type-spec -> intrinsic-type-spec | derived-type-spec // N.B. This type-spec production is one of two instances in the Fortran // grammar where intrinsic types and bare derived type names can clash; // the other is below in R703 declaration-type-spec. Look-ahead is required // to disambiguate the cases where a derived type name begins with the name // of an intrinsic type, e.g., REALITY. TYPE_CONTEXT_PARSER("type spec"_en_US, construct(intrinsicTypeSpec / lookAhead("::"_tok || ")"_tok)) || construct(derivedTypeSpec)) // R703 declaration-type-spec -> // intrinsic-type-spec | TYPE ( intrinsic-type-spec ) | // TYPE ( derived-type-spec ) | CLASS ( derived-type-spec ) | // CLASS ( * ) | TYPE ( * ) // N.B. It is critical to distribute "parenthesized()" over the alternatives // for TYPE (...), rather than putting the alternatives within it, which // would fail on "TYPE(real_derived)" with a misrecognition of "real" as an // intrinsic-type-spec. // N.B. TYPE(x) is a derived type if x is a one-word extension intrinsic // type (BYTE or DOUBLECOMPLEX), not the extension intrinsic type. TYPE_CONTEXT_PARSER("declaration type spec"_en_US, construct(intrinsicTypeSpec) || "TYPE" >> (parenthesized(construct( !"DOUBLECOMPLEX"_tok >> !"BYTE"_tok >> intrinsicTypeSpec)) || parenthesized(construct( construct(derivedTypeSpec))) || construct( "( * )" >> construct())) || "CLASS" >> parenthesized(construct( construct( derivedTypeSpec)) || construct("*" >> construct())) || extension( "nonstandard usage: STRUCTURE"_port_en_US, construct( // As is also done for the STRUCTURE statement, the name of // the structure includes the surrounding slashes to avoid // name clashes. construct( "RECORD" >> sourced("/" >> name / "/")))) || construct(vectorTypeSpec)) // R704 intrinsic-type-spec -> // integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION | // COMPLEX [kind-selector] | CHARACTER [char-selector] | // LOGICAL [kind-selector] // Extensions: DOUBLE COMPLEX, BYTE TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US, first(construct(integerTypeSpec), construct( construct("REAL" >> maybe(kindSelector))), construct("DOUBLE PRECISION" >> construct()), construct(construct( "COMPLEX" >> maybe(kindSelector))), construct(construct( "CHARACTER" >> maybe(Parser{}))), construct(construct( "LOGICAL" >> maybe(kindSelector))), extension( "nonstandard usage: DOUBLE COMPLEX"_port_en_US, construct("DOUBLE COMPLEX"_sptok >> construct())), extension("nonstandard usage: BYTE"_port_en_US, construct(construct( "BYTE" >> construct>(pure(1))))))) // Extension: Vector type // VECTOR(intrinsic-type-spec) | __VECTOR_PAIR | __VECTOR_QUAD TYPE_CONTEXT_PARSER("vector type spec"_en_US, extension( "nonstandard usage: Vector type"_port_en_US, first(construct(intrinsicVectorTypeSpec), construct("__VECTOR_PAIR" >> construct()), construct("__VECTOR_QUAD" >> construct())))) // VECTOR(integer-type-spec) | VECTOR(real-type-spec) | // VECTOR(unsigend-type-spec) | TYPE_PARSER(construct("VECTOR" >> parenthesized(construct(integerTypeSpec) || construct(unsignedTypeSpec) || construct(construct( "REAL" >> maybe(kindSelector)))))) // UNSIGNED type TYPE_PARSER(construct("UNSIGNED" >> maybe(kindSelector))) // R705 integer-type-spec -> INTEGER [kind-selector] TYPE_PARSER(construct("INTEGER" >> maybe(kindSelector))) // R706 kind-selector -> ( [KIND =] scalar-int-constant-expr ) // Legacy extension: kind-selector -> * digit-string TYPE_PARSER(construct( parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) || extension( "nonstandard usage: TYPE*KIND syntax"_port_en_US, construct(construct( "*" >> digitString64 / spaceCheck)))) constexpr auto noSpace{ recovery(withMessage("invalid space"_err_en_US, !" "_ch), space)}; // R707 signed-int-literal-constant -> [sign] int-literal-constant TYPE_PARSER(sourced( construct(SignedIntLiteralConstantWithoutKind{}, maybe(noSpace >> underscore >> noSpace >> kindParam)))) // R708 int-literal-constant -> digit-string [_ kind-param] // The negated look-ahead for a trailing underscore prevents misrecognition // when the digit string is a numeric kind parameter of a character literal. TYPE_PARSER(construct(space >> digitString, maybe(underscore >> noSpace >> kindParam) / !underscore)) // R709 kind-param -> digit-string | scalar-int-constant-name TYPE_PARSER(construct(digitString64) || construct( scalar(integer(constant(sourced(rawName >> construct())))))) // R712 sign -> + | - // N.B. A sign constitutes a whole token, so a space is allowed in free form // after the sign and before a real-literal-constant or // complex-literal-constant. A sign is not a unary operator in these contexts. constexpr auto sign{ "+"_tok >> pure(Sign::Positive) || "-"_tok >> pure(Sign::Negative)}; // R713 signed-real-literal-constant -> [sign] real-literal-constant constexpr auto signedRealLiteralConstant{ construct(maybe(sign), realLiteralConstant)}; // R714 real-literal-constant -> // significand [exponent-letter exponent] [_ kind-param] | // digit-string exponent-letter exponent [_ kind-param] // R715 significand -> digit-string . [digit-string] | . digit-string // R716 exponent-letter -> E | D // Extension: Q // R717 exponent -> signed-digit-string constexpr auto exponentPart{ ("ed"_ch || extension( "nonstandard usage: Q exponent"_port_en_US, "q"_ch)) >> SignedDigitString{}}; TYPE_CONTEXT_PARSER("REAL literal constant"_en_US, space >> construct( sourced((digitString >> "."_ch >> !(some(letter) >> "."_ch /* don't misinterpret 1.AND. */) >> maybe(digitString) >> maybe(exponentPart) >> ok || "."_ch >> digitString >> maybe(exponentPart) >> ok || digitString >> exponentPart >> ok) >> construct()), maybe(noSpace >> underscore >> noSpace >> kindParam))) // R718 complex-literal-constant -> ( real-part , imag-part ) TYPE_CONTEXT_PARSER("COMPLEX literal constant"_en_US, parenthesized(construct( Parser{} / ",", Parser{}))) // PGI/Intel extension: signed complex literal constant TYPE_PARSER(construct( sign, Parser{})) // R719 real-part -> // signed-int-literal-constant | signed-real-literal-constant | // named-constant // R720 imag-part -> // signed-int-literal-constant | signed-real-literal-constant | // named-constant TYPE_PARSER(construct(signedRealLiteralConstant) || construct(signedIntLiteralConstant) || construct(namedConstant)) // R721 char-selector -> // length-selector | // ( LEN = type-param-value , KIND = scalar-int-constant-expr ) | // ( type-param-value , [KIND =] scalar-int-constant-expr ) | // ( KIND = scalar-int-constant-expr [, LEN = type-param-value] ) TYPE_PARSER(construct(Parser{}) || parenthesized(construct( "LEN =" >> typeParamValue, ", KIND =" >> scalarIntConstantExpr)) || parenthesized(construct( typeParamValue / ",", maybe("KIND ="_tok) >> scalarIntConstantExpr)) || parenthesized(construct( "KIND =" >> scalarIntConstantExpr, maybe(", LEN =" >> typeParamValue)))) // R722 length-selector -> ( [LEN =] type-param-value ) | * char-length [,] // N.B. The trailing [,] in the production is permitted by the Standard // only in the context of a type-declaration-stmt, but even with that // limitation, it would seem to be unnecessary and buggy to consume the comma // here. TYPE_PARSER(construct( parenthesized(maybe("LEN ="_tok) >> typeParamValue)) || construct("*" >> charLength /* / maybe(","_tok) */)) // R723 char-length -> ( type-param-value ) | digit-string TYPE_PARSER(construct(parenthesized(typeParamValue)) || construct(space >> digitString64 / spaceCheck)) // R724 char-literal-constant -> // [kind-param _] ' [rep-char]... ' | // [kind-param _] " [rep-char]... " // "rep-char" is any non-control character. Doubled interior quotes are // combined. Backslash escapes can be enabled. // N.B. the parsing of "kind-param" takes care to not consume the '_'. TYPE_CONTEXT_PARSER("CHARACTER literal constant"_en_US, construct( kindParam / underscore, charLiteralConstantWithoutKind) || construct(construct>(), space >> charLiteralConstantWithoutKind)) TYPE_CONTEXT_PARSER( "Hollerith"_en_US, construct(rawHollerithLiteral)) // R725 logical-literal-constant -> // .TRUE. [_ kind-param] | .FALSE. [_ kind-param] // Also accept .T. and .F. as extensions. TYPE_PARSER(construct(logicalTRUE, maybe(noSpace >> underscore >> noSpace >> kindParam)) || construct( logicalFALSE, maybe(noSpace >> underscore >> noSpace >> kindParam))) // R726 derived-type-def -> // derived-type-stmt [type-param-def-stmt]... // [private-or-sequence]... [component-part] // [type-bound-procedure-part] end-type-stmt // R735 component-part -> [component-def-stmt]... TYPE_CONTEXT_PARSER("derived type definition"_en_US, construct(statement(Parser{}), many(unambiguousStatement(Parser{})), many(statement(Parser{})), many(inContext("component"_en_US, unambiguousStatement(Parser{}))), maybe(Parser{}), statement(Parser{}))) // R727 derived-type-stmt -> // TYPE [[, type-attr-spec-list] ::] type-name [( // type-param-name-list )] TYPE_CONTEXT_PARSER("TYPE statement"_en_US, construct( "TYPE" >> optionalListBeforeColons(Parser{}), name, defaulted(parenthesized(nonemptyList(name))))) // R728 type-attr-spec -> // ABSTRACT | access-spec | BIND(C) | EXTENDS ( parent-type-name ) TYPE_PARSER(construct(construct("ABSTRACT"_tok)) || construct(construct("BIND ( C )"_tok)) || construct( construct("EXTENDS" >> parenthesized(name))) || construct(accessSpec)) // R729 private-or-sequence -> private-components-stmt | sequence-stmt TYPE_PARSER(construct(Parser{}) || construct(Parser{})) // R730 end-type-stmt -> END TYPE [type-name] TYPE_PARSER(construct( recovery("END TYPE" >> maybe(name), namedConstructEndStmtErrorRecovery))) // R731 sequence-stmt -> SEQUENCE TYPE_PARSER(construct("SEQUENCE"_tok)) // R732 type-param-def-stmt -> // integer-type-spec , type-param-attr-spec :: type-param-decl-list // R734 type-param-attr-spec -> KIND | LEN constexpr auto kindOrLen{"KIND" >> pure(common::TypeParamAttr::Kind) || "LEN" >> pure(common::TypeParamAttr::Len)}; TYPE_PARSER(construct(integerTypeSpec / ",", kindOrLen, "::" >> nonemptyList("expected type parameter declarations"_err_en_US, Parser{}))) // R733 type-param-decl -> type-param-name [= scalar-int-constant-expr] TYPE_PARSER(construct(name, maybe("=" >> scalarIntConstantExpr))) // R736 component-def-stmt -> data-component-def-stmt | // proc-component-def-stmt // Accidental extension not enabled here: PGI accepts type-param-def-stmt in // component-part of derived-type-def. TYPE_PARSER(recovery( withMessage("expected component definition"_err_en_US, first(construct(Parser{}), construct(Parser{}))), construct(inStmtErrorRecovery))) // R737 data-component-def-stmt -> // declaration-type-spec [[, component-attr-spec-list] ::] // component-decl-list // N.B. The standard requires double colons if there's an initializer. TYPE_PARSER(construct(declarationTypeSpec, optionalListBeforeColons(Parser{}), nonemptyList("expected component declarations"_err_en_US, Parser{}))) // R738 component-attr-spec -> // access-spec | ALLOCATABLE | // CODIMENSION lbracket coarray-spec rbracket | // CONTIGUOUS | DIMENSION ( component-array-spec ) | POINTER | // CUDA-data-attr TYPE_PARSER(construct(accessSpec) || construct(allocatable) || construct("CODIMENSION" >> coarraySpec) || construct(contiguous) || construct("DIMENSION" >> Parser{}) || construct(pointer) || extension( construct(Parser{})) || construct(recovery( fail( "type parameter definitions must appear before component declarations"_err_en_US), kindOrLen >> construct()))) // R739 component-decl -> // component-name [( component-array-spec )] // [lbracket coarray-spec rbracket] [* char-length] // [component-initialization] TYPE_CONTEXT_PARSER("component declaration"_en_US, construct(name, maybe(Parser{}), maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization))) // The source field of the Name will be replaced with a distinct generated name. TYPE_CONTEXT_PARSER("%FILL item"_en_US, extension( "nonstandard usage: %FILL"_port_en_US, construct(space >> sourced("%FILL" >> construct()), maybe(Parser{}), maybe("*" >> charLength)))) TYPE_PARSER(construct(Parser{}) || construct(Parser{})) // R740 component-array-spec -> // explicit-shape-spec-list | deferred-shape-spec-list // N.B. Parenthesized here rather than around references to this production. TYPE_PARSER(construct(parenthesized( nonemptyList("expected explicit shape specifications"_err_en_US, explicitShapeSpec))) || construct(parenthesized(deferredShapeSpecList))) // R741 proc-component-def-stmt -> // PROCEDURE ( [proc-interface] ) , proc-component-attr-spec-list // :: proc-decl-list TYPE_CONTEXT_PARSER("PROCEDURE component definition statement"_en_US, construct( "PROCEDURE" >> parenthesized(maybe(procInterface)), localRecovery("expected PROCEDURE component attributes"_err_en_US, "," >> nonemptyList(Parser{}), ok), localRecovery("expected PROCEDURE declarations"_err_en_US, "::" >> nonemptyList(procDecl), SkipTo<'\n'>{}))) // R742 proc-component-attr-spec -> // access-spec | NOPASS | PASS [(arg-name)] | POINTER constexpr auto noPass{construct("NOPASS"_tok)}; constexpr auto pass{construct("PASS" >> maybe(parenthesized(name)))}; TYPE_PARSER(construct(accessSpec) || construct(noPass) || construct(pass) || construct(pointer)) // R744 initial-data-target -> designator constexpr auto initialDataTarget{indirect(designator)}; // R743 component-initialization -> // = constant-expr | => null-init | => initial-data-target // R805 initialization -> // = constant-expr | => null-init | => initial-data-target // Universal extension: initialization -> / data-stmt-value-list / TYPE_PARSER(construct("=>" >> nullInit) || construct("=>" >> initialDataTarget) || construct("=" >> constantExpr) || extension( "nonstandard usage: /initialization/"_port_en_US, construct( "/" >> nonemptyList("expected values"_err_en_US, indirect(Parser{})) / "/"))) // R745 private-components-stmt -> PRIVATE // R747 binding-private-stmt -> PRIVATE TYPE_PARSER(construct("PRIVATE"_tok)) // R746 type-bound-procedure-part -> // contains-stmt [binding-private-stmt] [type-bound-proc-binding]... TYPE_CONTEXT_PARSER("type bound procedure part"_en_US, construct(statement(containsStmt), maybe(statement(Parser{})), many(statement(Parser{})))) // R748 type-bound-proc-binding -> // type-bound-procedure-stmt | type-bound-generic-stmt | // final-procedure-stmt TYPE_CONTEXT_PARSER("type bound procedure binding"_en_US, recovery( first(construct(Parser{}), construct(Parser{}), construct(Parser{})), construct( !"END"_tok >> SkipTo<'\n'>{} >> construct()))) // R749 type-bound-procedure-stmt -> // PROCEDURE [[, bind-attr-list] ::] type-bound-proc-decl-list | // PROCEDURE ( interface-name ) , bind-attr-list :: binding-name-list // The "::" is required by the standard (C768) in the first production if // any type-bound-proc-decl has a "=>', but it's not strictly necessary to // avoid a bad parse. TYPE_CONTEXT_PARSER("type bound PROCEDURE statement"_en_US, "PROCEDURE" >> (construct( construct( parenthesized(name), localRecovery("expected list of binding attributes"_err_en_US, "," >> nonemptyList(Parser{}), ok), localRecovery("expected list of binding names"_err_en_US, "::" >> listOfNames, SkipTo<'\n'>{}))) || construct(construct< TypeBoundProcedureStmt::WithoutInterface>( pure>(), nonemptyList( "expected type bound procedure declarations"_err_en_US, construct(name, maybe(extension( "type-bound procedure statement should have '::' if it has '=>'"_port_en_US, "=>" >> name)))))) || construct( construct( optionalListBeforeColons(Parser{}), nonemptyList( "expected type bound procedure declarations"_err_en_US, Parser{}))))) // R750 type-bound-proc-decl -> binding-name [=> procedure-name] TYPE_PARSER(construct(name, maybe("=>" >> name))) // R751 type-bound-generic-stmt -> // GENERIC [, access-spec] :: generic-spec => binding-name-list TYPE_CONTEXT_PARSER("type bound GENERIC statement"_en_US, construct("GENERIC" >> maybe("," >> accessSpec), "::" >> indirect(genericSpec), "=>" >> listOfNames)) // R752 bind-attr -> // access-spec | DEFERRED | NON_OVERRIDABLE | NOPASS | PASS [(arg-name)] TYPE_PARSER(construct(accessSpec) || construct(construct("DEFERRED"_tok)) || construct( construct("NON_OVERRIDABLE"_tok)) || construct(noPass) || construct(pass)) // R753 final-procedure-stmt -> FINAL [::] final-subroutine-name-list TYPE_CONTEXT_PARSER("FINAL statement"_en_US, construct("FINAL" >> maybe("::"_tok) >> listOfNames)) // R754 derived-type-spec -> type-name [(type-param-spec-list)] TYPE_PARSER(construct(name, defaulted(parenthesized(nonemptyList( "expected type parameters"_err_en_US, Parser{}))))) // R755 type-param-spec -> [keyword =] type-param-value TYPE_PARSER(construct(maybe(keyword / "="), typeParamValue)) // R756 structure-constructor -> derived-type-spec ( [component-spec-list] ) TYPE_PARSER((construct(derivedTypeSpec, parenthesized(optionalList(Parser{}))) || // This alternative corrects misrecognition of the // component-spec-list as the type-param-spec-list in // derived-type-spec. construct( construct( name, construct>()), parenthesized(optionalList(Parser{})))) / !"("_tok) // R757 component-spec -> [keyword =] component-data-source TYPE_PARSER(construct( maybe(keyword / "="), Parser{})) // R758 component-data-source -> expr | data-target | proc-target TYPE_PARSER(construct(indirect(expr))) // R759 enum-def -> // enum-def-stmt enumerator-def-stmt [enumerator-def-stmt]... // end-enum-stmt TYPE_CONTEXT_PARSER("enum definition"_en_US, construct(statement(Parser{}), some(unambiguousStatement(Parser{})), statement(Parser{}))) // R760 enum-def-stmt -> ENUM, BIND(C) TYPE_PARSER(construct("ENUM , BIND ( C )"_tok)) // R761 enumerator-def-stmt -> ENUMERATOR [::] enumerator-list TYPE_CONTEXT_PARSER("ENUMERATOR statement"_en_US, construct("ENUMERATOR" >> maybe("::"_tok) >> nonemptyList("expected enumerators"_err_en_US, Parser{}))) // R762 enumerator -> named-constant [= scalar-int-constant-expr] TYPE_PARSER( construct(namedConstant, maybe("=" >> scalarIntConstantExpr))) // R763 end-enum-stmt -> END ENUM TYPE_PARSER(recovery("END ENUM"_tok, constructEndStmtErrorRecovery) >> construct()) // R801 type-declaration-stmt -> // declaration-type-spec [[, attr-spec]... ::] entity-decl-list constexpr auto entityDeclWithoutEqInit{construct(name, maybe(arraySpec), maybe(coarraySpec), maybe("*" >> charLength), !"="_tok >> maybe(initialization))}; // old-style REAL A/0/ still works TYPE_PARSER( construct(declarationTypeSpec, defaulted("," >> nonemptyList(Parser{})) / "::", nonemptyList("expected entity declarations"_err_en_US, entityDecl)) || // C806: no initializers allowed without colons ("REALA=1" is ambiguous) construct(declarationTypeSpec, construct>(), nonemptyList("expected entity declarations"_err_en_US, entityDeclWithoutEqInit)) || // PGI-only extension: comma in place of doubled colons extension( "nonstandard usage: ',' in place of '::'"_port_en_US, construct(declarationTypeSpec, defaulted("," >> nonemptyList(Parser{})), withMessage("expected entity declarations"_err_en_US, "," >> nonemptyList(entityDecl))))) // R802 attr-spec -> // access-spec | ALLOCATABLE | ASYNCHRONOUS | // CODIMENSION lbracket coarray-spec rbracket | CONTIGUOUS | // DIMENSION ( array-spec ) | EXTERNAL | INTENT ( intent-spec ) | // INTRINSIC | language-binding-spec | OPTIONAL | PARAMETER | POINTER | // PROTECTED | SAVE | TARGET | VALUE | VOLATILE | // CUDA-data-attr TYPE_PARSER(construct(accessSpec) || construct(allocatable) || construct(construct("ASYNCHRONOUS"_tok)) || construct("CODIMENSION" >> coarraySpec) || construct(contiguous) || construct("DIMENSION" >> arraySpec) || construct(construct("EXTERNAL"_tok)) || construct("INTENT" >> parenthesized(intentSpec)) || construct(construct("INTRINSIC"_tok)) || construct(languageBindingSpec) || construct(optional) || construct(construct("PARAMETER"_tok)) || construct(pointer) || construct(protectedAttr) || construct(save) || construct(construct("TARGET"_tok)) || construct(construct("VALUE"_tok)) || construct(construct("VOLATILE"_tok)) || extension( construct(Parser{}))) // CUDA-data-attr -> CONSTANT | DEVICE | MANAGED | PINNED | SHARED | TEXTURE TYPE_PARSER("CONSTANT" >> pure(common::CUDADataAttr::Constant) || "DEVICE" >> pure(common::CUDADataAttr::Device) || "MANAGED" >> pure(common::CUDADataAttr::Managed) || "PINNED" >> pure(common::CUDADataAttr::Pinned) || "SHARED" >> pure(common::CUDADataAttr::Shared) || "TEXTURE" >> pure(common::CUDADataAttr::Texture)) // R804 object-name -> name constexpr auto objectName{name}; // R803 entity-decl -> // object-name [( array-spec )] [lbracket coarray-spec rbracket] // [* char-length] [initialization] | // function-name [* char-length] TYPE_PARSER(construct(objectName, maybe(arraySpec), maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization))) // R806 null-init -> function-reference ... which must resolve to NULL() TYPE_PARSER(lookAhead(name / "( )") >> construct(expr)) // R807 access-spec -> PUBLIC | PRIVATE TYPE_PARSER(construct("PUBLIC" >> pure(AccessSpec::Kind::Public)) || construct("PRIVATE" >> pure(AccessSpec::Kind::Private))) // R808 language-binding-spec -> // BIND ( C [, NAME = scalar-default-char-constant-expr] ) // R1528 proc-language-binding-spec -> language-binding-spec TYPE_PARSER(construct( "BIND ( C" >> maybe(", NAME =" >> scalarDefaultCharConstantExpr) / ")")) // R809 coarray-spec -> deferred-coshape-spec-list | explicit-coshape-spec // N.B. Bracketed here rather than around references, for consistency with // array-spec. TYPE_PARSER( construct(bracketed(Parser{})) || construct(bracketed(Parser{}))) // R810 deferred-coshape-spec -> : // deferred-coshape-spec-list - just a list of colons inline int listLength(std::list &&xs) { return xs.size(); } TYPE_PARSER(construct( applyFunction(listLength, nonemptyList(":"_tok)))) // R811 explicit-coshape-spec -> // [[lower-cobound :] upper-cobound ,]... [lower-cobound :] * // R812 lower-cobound -> specification-expr // R813 upper-cobound -> specification-expr TYPE_PARSER(construct( many(explicitShapeSpec / ","), maybe(specificationExpr / ":") / "*")) // R815 array-spec -> // explicit-shape-spec-list | assumed-shape-spec-list | // deferred-shape-spec-list | assumed-size-spec | implied-shape-spec | // implied-shape-or-assumed-size-spec | assumed-rank-spec // N.B. Parenthesized here rather than around references to avoid // a need for forced look-ahead. // Shape specs that could be deferred-shape-spec or assumed-shape-spec // (e.g. '(:,:)') are parsed as the former. TYPE_PARSER( construct(parenthesized(nonemptyList(explicitShapeSpec))) || construct(parenthesized(deferredShapeSpecList)) || construct( parenthesized(nonemptyList(Parser{}))) || construct(parenthesized(Parser{})) || construct(parenthesized(Parser{})) || construct(parenthesized(Parser{}))) // R816 explicit-shape-spec -> [lower-bound :] upper-bound // R817 lower-bound -> specification-expr // R818 upper-bound -> specification-expr TYPE_PARSER(construct( maybe(specificationExpr / ":"), specificationExpr)) // R819 assumed-shape-spec -> [lower-bound] : TYPE_PARSER(construct(maybe(specificationExpr) / ":")) // R820 deferred-shape-spec -> : // deferred-shape-spec-list - just a list of colons TYPE_PARSER(construct( applyFunction(listLength, nonemptyList(":"_tok)))) // R821 assumed-implied-spec -> [lower-bound :] * TYPE_PARSER(construct(maybe(specificationExpr / ":") / "*")) // R822 assumed-size-spec -> explicit-shape-spec-list , assumed-implied-spec TYPE_PARSER(construct( nonemptyList(explicitShapeSpec) / ",", assumedImpliedSpec)) // R823 implied-shape-or-assumed-size-spec -> assumed-implied-spec // R824 implied-shape-spec -> assumed-implied-spec , assumed-implied-spec-list // I.e., when the assumed-implied-spec-list has a single item, it constitutes an // implied-shape-or-assumed-size-spec; otherwise, an implied-shape-spec. TYPE_PARSER(construct(nonemptyList(assumedImpliedSpec))) // R825 assumed-rank-spec -> .. TYPE_PARSER(construct(".."_tok)) // R826 intent-spec -> IN | OUT | INOUT TYPE_PARSER(construct("IN OUT" >> pure(IntentSpec::Intent::InOut) || "IN" >> pure(IntentSpec::Intent::In) || "OUT" >> pure(IntentSpec::Intent::Out))) // R827 access-stmt -> access-spec [[::] access-id-list] TYPE_PARSER(construct(accessSpec, defaulted(maybe("::"_tok) >> nonemptyList("expected names and generic specifications"_err_en_US, Parser{})))) // R828 access-id -> access-name | generic-spec // "access-name" is ambiguous with "generic-spec" TYPE_PARSER(construct(indirect(genericSpec))) // R829 allocatable-stmt -> ALLOCATABLE [::] allocatable-decl-list TYPE_PARSER(construct("ALLOCATABLE" >> maybe("::"_tok) >> nonemptyList( "expected object declarations"_err_en_US, Parser{}))) // R830 allocatable-decl -> // object-name [( array-spec )] [lbracket coarray-spec rbracket] // R860 target-decl -> // object-name [( array-spec )] [lbracket coarray-spec rbracket] TYPE_PARSER( construct(objectName, maybe(arraySpec), maybe(coarraySpec))) // R831 asynchronous-stmt -> ASYNCHRONOUS [::] object-name-list TYPE_PARSER(construct("ASYNCHRONOUS" >> maybe("::"_tok) >> nonemptyList("expected object names"_err_en_US, objectName))) // R832 bind-stmt -> language-binding-spec [::] bind-entity-list TYPE_PARSER(construct(languageBindingSpec / maybe("::"_tok), nonemptyList("expected bind entities"_err_en_US, Parser{}))) // R833 bind-entity -> entity-name | / common-block-name / TYPE_PARSER(construct(pure(BindEntity::Kind::Object), name) || construct("/" >> pure(BindEntity::Kind::Common), name / "/")) // R834 codimension-stmt -> CODIMENSION [::] codimension-decl-list TYPE_PARSER(construct("CODIMENSION" >> maybe("::"_tok) >> nonemptyList("expected codimension declarations"_err_en_US, Parser{}))) // R835 codimension-decl -> coarray-name lbracket coarray-spec rbracket TYPE_PARSER(construct(name, coarraySpec)) // R836 contiguous-stmt -> CONTIGUOUS [::] object-name-list TYPE_PARSER(construct("CONTIGUOUS" >> maybe("::"_tok) >> nonemptyList("expected object names"_err_en_US, objectName))) // R837 data-stmt -> DATA data-stmt-set [[,] data-stmt-set]... TYPE_CONTEXT_PARSER("DATA statement"_en_US, construct( "DATA" >> nonemptySeparated(Parser{}, maybe(","_tok)))) // R838 data-stmt-set -> data-stmt-object-list / data-stmt-value-list / TYPE_PARSER(construct( nonemptyList( "expected DATA statement objects"_err_en_US, Parser{}), withMessage("expected DATA statement value list"_err_en_US, "/"_tok >> nonemptyList("expected DATA statement values"_err_en_US, Parser{})) / "/")) // R839 data-stmt-object -> variable | data-implied-do TYPE_PARSER(construct(indirect(variable)) || construct(dataImpliedDo)) // R840 data-implied-do -> // ( data-i-do-object-list , [integer-type-spec ::] data-i-do-variable // = scalar-int-constant-expr , scalar-int-constant-expr // [, scalar-int-constant-expr] ) // R842 data-i-do-variable -> do-variable TYPE_PARSER(parenthesized(construct( nonemptyList(Parser{} / lookAhead(","_tok)) / ",", maybe(integerTypeSpec / "::"), loopBounds(scalarIntConstantExpr)))) // R841 data-i-do-object -> // array-element | scalar-structure-component | data-implied-do TYPE_PARSER(construct(scalar(indirect(designator))) || construct(indirect(dataImpliedDo))) // R843 data-stmt-value -> [data-stmt-repeat *] data-stmt-constant TYPE_PARSER(construct( maybe(Parser{} / "*"), Parser{})) // R847 constant-subobject -> designator // R846 int-constant-subobject -> constant-subobject constexpr auto constantSubobject{constant(indirect(designator))}; // R844 data-stmt-repeat -> scalar-int-constant | scalar-int-constant-subobject // R607 int-constant -> constant // Factored into: constant -> literal-constant -> int-literal-constant // The named-constant alternative of constant is subsumed by constant-subobject TYPE_PARSER(construct(intLiteralConstant) || construct(scalar(integer(constantSubobject)))) // R845 data-stmt-constant -> // scalar-constant | scalar-constant-subobject | // signed-int-literal-constant | signed-real-literal-constant | // null-init | initial-data-target | // constant-structure-constructor // N.B. scalar-constant and scalar-constant-subobject are ambiguous with // initial-data-target; null-init and structure-constructor are ambiguous // in the absence of parameters and components; structure-constructor with // components can be ambiguous with a scalar-constant-subobject. // So we parse literal constants, designator, null-init, and // structure-constructor, so that semantics can figure things out later // with the symbol table. TYPE_PARSER(sourced(first(construct(literalConstant), construct(signedRealLiteralConstant), construct(signedIntLiteralConstant), extension( "nonstandard usage: signed COMPLEX literal"_port_en_US, construct(Parser{})), construct(nullInit), construct(indirect(designator) / !"("_tok), construct(Parser{})))) // R848 dimension-stmt -> // DIMENSION [::] array-name ( array-spec ) // [, array-name ( array-spec )]... TYPE_CONTEXT_PARSER("DIMENSION statement"_en_US, construct("DIMENSION" >> maybe("::"_tok) >> nonemptyList("expected array specifications"_err_en_US, construct(name, arraySpec)))) // R849 intent-stmt -> INTENT ( intent-spec ) [::] dummy-arg-name-list TYPE_CONTEXT_PARSER("INTENT statement"_en_US, construct( "INTENT" >> parenthesized(intentSpec) / maybe("::"_tok), listOfNames)) // R850 optional-stmt -> OPTIONAL [::] dummy-arg-name-list TYPE_PARSER( construct("OPTIONAL" >> maybe("::"_tok) >> listOfNames)) // R851 parameter-stmt -> PARAMETER ( named-constant-def-list ) // Legacy extension: omitted parentheses, no implicit typing from names TYPE_CONTEXT_PARSER("PARAMETER statement"_en_US, construct( "PARAMETER" >> parenthesized(nonemptyList(Parser{})))) TYPE_CONTEXT_PARSER("old style PARAMETER statement"_en_US, extension( "nonstandard usage: PARAMETER without parentheses"_port_en_US, construct( "PARAMETER" >> nonemptyList(Parser{})))) // R852 named-constant-def -> named-constant = constant-expr TYPE_PARSER(construct(namedConstant, "=" >> constantExpr)) // R853 pointer-stmt -> POINTER [::] pointer-decl-list TYPE_PARSER(construct("POINTER" >> maybe("::"_tok) >> nonemptyList( "expected pointer declarations"_err_en_US, Parser{}))) // R854 pointer-decl -> // object-name [( deferred-shape-spec-list )] | proc-entity-name TYPE_PARSER( construct(name, maybe(parenthesized(deferredShapeSpecList)))) // R855 protected-stmt -> PROTECTED [::] entity-name-list TYPE_PARSER( construct("PROTECTED" >> maybe("::"_tok) >> listOfNames)) // R856 save-stmt -> SAVE [[::] saved-entity-list] TYPE_PARSER(construct( "SAVE" >> defaulted(maybe("::"_tok) >> nonemptyList("expected SAVE entities"_err_en_US, Parser{})))) // R857 saved-entity -> object-name | proc-pointer-name | / common-block-name / // R858 proc-pointer-name -> name TYPE_PARSER(construct(pure(SavedEntity::Kind::Entity), name) || construct("/" >> pure(SavedEntity::Kind::Common), name / "/")) // R859 target-stmt -> TARGET [::] target-decl-list TYPE_PARSER(construct("TARGET" >> maybe("::"_tok) >> nonemptyList("expected objects"_err_en_US, Parser{}))) // R861 value-stmt -> VALUE [::] dummy-arg-name-list TYPE_PARSER(construct("VALUE" >> maybe("::"_tok) >> listOfNames)) // R862 volatile-stmt -> VOLATILE [::] object-name-list TYPE_PARSER(construct("VOLATILE" >> maybe("::"_tok) >> nonemptyList("expected object names"_err_en_US, objectName))) // R866 implicit-name-spec -> EXTERNAL | TYPE constexpr auto implicitNameSpec{ "EXTERNAL" >> pure(ImplicitStmt::ImplicitNoneNameSpec::External) || "TYPE" >> pure(ImplicitStmt::ImplicitNoneNameSpec::Type)}; // R863 implicit-stmt -> // IMPLICIT implicit-spec-list | // IMPLICIT NONE [( [implicit-name-spec-list] )] TYPE_CONTEXT_PARSER("IMPLICIT statement"_en_US, construct( "IMPLICIT" >> nonemptyList("expected IMPLICIT specifications"_err_en_US, Parser{})) || construct("IMPLICIT NONE"_sptok >> defaulted(parenthesized(optionalList(implicitNameSpec))))) // R864 implicit-spec -> declaration-type-spec ( letter-spec-list ) // The variant form of declarationTypeSpec is meant to avoid misrecognition // of a letter-spec as a simple parenthesized expression for kind or character // length, e.g., PARAMETER(I=5,N=1); IMPLICIT REAL(I-N)(O-Z) vs. // IMPLICIT REAL(I-N). The variant form needs to attempt to reparse only // types with optional parenthesized kind/length expressions, so derived // type specs, DOUBLE PRECISION, and DOUBLE COMPLEX need not be considered. constexpr auto noKindSelector{construct>()}; constexpr auto implicitSpecDeclarationTypeSpecRetry{ construct(first( construct( construct("INTEGER" >> noKindSelector)), construct( construct("REAL" >> noKindSelector)), construct( construct("COMPLEX" >> noKindSelector)), construct(construct( "CHARACTER" >> construct>())), construct(construct( "LOGICAL" >> noKindSelector))))}; TYPE_PARSER(construct(declarationTypeSpec, parenthesized(nonemptyList(Parser{}))) || construct(implicitSpecDeclarationTypeSpecRetry, parenthesized(nonemptyList(Parser{})))) // R865 letter-spec -> letter [- letter] TYPE_PARSER(space >> (construct(letter, maybe("-" >> letter)) || construct(otherIdChar, construct>()))) // R867 import-stmt -> // IMPORT [[::] import-name-list] | // IMPORT , ONLY : import-name-list | IMPORT , NONE | IMPORT , ALL TYPE_CONTEXT_PARSER("IMPORT statement"_en_US, construct( "IMPORT , ONLY :" >> pure(common::ImportKind::Only), listOfNames) || construct( "IMPORT , NONE" >> pure(common::ImportKind::None)) || construct( "IMPORT , ALL" >> pure(common::ImportKind::All)) || construct( "IMPORT" >> maybe("::"_tok) >> optionalList(name))) // R868 namelist-stmt -> // NAMELIST / namelist-group-name / namelist-group-object-list // [[,] / namelist-group-name / namelist-group-object-list]... // R869 namelist-group-object -> variable-name TYPE_PARSER(construct("NAMELIST" >> nonemptySeparated( construct("/" >> name / "/", listOfNames), maybe(","_tok)))) // R870 equivalence-stmt -> EQUIVALENCE equivalence-set-list // R871 equivalence-set -> ( equivalence-object , equivalence-object-list ) TYPE_PARSER(construct("EQUIVALENCE" >> nonemptyList( parenthesized(nonemptyList("expected EQUIVALENCE objects"_err_en_US, Parser{}))))) // R872 equivalence-object -> variable-name | array-element | substring TYPE_PARSER(construct(indirect(designator))) // R873 common-stmt -> // COMMON [/ [common-block-name] /] common-block-object-list // [[,] / [common-block-name] / common-block-object-list]... TYPE_PARSER( construct("COMMON" >> defaulted("/" >> maybe(name) / "/"), nonemptyList("expected COMMON block objects"_err_en_US, Parser{}), many(maybe(","_tok) >> construct("/" >> maybe(name) / "/", nonemptyList("expected COMMON block objects"_err_en_US, Parser{}))))) // R874 common-block-object -> variable-name [( array-spec )] TYPE_PARSER(construct(name, maybe(arraySpec))) // R901 designator -> object-name | array-element | array-section | // coindexed-named-object | complex-part-designator | // structure-component | substring // The Standard's productions for designator and its alternatives are // ambiguous without recourse to a symbol table. Many of the alternatives // for designator (viz., array-element, coindexed-named-object, // and structure-component) are all syntactically just data-ref. // What designator boils down to is this: // It starts with either a name or a character literal. // If it starts with a character literal, it must be a substring. // If it starts with a name, it's a sequence of %-separated parts; // each part is a name, maybe a (section-subscript-list), and // maybe an [image-selector]. // If it's a substring, it ends with (substring-range). TYPE_CONTEXT_PARSER("designator"_en_US, sourced(construct(substring) || construct(dataRef))) constexpr auto percentOrDot{"%"_tok || // legacy VAX extension for RECORD field access extension( "nonstandard usage: component access with '.' in place of '%'"_port_en_US, "."_tok / lookAhead(OldStructureComponentName{}))}; // R902 variable -> designator | function-reference // This production appears to be left-recursive in the grammar via // function-reference -> procedure-designator -> proc-component-ref -> // scalar-variable // and would be so if we were to allow functions to be called via procedure // pointer components within derived type results of other function references // (a reasonable extension, esp. in the case of procedure pointer components // that are NOPASS). However, Fortran constrains the use of a variable in a // proc-component-ref to be a data-ref without coindices (C1027). // Some array element references will be misrecognized as function references. constexpr auto noMoreAddressing{!"("_tok >> !"["_tok >> !percentOrDot}; TYPE_CONTEXT_PARSER("variable"_en_US, construct(indirect(functionReference / noMoreAddressing)) || construct(indirect(designator))) // R908 substring -> parent-string ( substring-range ) // R909 parent-string -> // scalar-variable-name | array-element | coindexed-named-object | // scalar-structure-component | scalar-char-literal-constant | // scalar-named-constant TYPE_PARSER( construct(dataRef, parenthesized(Parser{}))) TYPE_PARSER(construct( charLiteralConstant, parenthesized(Parser{}))) TYPE_PARSER(sourced(construct(Parser{}) / ("%LEN"_tok || "%KIND"_tok))) // R910 substring-range -> [scalar-int-expr] : [scalar-int-expr] TYPE_PARSER(construct( maybe(scalarIntExpr), ":" >> maybe(scalarIntExpr))) // R911 data-ref -> part-ref [% part-ref]... // R914 coindexed-named-object -> data-ref // R917 array-element -> data-ref TYPE_PARSER( construct(nonemptySeparated(Parser{}, percentOrDot))) // R912 part-ref -> part-name [( section-subscript-list )] [image-selector] TYPE_PARSER(construct(name, defaulted( parenthesized(nonemptyList(Parser{})) / !"=>"_tok), maybe(Parser{}))) // R913 structure-component -> data-ref // The final part-ref in the data-ref is not allowed to have subscripts. TYPE_CONTEXT_PARSER("component"_en_US, construct( construct(some(Parser{} / percentOrDot)), name)) // R919 subscript -> scalar-int-expr constexpr auto subscript{scalarIntExpr}; // R920 section-subscript -> subscript | subscript-triplet | vector-subscript // R923 vector-subscript -> int-expr // N.B. The distinction that needs to be made between "subscript" and // "vector-subscript" is deferred to semantic analysis. TYPE_PARSER(construct(Parser{}) || construct(intExpr)) // R921 subscript-triplet -> [subscript] : [subscript] [: stride] TYPE_PARSER(construct( maybe(subscript), ":" >> maybe(subscript), maybe(":" >> subscript))) // R925 cosubscript -> scalar-int-expr constexpr auto cosubscript{scalarIntExpr}; // R924 image-selector -> // lbracket cosubscript-list [, image-selector-spec-list] rbracket TYPE_CONTEXT_PARSER("image selector"_en_US, construct( "[" >> nonemptyList(cosubscript / lookAhead(space / ",]"_ch)), defaulted("," >> nonemptyList(Parser{})) / "]")) // R926 image-selector-spec -> // STAT = stat-variable | TEAM = team-value | // TEAM_NUMBER = scalar-int-expr TYPE_PARSER(construct(construct( "STAT =" >> scalar(integer(indirect(variable))))) || construct(construct("TEAM =" >> teamValue)) || construct(construct( "TEAM_NUMBER =" >> scalarIntExpr))) // R927 allocate-stmt -> // ALLOCATE ( [type-spec ::] allocation-list [, alloc-opt-list] ) TYPE_CONTEXT_PARSER("ALLOCATE statement"_en_US, construct("ALLOCATE (" >> maybe(typeSpec / "::"), nonemptyList(Parser{}), defaulted("," >> nonemptyList(Parser{})) / ")")) // R928 alloc-opt -> // ERRMSG = errmsg-variable | MOLD = source-expr | // SOURCE = source-expr | STAT = stat-variable | // (CUDA) STREAM = scalar-int-expr // PINNED = scalar-logical-variable // R931 source-expr -> expr TYPE_PARSER(construct( construct("MOLD =" >> indirect(expr))) || construct( construct("SOURCE =" >> indirect(expr))) || construct(statOrErrmsg) || extension( construct(construct( "STREAM =" >> indirect(scalarIntExpr))) || construct(construct( "PINNED =" >> indirect(scalarLogicalVariable))))) // R929 stat-variable -> scalar-int-variable TYPE_PARSER(construct(scalar(integer(variable)))) // R932 allocation -> // allocate-object [( allocate-shape-spec-list )] // [lbracket allocate-coarray-spec rbracket] TYPE_PARSER(construct(Parser{}, defaulted(parenthesized(nonemptyList(Parser{}))), maybe(bracketed(Parser{})))) // R933 allocate-object -> variable-name | structure-component TYPE_PARSER(construct(structureComponent) || construct(name / !"="_tok)) // R934 allocate-shape-spec -> [lower-bound-expr :] upper-bound-expr // R938 allocate-coshape-spec -> [lower-bound-expr :] upper-bound-expr TYPE_PARSER(construct(maybe(boundExpr / ":"), boundExpr)) // R937 allocate-coarray-spec -> // [allocate-coshape-spec-list ,] [lower-bound-expr :] * TYPE_PARSER(construct( defaulted(nonemptyList(Parser{}) / ","), maybe(boundExpr / ":") / "*")) // R939 nullify-stmt -> NULLIFY ( pointer-object-list ) TYPE_CONTEXT_PARSER("NULLIFY statement"_en_US, "NULLIFY" >> parenthesized(construct( nonemptyList(Parser{})))) // R940 pointer-object -> // variable-name | structure-component | proc-pointer-name TYPE_PARSER(construct(structureComponent) || construct(name)) // R941 deallocate-stmt -> // DEALLOCATE ( allocate-object-list [, dealloc-opt-list] ) TYPE_CONTEXT_PARSER("DEALLOCATE statement"_en_US, construct( "DEALLOCATE (" >> nonemptyList(Parser{}), defaulted("," >> nonemptyList(statOrErrmsg)) / ")")) // R942 dealloc-opt -> STAT = stat-variable | ERRMSG = errmsg-variable // R1165 sync-stat -> STAT = stat-variable | ERRMSG = errmsg-variable TYPE_PARSER(construct("STAT =" >> statVariable) || construct("ERRMSG =" >> msgVariable)) // Directives, extensions, and deprecated statements // !DIR$ IGNORE_TKR [ [(tkrdmac...)] name ]... // !DIR$ LOOP COUNT (n1[, n2]...) // !DIR$ name... constexpr auto ignore_tkr{ "DIR$ IGNORE_TKR" >> optionalList(construct( maybe(parenthesized(many(letter))), name))}; constexpr auto loopCount{ "DIR$ LOOP COUNT" >> construct( parenthesized(nonemptyList(digitString64)))}; TYPE_PARSER(beginDirective >> sourced(construct(ignore_tkr) || construct(loopCount) || construct( "DIR$" >> many(construct(name, maybe(("="_tok || ":"_tok) >> digitString64))))) / endOfStmt) TYPE_PARSER(extension( "nonstandard usage: based POINTER"_port_en_US, construct( "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US, construct("(" >> objectName / ",", objectName, maybe(Parser{}) / ")"))))) // CUDA-attributes-stmt -> ATTRIBUTES (CUDA-data-attr) [::] name-list TYPE_PARSER(extension(construct( "ATTRIBUTES" >> parenthesized(Parser{}), defaulted( maybe("::"_tok) >> nonemptyList("expected names"_err_en_US, name))))) // Subtle: the name includes the surrounding slashes, which avoids // clashes with other uses of the name in the same scope. TYPE_PARSER(construct( "STRUCTURE" >> maybe(sourced("/" >> name / "/")), optionalList(entityDecl))) constexpr auto nestedStructureDef{ CONTEXT_PARSER("nested STRUCTURE definition"_en_US, construct(statement(NestedStructureStmt{}), many(Parser{}), statement(construct( "END STRUCTURE"_tok))))}; TYPE_PARSER(construct(statement(StructureComponents{})) || construct(indirect(Parser{})) || construct(indirect(nestedStructureDef))) TYPE_CONTEXT_PARSER("STRUCTURE definition"_en_US, extension( "nonstandard usage: STRUCTURE"_port_en_US, construct(statement(Parser{}), many(Parser{}), statement(construct( "END STRUCTURE"_tok))))) TYPE_CONTEXT_PARSER("UNION definition"_en_US, construct(statement(construct("UNION"_tok)), many(Parser{}), statement(construct("END UNION"_tok)))) TYPE_CONTEXT_PARSER("MAP definition"_en_US, construct(statement(construct("MAP"_tok)), many(Parser{}), statement(construct("END MAP"_tok)))) TYPE_CONTEXT_PARSER("arithmetic IF statement"_en_US, deprecated(construct( "IF" >> parenthesized(expr), label / ",", label / ",", label))) TYPE_CONTEXT_PARSER("ASSIGN statement"_en_US, deprecated( construct("ASSIGN" >> label, "TO" >> name))) TYPE_CONTEXT_PARSER("assigned GOTO statement"_en_US, deprecated(construct( "GO TO" >> name, defaulted(maybe(","_tok) >> parenthesized(nonemptyList("expected labels"_err_en_US, label)))))) TYPE_CONTEXT_PARSER("PAUSE statement"_en_US, deprecated( construct("PAUSE" >> maybe(Parser{})))) // These requirement productions are defined by the Fortran standard but never // used directly by the grammar: // R620 delimiter -> ( | ) | / | [ | ] | (/ | /) // R1027 numeric-expr -> expr // R1031 int-constant-expr -> int-expr // R1221 dtv-type-spec -> TYPE ( derived-type-spec ) | // CLASS ( derived-type-spec ) // // These requirement productions are defined and used, but need not be // defined independently here in this file: // R771 lbracket -> [ // R772 rbracket -> ] // // Further note that: // R607 int-constant -> constant // is used only once via R844 scalar-int-constant // R904 logical-variable -> variable // is used only via scalar-logical-variable // R906 default-char-variable -> variable // is used only via scalar-default-char-variable // R907 int-variable -> variable // is used only via scalar-int-variable // R915 complex-part-designator -> designator % RE | designator % IM // %RE and %IM are initially recognized as structure components // R916 type-param-inquiry -> designator % type-param-name // is occulted by structure component designators // R918 array-section -> // data-ref [( substring-range )] | complex-part-designator // is not used because parsing is not sensitive to rank // R1030 default-char-constant-expr -> default-char-expr // is only used via scalar-default-char-constant-expr } // namespace Fortran::parser