| //===-- lib/Parser/program-parsers.cpp ------------------------------------===// |
| // |
| // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
| // See https://llvm.org/LICENSE.txt for license information. |
| // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
| // |
| //===----------------------------------------------------------------------===// |
| |
| // Per-type parsers for 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/characters.h" |
| #include "flang/Parser/parse-tree.h" |
| |
| namespace Fortran::parser { |
| |
| // R1530 function-stmt -> |
| // [prefix] FUNCTION function-name ( [dummy-arg-name-list] ) [suffix] |
| // R1526 prefix -> prefix-spec [prefix-spec]... |
| // R1531 dummy-arg-name -> name |
| |
| static constexpr auto validFunctionStmt{ |
| construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name, |
| parenthesized(optionalList(name)), maybe(suffix)) / |
| atEndOfStmt || |
| construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name / atEndOfStmt, |
| // PGI & Intel accept "FUNCTION F" |
| extension<LanguageFeature::OmitFunctionDummies>( |
| "nonstandard usage: FUNCTION statement without dummy argument list"_port_en_US, |
| pure<std::list<Name>>()), |
| pure<std::optional<Suffix>>())}; |
| |
| // function-stmt with error recovery -- used in interfaces and internal |
| // subprograms, but not at the top level, where REALFUNCTIONF and |
| // INTEGERPUREELEMENTALFUNCTIONG(10) might appear as the first statement |
| // of a main program. |
| TYPE_PARSER(validFunctionStmt || |
| construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name, |
| defaulted(parenthesized(optionalList(name))), maybe(suffix)) / |
| checkEndOfKnownStmt) |
| |
| // R502 program-unit -> |
| // main-program | external-subprogram | module | submodule | block-data |
| // R503 external-subprogram -> function-subprogram | subroutine-subprogram |
| // N.B. "module" must precede "external-subprogram" in this sequence of |
| // alternatives to avoid ambiguity with the MODULE keyword prefix that |
| // they recognize. I.e., "modulesubroutinefoo" should start a module |
| // "subroutinefoo", not a subroutine "foo" with the MODULE prefix. The |
| // ambiguity is exacerbated by the extension that accepts a function |
| // statement without an otherwise empty list of dummy arguments. That |
| // MODULE prefix is disallowed by a constraint (C1547) in this context, |
| // so the standard language is not ambiguous, but disabling its misrecognition |
| // here would require context-sensitive keyword recognition or variant parsers |
| // for several productions; giving the "module" production priority here is a |
| // cleaner solution, though regrettably subtle. |
| // Enforcing C1547 is done in semantics. |
| static constexpr auto programUnit{ |
| construct<ProgramUnit>(indirect(Parser<Module>{})) || |
| construct<ProgramUnit>(indirect(subroutineSubprogram)) || |
| construct<ProgramUnit>(indirect(Parser<Submodule>{})) || |
| construct<ProgramUnit>(indirect(Parser<BlockData>{})) || |
| lookAhead(validFunctionStmt) >> |
| construct<ProgramUnit>(indirect(functionSubprogram)) || |
| construct<ProgramUnit>(indirect(Parser<MainProgram>{}))}; |
| static constexpr auto normalProgramUnit{StartNewSubprogram{} >> programUnit / |
| skipMany(";"_tok) / space / recovery(endOfLine, SkipPast<'\n'>{})}; |
| static constexpr auto globalCompilerDirective{ |
| construct<ProgramUnit>(indirect(compilerDirective))}; |
| |
| static constexpr auto globalOpenACCCompilerDirective{ |
| construct<ProgramUnit>(indirect(skipStuffBeforeStatement >> |
| "!$ACC "_sptok >> Parser<OpenACCRoutineConstruct>{}))}; |
| |
| // R501 program -> program-unit [program-unit]... |
| // This is the top-level production for the Fortran language. |
| // F'2018 6.3.1 defines a program unit as a sequence of one or more lines, |
| // implying that a line can't be part of two distinct program units. |
| // Consequently, a program unit END statement should be the last statement |
| // on its line. We parse those END statements via unterminatedStatement() |
| // and then skip over the end of the line here. |
| TYPE_PARSER( |
| construct<Program>(extension<LanguageFeature::EmptySourceFile>( |
| "nonstandard usage: empty source file"_port_en_US, |
| skipStuffBeforeStatement >> !nextCh >> |
| pure<std::list<ProgramUnit>>()) || |
| some(globalCompilerDirective || globalOpenACCCompilerDirective || |
| normalProgramUnit) / |
| skipStuffBeforeStatement)) |
| |
| // R507 declaration-construct -> |
| // specification-construct | data-stmt | format-stmt | |
| // entry-stmt | stmt-function-stmt |
| // N.B. These parsers incorporate recognition of some other statements that |
| // may have been misplaced in the sequence of statements that are acceptable |
| // as a specification part in order to improve error recovery. |
| // Also note that many instances of specification-part in the standard grammar |
| // are in contexts that impose constraints on the kinds of statements that |
| // are allowed, and so we have a variant production for declaration-construct |
| // that implements those constraints. |
| constexpr auto actionStmtLookAhead{first(actionStmt >> ok, |
| // Also accept apparent action statements with errors if they might be |
| // first in the execution part |
| "ALLOCATE ("_tok, "CALL" >> name >> "("_tok, "GO TO"_tok, "OPEN ("_tok, |
| "PRINT"_tok / space / !"("_tok, "READ ("_tok, "WRITE ("_tok)}; |
| constexpr auto execPartLookAhead{first(actionStmtLookAhead >> ok, |
| openaccConstruct >> ok, openmpConstruct >> ok, "ASSOCIATE ("_tok, |
| "BLOCK"_tok, "SELECT"_tok, "CHANGE TEAM"_sptok, "CRITICAL"_tok, "DO"_tok, |
| "IF ("_tok, "WHERE ("_tok, "FORALL ("_tok, "!$CUF"_tok)}; |
| constexpr auto declErrorRecovery{ |
| stmtErrorRecoveryStart >> !execPartLookAhead >> skipStmtErrorRecovery}; |
| constexpr auto misplacedSpecificationStmt{Parser<UseStmt>{} >> |
| fail<DeclarationConstruct>("misplaced USE statement"_err_en_US) || |
| Parser<ImportStmt>{} >> |
| fail<DeclarationConstruct>( |
| "IMPORT statements must follow any USE statements and precede all other declarations"_err_en_US) || |
| Parser<ImplicitStmt>{} >> |
| fail<DeclarationConstruct>( |
| "IMPLICIT statements must follow USE and IMPORT and precede all other declarations"_err_en_US)}; |
| |
| TYPE_CONTEXT_PARSER("declaration construct"_en_US, |
| first(construct<DeclarationConstruct>(specificationConstruct), |
| construct<DeclarationConstruct>(statement(indirect(dataStmt))), |
| construct<DeclarationConstruct>(statement(indirect(formatStmt))), |
| construct<DeclarationConstruct>(statement(indirect(entryStmt))), |
| construct<DeclarationConstruct>( |
| statement(indirect(Parser<StmtFunctionStmt>{}))), |
| misplacedSpecificationStmt)) |
| |
| constexpr auto recoveredDeclarationConstruct{ |
| recovery(withMessage("expected declaration construct"_err_en_US, |
| declarationConstruct), |
| construct<DeclarationConstruct>(declErrorRecovery))}; |
| |
| // R504 specification-part -> |
| // [use-stmt]... [import-stmt]... [implicit-part] |
| // [declaration-construct]... |
| TYPE_CONTEXT_PARSER("specification part"_en_US, |
| construct<SpecificationPart>(many(openaccDeclarativeConstruct), |
| many(openmpDeclarativeConstruct), many(indirect(compilerDirective)), |
| many(statement(indirect(Parser<UseStmt>{}))), |
| many(unambiguousStatement(indirect(Parser<ImportStmt>{}))), |
| implicitPart, many(recoveredDeclarationConstruct))) |
| |
| // R507 variant of declaration-construct for use in limitedSpecificationPart. |
| constexpr auto invalidDeclarationStmt{formatStmt >> |
| fail<DeclarationConstruct>( |
| "FORMAT statements are not permitted in this specification part"_err_en_US) || |
| entryStmt >> |
| fail<DeclarationConstruct>( |
| "ENTRY statements are not permitted in this specification part"_err_en_US)}; |
| |
| constexpr auto limitedDeclarationConstruct{recovery( |
| withMessage("expected declaration construct"_err_en_US, |
| inContext("declaration construct"_en_US, |
| first(construct<DeclarationConstruct>(specificationConstruct), |
| construct<DeclarationConstruct>(statement(indirect(dataStmt))), |
| misplacedSpecificationStmt, invalidDeclarationStmt))), |
| construct<DeclarationConstruct>( |
| stmtErrorRecoveryStart >> skipStmtErrorRecovery))}; |
| |
| // R504 variant for many contexts (modules, submodules, BLOCK DATA subprograms, |
| // and interfaces) which have constraints on their specification parts that |
| // preclude FORMAT, ENTRY, and statement functions, and benefit from |
| // specialized error recovery in the event of a spurious executable |
| // statement. |
| constexpr auto limitedSpecificationPart{inContext("specification part"_en_US, |
| construct<SpecificationPart>(many(openaccDeclarativeConstruct), |
| many(openmpDeclarativeConstruct), many(indirect(compilerDirective)), |
| many(statement(indirect(Parser<UseStmt>{}))), |
| many(unambiguousStatement(indirect(Parser<ImportStmt>{}))), |
| implicitPart, many(limitedDeclarationConstruct)))}; |
| |
| // R508 specification-construct -> |
| // derived-type-def | enum-def | generic-stmt | interface-block | |
| // parameter-stmt | procedure-declaration-stmt | |
| // other-specification-stmt | type-declaration-stmt |
| TYPE_CONTEXT_PARSER("specification construct"_en_US, |
| first(construct<SpecificationConstruct>(indirect(Parser<DerivedTypeDef>{})), |
| construct<SpecificationConstruct>(indirect(Parser<EnumDef>{})), |
| construct<SpecificationConstruct>( |
| statement(indirect(Parser<GenericStmt>{}))), |
| construct<SpecificationConstruct>(indirect(interfaceBlock)), |
| construct<SpecificationConstruct>(statement(indirect(parameterStmt))), |
| construct<SpecificationConstruct>( |
| statement(indirect(oldParameterStmt))), |
| construct<SpecificationConstruct>( |
| statement(indirect(Parser<ProcedureDeclarationStmt>{}))), |
| construct<SpecificationConstruct>( |
| statement(Parser<OtherSpecificationStmt>{})), |
| construct<SpecificationConstruct>( |
| statement(indirect(typeDeclarationStmt))), |
| construct<SpecificationConstruct>(indirect(Parser<StructureDef>{})), |
| construct<SpecificationConstruct>( |
| indirect(openaccDeclarativeConstruct)), |
| construct<SpecificationConstruct>(indirect(openmpDeclarativeConstruct)), |
| construct<SpecificationConstruct>(indirect(compilerDirective)))) |
| |
| // R513 other-specification-stmt -> |
| // access-stmt | allocatable-stmt | asynchronous-stmt | bind-stmt | |
| // codimension-stmt | contiguous-stmt | dimension-stmt | external-stmt | |
| // intent-stmt | intrinsic-stmt | namelist-stmt | optional-stmt | |
| // pointer-stmt | protected-stmt | save-stmt | target-stmt | |
| // volatile-stmt | value-stmt | common-stmt | equivalence-stmt | |
| // (CUDA) CUDA-attributes-stmt |
| TYPE_PARSER(first( |
| construct<OtherSpecificationStmt>(indirect(Parser<AccessStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<AllocatableStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<AsynchronousStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<BindStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<CodimensionStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<ContiguousStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<DimensionStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<ExternalStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<IntentStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<IntrinsicStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<NamelistStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<OptionalStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<PointerStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<ProtectedStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<SaveStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<TargetStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<ValueStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<VolatileStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<CommonStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<EquivalenceStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<BasedPointerStmt>{})), |
| construct<OtherSpecificationStmt>(indirect(Parser<CUDAAttributesStmt>{})))) |
| |
| // R1401 main-program -> |
| // [program-stmt] [specification-part] [execution-part] |
| // [internal-subprogram-part] end-program-stmt |
| TYPE_CONTEXT_PARSER("main program"_en_US, |
| construct<MainProgram>(maybe(statement(Parser<ProgramStmt>{})), |
| specificationPart, executionPart, maybe(internalSubprogramPart), |
| unterminatedStatement(Parser<EndProgramStmt>{}))) |
| |
| // R1402 program-stmt -> PROGRAM program-name |
| // PGI allows empty parentheses after the name. |
| TYPE_CONTEXT_PARSER("PROGRAM statement"_en_US, |
| construct<ProgramStmt>("PROGRAM" >> name / |
| maybe(extension<LanguageFeature::ProgramParentheses>( |
| "nonstandard usage: parentheses in PROGRAM statement"_port_en_US, |
| parenthesized(ok))))) |
| |
| // R1403 end-program-stmt -> END [PROGRAM [program-name]] |
| TYPE_CONTEXT_PARSER("END PROGRAM statement"_en_US, |
| construct<EndProgramStmt>( |
| recovery("END" >> defaulted("PROGRAM" >> maybe(name)) / atEndOfStmt, |
| progUnitEndStmtErrorRecovery))) |
| |
| // R1404 module -> |
| // module-stmt [specification-part] [module-subprogram-part] |
| // end-module-stmt |
| TYPE_CONTEXT_PARSER("module"_en_US, |
| construct<Module>(statement(Parser<ModuleStmt>{}), limitedSpecificationPart, |
| maybe(Parser<ModuleSubprogramPart>{}), |
| unterminatedStatement(Parser<EndModuleStmt>{}))) |
| |
| // R1405 module-stmt -> MODULE module-name |
| TYPE_CONTEXT_PARSER( |
| "MODULE statement"_en_US, construct<ModuleStmt>("MODULE" >> name)) |
| |
| // R1406 end-module-stmt -> END [MODULE [module-name]] |
| TYPE_CONTEXT_PARSER("END MODULE statement"_en_US, |
| construct<EndModuleStmt>( |
| recovery("END" >> defaulted("MODULE" >> maybe(name)) / atEndOfStmt, |
| progUnitEndStmtErrorRecovery))) |
| |
| // R1407 module-subprogram-part -> contains-stmt [module-subprogram]... |
| TYPE_CONTEXT_PARSER("module subprogram part"_en_US, |
| construct<ModuleSubprogramPart>(statement(containsStmt), |
| many(StartNewSubprogram{} >> Parser<ModuleSubprogram>{}))) |
| |
| // R1408 module-subprogram -> |
| // function-subprogram | subroutine-subprogram | |
| // separate-module-subprogram |
| TYPE_PARSER(construct<ModuleSubprogram>(indirect(functionSubprogram)) || |
| construct<ModuleSubprogram>(indirect(subroutineSubprogram)) || |
| construct<ModuleSubprogram>(indirect(Parser<SeparateModuleSubprogram>{})) || |
| construct<ModuleSubprogram>(indirect(compilerDirective))) |
| |
| // R1410 module-nature -> INTRINSIC | NON_INTRINSIC |
| constexpr auto moduleNature{ |
| "INTRINSIC" >> pure(UseStmt::ModuleNature::Intrinsic) || |
| "NON_INTRINSIC" >> pure(UseStmt::ModuleNature::Non_Intrinsic)}; |
| |
| // R1409 use-stmt -> |
| // USE [[, module-nature] ::] module-name [, rename-list] | |
| // USE [[, module-nature] ::] module-name , ONLY : [only-list] |
| // N.B. Lookahead to the end of the statement is necessary to resolve |
| // ambiguity with assignments and statement function definitions that |
| // begin with the letters "USE". |
| TYPE_PARSER(construct<UseStmt>("USE" >> optionalBeforeColons(moduleNature), |
| name, ", ONLY :" >> optionalList(Parser<Only>{})) || |
| construct<UseStmt>("USE" >> optionalBeforeColons(moduleNature), name, |
| defaulted("," >> |
| nonemptyList("expected renamings"_err_en_US, Parser<Rename>{})) / |
| lookAhead(endOfStmt))) |
| |
| // R1411 rename -> |
| // local-name => use-name | |
| // OPERATOR ( local-defined-operator ) => |
| // OPERATOR ( use-defined-operator ) |
| TYPE_PARSER(construct<Rename>("OPERATOR (" >> |
| construct<Rename::Operators>( |
| definedOpName / ") => OPERATOR (", definedOpName / ")")) || |
| construct<Rename>(construct<Rename::Names>(name, "=>" >> name))) |
| |
| // R1412 only -> generic-spec | only-use-name | rename |
| // R1413 only-use-name -> use-name |
| // N.B. generic-spec and only-use-name are ambiguous; resolved with symbols |
| TYPE_PARSER(construct<Only>(Parser<Rename>{}) || |
| construct<Only>(indirect(genericSpec)) || construct<Only>(name)) |
| |
| // R1416 submodule -> |
| // submodule-stmt [specification-part] [module-subprogram-part] |
| // end-submodule-stmt |
| TYPE_CONTEXT_PARSER("submodule"_en_US, |
| construct<Submodule>(statement(Parser<SubmoduleStmt>{}), |
| limitedSpecificationPart, maybe(Parser<ModuleSubprogramPart>{}), |
| unterminatedStatement(Parser<EndSubmoduleStmt>{}))) |
| |
| // R1417 submodule-stmt -> SUBMODULE ( parent-identifier ) submodule-name |
| TYPE_CONTEXT_PARSER("SUBMODULE statement"_en_US, |
| construct<SubmoduleStmt>( |
| "SUBMODULE" >> parenthesized(Parser<ParentIdentifier>{}), name)) |
| |
| // R1418 parent-identifier -> ancestor-module-name [: parent-submodule-name] |
| TYPE_PARSER(construct<ParentIdentifier>(name, maybe(":" >> name))) |
| |
| // R1419 end-submodule-stmt -> END [SUBMODULE [submodule-name]] |
| TYPE_CONTEXT_PARSER("END SUBMODULE statement"_en_US, |
| construct<EndSubmoduleStmt>( |
| recovery("END" >> defaulted("SUBMODULE" >> maybe(name)) / atEndOfStmt, |
| progUnitEndStmtErrorRecovery))) |
| |
| // R1420 block-data -> block-data-stmt [specification-part] end-block-data-stmt |
| TYPE_CONTEXT_PARSER("BLOCK DATA subprogram"_en_US, |
| construct<BlockData>(statement(Parser<BlockDataStmt>{}), |
| limitedSpecificationPart, |
| unterminatedStatement(Parser<EndBlockDataStmt>{}))) |
| |
| // R1421 block-data-stmt -> BLOCK DATA [block-data-name] |
| TYPE_CONTEXT_PARSER("BLOCK DATA statement"_en_US, |
| construct<BlockDataStmt>("BLOCK DATA" >> maybe(name))) |
| |
| // R1422 end-block-data-stmt -> END [BLOCK DATA [block-data-name]] |
| TYPE_CONTEXT_PARSER("END BLOCK DATA statement"_en_US, |
| construct<EndBlockDataStmt>( |
| recovery("END" >> defaulted("BLOCK DATA" >> maybe(name)) / atEndOfStmt, |
| progUnitEndStmtErrorRecovery))) |
| |
| // R1501 interface-block -> |
| // interface-stmt [interface-specification]... end-interface-stmt |
| TYPE_PARSER(construct<InterfaceBlock>(statement(Parser<InterfaceStmt>{}), |
| many(Parser<InterfaceSpecification>{}), |
| statement(Parser<EndInterfaceStmt>{}))) |
| |
| // R1502 interface-specification -> interface-body | procedure-stmt |
| TYPE_PARSER(construct<InterfaceSpecification>(Parser<InterfaceBody>{}) || |
| construct<InterfaceSpecification>(statement(Parser<ProcedureStmt>{}))) |
| |
| // R1503 interface-stmt -> INTERFACE [generic-spec] | ABSTRACT INTERFACE |
| TYPE_PARSER(construct<InterfaceStmt>("INTERFACE" >> maybe(genericSpec)) || |
| construct<InterfaceStmt>(construct<Abstract>("ABSTRACT INTERFACE"_sptok))) |
| |
| // R1504 end-interface-stmt -> END INTERFACE [generic-spec] |
| TYPE_PARSER( |
| construct<EndInterfaceStmt>(recovery("END INTERFACE" >> maybe(genericSpec), |
| constructEndStmtErrorRecovery >> pure<std::optional<GenericSpec>>()))) |
| |
| // R1505 interface-body -> |
| // function-stmt [specification-part] end-function-stmt | |
| // subroutine-stmt [specification-part] end-subroutine-stmt |
| TYPE_CONTEXT_PARSER("interface body"_en_US, |
| construct<InterfaceBody>( |
| construct<InterfaceBody::Function>(statement(functionStmt), |
| indirect(limitedSpecificationPart), statement(endFunctionStmt))) || |
| construct<InterfaceBody>(construct<InterfaceBody::Subroutine>( |
| statement(subroutineStmt), indirect(limitedSpecificationPart), |
| statement(endSubroutineStmt)))) |
| |
| // R1507 specific-procedure -> procedure-name |
| constexpr auto specificProcedures{ |
| nonemptyList("expected specific procedure names"_err_en_US, name)}; |
| |
| // R1506 procedure-stmt -> [MODULE] PROCEDURE [::] specific-procedure-list |
| TYPE_PARSER(construct<ProcedureStmt>("MODULE PROCEDURE"_sptok >> |
| pure(ProcedureStmt::Kind::ModuleProcedure), |
| maybe("::"_tok) >> specificProcedures) || |
| construct<ProcedureStmt>( |
| "PROCEDURE" >> pure(ProcedureStmt::Kind::Procedure), |
| maybe("::"_tok) >> specificProcedures)) |
| |
| // R1508 generic-spec -> |
| // generic-name | OPERATOR ( defined-operator ) | |
| // ASSIGNMENT ( = ) | defined-io-generic-spec |
| // R1509 defined-io-generic-spec -> |
| // READ ( FORMATTED ) | READ ( UNFORMATTED ) | |
| // WRITE ( FORMATTED ) | WRITE ( UNFORMATTED ) |
| TYPE_PARSER(sourced(first(construct<GenericSpec>("OPERATOR" >> |
| parenthesized(Parser<DefinedOperator>{})), |
| construct<GenericSpec>( |
| construct<GenericSpec::Assignment>("ASSIGNMENT ( = )"_tok)), |
| construct<GenericSpec>( |
| construct<GenericSpec::ReadFormatted>("READ ( FORMATTED )"_tok)), |
| construct<GenericSpec>( |
| construct<GenericSpec::ReadUnformatted>("READ ( UNFORMATTED )"_tok)), |
| construct<GenericSpec>( |
| construct<GenericSpec::WriteFormatted>("WRITE ( FORMATTED )"_tok)), |
| construct<GenericSpec>( |
| construct<GenericSpec::WriteUnformatted>("WRITE ( UNFORMATTED )"_tok)), |
| construct<GenericSpec>(name)))) |
| |
| // R1510 generic-stmt -> |
| // GENERIC [, access-spec] :: generic-spec => specific-procedure-list |
| TYPE_PARSER(construct<GenericStmt>("GENERIC" >> maybe("," >> accessSpec), |
| "::" >> genericSpec, "=>" >> specificProcedures)) |
| |
| // R1511 external-stmt -> EXTERNAL [::] external-name-list |
| TYPE_PARSER( |
| "EXTERNAL" >> maybe("::"_tok) >> construct<ExternalStmt>(listOfNames)) |
| |
| // R1512 procedure-declaration-stmt -> |
| // PROCEDURE ( [proc-interface] ) [[, proc-attr-spec]... ::] |
| // proc-decl-list |
| TYPE_PARSER("PROCEDURE" >> |
| construct<ProcedureDeclarationStmt>(parenthesized(maybe(procInterface)), |
| optionalListBeforeColons(Parser<ProcAttrSpec>{}), |
| nonemptyList("expected procedure declarations"_err_en_US, procDecl))) |
| |
| // R1513 proc-interface -> interface-name | declaration-type-spec |
| // R1516 interface-name -> name |
| // N.B. Simple names of intrinsic types (e.g., "REAL") are not |
| // ambiguous here - they take precedence over derived type names |
| // thanks to C1516. |
| TYPE_PARSER( |
| construct<ProcInterface>(declarationTypeSpec / lookAhead(")"_tok)) || |
| construct<ProcInterface>(name)) |
| |
| // R1514 proc-attr-spec -> |
| // access-spec | proc-language-binding-spec | INTENT ( intent-spec ) | |
| // OPTIONAL | POINTER | PROTECTED | SAVE |
| TYPE_PARSER(construct<ProcAttrSpec>(accessSpec) || |
| construct<ProcAttrSpec>(languageBindingSpec) || |
| construct<ProcAttrSpec>("INTENT" >> parenthesized(intentSpec)) || |
| construct<ProcAttrSpec>(optional) || construct<ProcAttrSpec>(pointer) || |
| construct<ProcAttrSpec>(protectedAttr) || construct<ProcAttrSpec>(save)) |
| |
| // R1515 proc-decl -> procedure-entity-name [=> proc-pointer-init] |
| TYPE_PARSER(construct<ProcDecl>(name, maybe("=>" >> Parser<ProcPointerInit>{}))) |
| |
| // R1517 proc-pointer-init -> null-init | initial-proc-target |
| // R1518 initial-proc-target -> procedure-name |
| TYPE_PARSER( |
| construct<ProcPointerInit>(nullInit) || construct<ProcPointerInit>(name)) |
| |
| // R1519 intrinsic-stmt -> INTRINSIC [::] intrinsic-procedure-name-list |
| TYPE_PARSER( |
| "INTRINSIC" >> maybe("::"_tok) >> construct<IntrinsicStmt>(listOfNames)) |
| |
| // R1520 function-reference -> procedure-designator |
| // ( [actual-arg-spec-list] ) |
| TYPE_CONTEXT_PARSER("function reference"_en_US, |
| sourced(construct<FunctionReference>( |
| construct<Call>(Parser<ProcedureDesignator>{}, |
| parenthesized(optionalList(actualArgSpec))))) / |
| !"["_tok) |
| |
| // R1521 call-stmt -> CALL procedure-designator [chevrons] |
| /// [( [actual-arg-spec-list] )] |
| // (CUDA) chevrons -> <<< * | scalar-expr, scalar-expr [, scalar-int-expr |
| // [, scalar-int-expr ] ] >>> |
| constexpr auto starOrExpr{ |
| construct<CallStmt::StarOrExpr>("*" >> pure<std::optional<ScalarExpr>>() || |
| applyFunction(presentOptional<ScalarExpr>, scalarExpr))}; |
| TYPE_PARSER(extension<LanguageFeature::CUDA>( |
| "<<<" >> construct<CallStmt::Chevrons>(starOrExpr, ", " >> scalarExpr, |
| maybe("," >> scalarIntExpr), maybe("," >> scalarIntExpr)) / |
| ">>>")) |
| constexpr auto actualArgSpecList{optionalList(actualArgSpec)}; |
| TYPE_CONTEXT_PARSER("CALL statement"_en_US, |
| construct<CallStmt>( |
| sourced(construct<CallStmt>("CALL" >> Parser<ProcedureDesignator>{}, |
| maybe(Parser<CallStmt::Chevrons>{}) / space, |
| "(" >> actualArgSpecList / ")" || |
| lookAhead(endOfStmt) >> defaulted(actualArgSpecList))))) |
| |
| // R1522 procedure-designator -> |
| // procedure-name | proc-component-ref | data-ref % binding-name |
| TYPE_PARSER(construct<ProcedureDesignator>(Parser<ProcComponentRef>{}) || |
| construct<ProcedureDesignator>(name)) |
| |
| // R1523 actual-arg-spec -> [keyword =] actual-arg |
| TYPE_PARSER(construct<ActualArgSpec>( |
| maybe(keyword / "=" / !"="_ch), Parser<ActualArg>{})) |
| |
| // R1524 actual-arg -> |
| // expr | variable | procedure-name | proc-component-ref | |
| // alt-return-spec |
| // N.B. the "procedure-name" and "proc-component-ref" alternatives can't |
| // yet be distinguished from "variable", many instances of which can't be |
| // distinguished from "expr" anyway (to do so would misparse structure |
| // constructors and function calls as array elements). |
| // Semantics sorts it all out later. |
| TYPE_PARSER(construct<ActualArg>(expr) || |
| construct<ActualArg>(Parser<AltReturnSpec>{}) || |
| extension<LanguageFeature::PercentRefAndVal>( |
| "nonstandard usage: %REF"_port_en_US, |
| construct<ActualArg>( |
| construct<ActualArg::PercentRef>("%REF" >> parenthesized(expr)))) || |
| extension<LanguageFeature::PercentRefAndVal>( |
| "nonstandard usage: %VAL"_port_en_US, |
| construct<ActualArg>( |
| construct<ActualArg::PercentVal>("%VAL" >> parenthesized(expr))))) |
| |
| // R1525 alt-return-spec -> * label |
| TYPE_PARSER(construct<AltReturnSpec>(star >> label)) |
| |
| // R1527 prefix-spec -> |
| // declaration-type-spec | ELEMENTAL | IMPURE | MODULE | |
| // NON_RECURSIVE | PURE | RECURSIVE | |
| // (CUDA) ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... ) | |
| // LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list) |
| TYPE_PARSER(first("DEVICE" >> pure(common::CUDASubprogramAttrs::Device), |
| "GLOBAL" >> pure(common::CUDASubprogramAttrs::Global), |
| "GRID_GLOBAL" >> pure(common::CUDASubprogramAttrs::Grid_Global), |
| "HOST" >> pure(common::CUDASubprogramAttrs::Host))) |
| TYPE_PARSER(first(construct<PrefixSpec>(declarationTypeSpec), |
| construct<PrefixSpec>(construct<PrefixSpec::Elemental>("ELEMENTAL"_tok)), |
| construct<PrefixSpec>(construct<PrefixSpec::Impure>("IMPURE"_tok)), |
| construct<PrefixSpec>(construct<PrefixSpec::Module>("MODULE"_tok)), |
| construct<PrefixSpec>( |
| construct<PrefixSpec::Non_Recursive>("NON_RECURSIVE"_tok)), |
| construct<PrefixSpec>(construct<PrefixSpec::Pure>("PURE"_tok)), |
| construct<PrefixSpec>(construct<PrefixSpec::Recursive>("RECURSIVE"_tok)), |
| extension<LanguageFeature::CUDA>( |
| construct<PrefixSpec>(construct<PrefixSpec::Attributes>("ATTRIBUTES" >> |
| parenthesized( |
| optionalList(Parser<common::CUDASubprogramAttrs>{}))))), |
| extension<LanguageFeature::CUDA>(construct<PrefixSpec>( |
| construct<PrefixSpec::Launch_Bounds>("LAUNCH_BOUNDS" >> |
| parenthesized(nonemptyList( |
| "expected launch bounds"_err_en_US, scalarIntConstantExpr))))), |
| extension<LanguageFeature::CUDA>(construct<PrefixSpec>( |
| construct<PrefixSpec::Cluster_Dims>("CLUSTER_DIMS" >> |
| parenthesized(nonemptyList("expected cluster dimensions"_err_en_US, |
| scalarIntConstantExpr))))))) |
| |
| // R1529 function-subprogram -> |
| // function-stmt [specification-part] [execution-part] |
| // [internal-subprogram-part] end-function-stmt |
| TYPE_CONTEXT_PARSER("FUNCTION subprogram"_en_US, |
| construct<FunctionSubprogram>(statement(functionStmt), specificationPart, |
| executionPart, maybe(internalSubprogramPart), |
| unterminatedStatement(endFunctionStmt))) |
| |
| // R1532 suffix -> |
| // proc-language-binding-spec [RESULT ( result-name )] | |
| // RESULT ( result-name ) [proc-language-binding-spec] |
| TYPE_PARSER(construct<Suffix>( |
| languageBindingSpec, maybe("RESULT" >> parenthesized(name))) || |
| construct<Suffix>( |
| "RESULT" >> parenthesized(name), maybe(languageBindingSpec))) |
| |
| // R1533 end-function-stmt -> END [FUNCTION [function-name]] |
| TYPE_PARSER(construct<EndFunctionStmt>( |
| recovery("END" >> defaulted("FUNCTION" >> maybe(name)) / atEndOfStmt, |
| progUnitEndStmtErrorRecovery))) |
| |
| // R1534 subroutine-subprogram -> |
| // subroutine-stmt [specification-part] [execution-part] |
| // [internal-subprogram-part] end-subroutine-stmt |
| TYPE_CONTEXT_PARSER("SUBROUTINE subprogram"_en_US, |
| construct<SubroutineSubprogram>(statement(subroutineStmt), |
| specificationPart, executionPart, maybe(internalSubprogramPart), |
| unterminatedStatement(endSubroutineStmt))) |
| |
| // R1535 subroutine-stmt -> |
| // [prefix] SUBROUTINE subroutine-name [( [dummy-arg-list] ) |
| // [proc-language-binding-spec]] |
| TYPE_PARSER( |
| (construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name, |
| !"("_tok >> pure<std::list<DummyArg>>(), |
| pure<std::optional<LanguageBindingSpec>>()) || |
| construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name, |
| defaulted(parenthesized(optionalList(dummyArg))), |
| maybe(languageBindingSpec))) / |
| checkEndOfKnownStmt) |
| |
| // R1536 dummy-arg -> dummy-arg-name | * |
| TYPE_PARSER(construct<DummyArg>(name) || construct<DummyArg>(star)) |
| |
| // R1537 end-subroutine-stmt -> END [SUBROUTINE [subroutine-name]] |
| TYPE_PARSER(construct<EndSubroutineStmt>( |
| recovery("END" >> defaulted("SUBROUTINE" >> maybe(name)) / atEndOfStmt, |
| progUnitEndStmtErrorRecovery))) |
| |
| // R1538 separate-module-subprogram -> |
| // mp-subprogram-stmt [specification-part] [execution-part] |
| // [internal-subprogram-part] end-mp-subprogram-stmt |
| TYPE_CONTEXT_PARSER("separate module subprogram"_en_US, |
| construct<SeparateModuleSubprogram>(statement(Parser<MpSubprogramStmt>{}), |
| specificationPart, executionPart, maybe(internalSubprogramPart), |
| statement(Parser<EndMpSubprogramStmt>{}))) |
| |
| // R1539 mp-subprogram-stmt -> MODULE PROCEDURE procedure-name |
| TYPE_CONTEXT_PARSER("MODULE PROCEDURE statement"_en_US, |
| construct<MpSubprogramStmt>("MODULE PROCEDURE"_sptok >> name)) |
| |
| // R1540 end-mp-subprogram-stmt -> END [PROCEDURE [procedure-name]] |
| TYPE_CONTEXT_PARSER("END PROCEDURE statement"_en_US, |
| construct<EndMpSubprogramStmt>( |
| recovery("END" >> defaulted("PROCEDURE" >> maybe(name)) / atEndOfStmt, |
| progUnitEndStmtErrorRecovery))) |
| |
| // R1541 entry-stmt -> ENTRY entry-name [( [dummy-arg-list] ) [suffix]] |
| TYPE_PARSER( |
| "ENTRY" >> (construct<EntryStmt>(name, |
| parenthesized(optionalList(dummyArg)), maybe(suffix)) || |
| construct<EntryStmt>(name, construct<std::list<DummyArg>>(), |
| construct<std::optional<Suffix>>()))) |
| |
| // R1542 return-stmt -> RETURN [scalar-int-expr] |
| TYPE_CONTEXT_PARSER("RETURN statement"_en_US, |
| construct<ReturnStmt>("RETURN" >> maybe(scalarIntExpr))) |
| |
| // R1543 contains-stmt -> CONTAINS |
| TYPE_PARSER(construct<ContainsStmt>("CONTAINS"_tok)) |
| |
| // R1544 stmt-function-stmt -> |
| // function-name ( [dummy-arg-name-list] ) = scalar-expr |
| TYPE_CONTEXT_PARSER("statement function definition"_en_US, |
| construct<StmtFunctionStmt>( |
| name, parenthesized(optionalList(name)), "=" >> scalar(expr))) |
| } // namespace Fortran::parser |