648 lines · cpp
1//===-- lib/Parser/program-parsers.cpp ------------------------------------===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9// Per-type parsers for program units10 11#include "basic-parsers.h"12#include "expr-parsers.h"13#include "misc-parsers.h"14#include "stmt-parser.h"15#include "token-parsers.h"16#include "type-parser-implementation.h"17#include "flang/Parser/characters.h"18#include "flang/Parser/parse-tree.h"19 20namespace Fortran::parser {21 22// R1530 function-stmt ->23// [prefix] FUNCTION function-name ( [dummy-arg-name-list] ) [suffix]24// R1526 prefix -> prefix-spec [prefix-spec]...25// R1531 dummy-arg-name -> name26 27static constexpr auto validFunctionStmt{28 construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,29 parenthesized(optionalList(name)), maybe(suffix)) /30 atEndOfStmt ||31 construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name / atEndOfStmt,32 // PGI & Intel accept "FUNCTION F"33 extension<LanguageFeature::OmitFunctionDummies>(34 "nonstandard usage: FUNCTION statement without dummy argument list"_port_en_US,35 pure<std::list<Name>>()),36 pure<std::optional<Suffix>>())};37 38// function-stmt with error recovery -- used in interfaces and internal39// subprograms, but not at the top level, where REALFUNCTIONF and40// INTEGERPUREELEMENTALFUNCTIONG(10) might appear as the first statement41// of a main program.42TYPE_PARSER(validFunctionStmt ||43 construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,44 defaulted(parenthesized(optionalList(name))), maybe(suffix)) /45 checkEndOfKnownStmt)46 47// R502 program-unit ->48// main-program | external-subprogram | module | submodule | block-data49// R503 external-subprogram -> function-subprogram | subroutine-subprogram50// N.B. "module" must precede "external-subprogram" in this sequence of51// alternatives to avoid ambiguity with the MODULE keyword prefix that52// they recognize. I.e., "modulesubroutinefoo" should start a module53// "subroutinefoo", not a subroutine "foo" with the MODULE prefix. The54// ambiguity is exacerbated by the extension that accepts a function55// statement without an otherwise empty list of dummy arguments. That56// MODULE prefix is disallowed by a constraint (C1547) in this context,57// so the standard language is not ambiguous, but disabling its misrecognition58// here would require context-sensitive keyword recognition or variant parsers59// for several productions; giving the "module" production priority here is a60// cleaner solution, though regrettably subtle.61// Enforcing C1547 is done in semantics.62static constexpr auto programUnit{63 construct<ProgramUnit>(indirect(Parser<Module>{})) ||64 construct<ProgramUnit>(indirect(subroutineSubprogram)) ||65 construct<ProgramUnit>(indirect(Parser<Submodule>{})) ||66 construct<ProgramUnit>(indirect(Parser<BlockData>{})) ||67 lookAhead(maybe(label) >> validFunctionStmt) >>68 construct<ProgramUnit>(indirect(functionSubprogram)) ||69 construct<ProgramUnit>(indirect(Parser<MainProgram>{}))};70 71static constexpr auto normalProgramUnit{72 !consumedAllInput >> StartNewSubprogram{} >> programUnit /73 skipMany(";"_tok) / space / recovery(endOfLine, skipToNextLineIfAny)};74 75static constexpr auto globalCompilerDirective{76 construct<ProgramUnit>(indirect(compilerDirective))};77 78static constexpr auto globalOpenACCCompilerDirective{79 construct<ProgramUnit>(indirect(skipStuffBeforeStatement >>80 "!$ACC "_sptok >> Parser<OpenACCRoutineConstruct>{}))};81 82// R501 program -> program-unit [program-unit]...83// This is the top-level production for the Fortran language.84// F'2018 6.3.1 defines a program unit as a sequence of one or more lines,85// implying that a line can't be part of two distinct program units.86// Consequently, a program unit END statement should be the last statement87// on its line. We parse those END statements via unterminatedStatement()88// and then skip over the end of the line here.89TYPE_PARSER(90 construct<Program>(extension<LanguageFeature::EmptySourceFile>(91 "nonstandard usage: empty source file"_port_en_US,92 skipStuffBeforeStatement >> consumedAllInput >>93 pure<std::list<ProgramUnit>>()) ||94 some(globalCompilerDirective || globalOpenACCCompilerDirective ||95 normalProgramUnit) /96 skipStuffBeforeStatement))97 98// R507 declaration-construct ->99// specification-construct | data-stmt | format-stmt |100// entry-stmt | stmt-function-stmt101// N.B. These parsers incorporate recognition of some other statements that102// may have been misplaced in the sequence of statements that are acceptable103// as a specification part in order to improve error recovery.104// Also note that many instances of specification-part in the standard grammar105// are in contexts that impose constraints on the kinds of statements that106// are allowed, and so we have a variant production for declaration-construct107// that implements those constraints.108constexpr auto actionStmtLookAhead{first(actionStmt >> ok,109 // Also accept apparent action statements with errors if they might be110 // first in the execution part111 "ALLOCATE ("_tok, "CALL" >> name >> "("_tok, "GO TO"_tok, "OPEN ("_tok,112 "PRINT"_tok / space / !"("_tok, "READ ("_tok, "WRITE ("_tok)};113constexpr auto execPartLookAhead{first(actionStmtLookAhead,114 openaccConstruct >> ok, openmpExecDirective >> ok, "ASSOCIATE ("_tok,115 "BLOCK"_tok, "SELECT"_tok, "CHANGE TEAM"_sptok, "CRITICAL"_tok, "DO"_tok,116 "IF ("_tok, "WHERE ("_tok, "FORALL ("_tok, "!$CUF"_tok)};117constexpr auto declErrorRecovery{118 stmtErrorRecoveryStart >> !execPartLookAhead >> skipStmtErrorRecovery};119constexpr auto misplacedSpecificationStmt{Parser<UseStmt>{} >>120 fail<DeclarationConstruct>("misplaced USE statement"_err_en_US) ||121 Parser<ImportStmt>{} >>122 fail<DeclarationConstruct>(123 "IMPORT statements must follow any USE statements and precede all other declarations"_err_en_US) ||124 Parser<ImplicitStmt>{} >>125 fail<DeclarationConstruct>(126 "IMPLICIT statements must follow USE and IMPORT and precede all other declarations"_err_en_US)};127 128TYPE_CONTEXT_PARSER("declaration construct"_en_US,129 first(construct<DeclarationConstruct>(specificationConstruct),130 construct<DeclarationConstruct>(statement(indirect(dataStmt))),131 construct<DeclarationConstruct>(statement(indirect(formatStmt))),132 construct<DeclarationConstruct>(statement(indirect(entryStmt))),133 construct<DeclarationConstruct>(134 statement(indirect(Parser<StmtFunctionStmt>{}))),135 misplacedSpecificationStmt))136 137constexpr auto recoveredDeclarationConstruct{138 recovery(withMessage("expected declaration construct"_err_en_US,139 declarationConstruct),140 construct<DeclarationConstruct>(declErrorRecovery))};141 142// R504 specification-part ->143// [use-stmt]... [import-stmt]... [implicit-part]144// [declaration-construct]...145TYPE_CONTEXT_PARSER("specification part"_en_US,146 construct<SpecificationPart>(many(openaccDeclarativeConstruct),147 many(openmpDeclarativeConstruct), many(indirect(compilerDirective)),148 many(statement(indirect(Parser<UseStmt>{}))),149 many(unambiguousStatement(indirect(Parser<ImportStmt>{}))),150 implicitPart, many(recoveredDeclarationConstruct)))151 152// R507 variant of declaration-construct for use in limitedSpecificationPart.153constexpr auto invalidDeclarationStmt{formatStmt >>154 fail<DeclarationConstruct>(155 "FORMAT statements are not permitted in this specification part"_err_en_US) ||156 entryStmt >>157 fail<DeclarationConstruct>(158 "ENTRY statements are not permitted in this specification part"_err_en_US)};159 160constexpr auto limitedDeclarationConstruct{recovery(161 withMessage("expected declaration construct"_err_en_US,162 inContext("declaration construct"_en_US,163 first(construct<DeclarationConstruct>(specificationConstruct),164 construct<DeclarationConstruct>(statement(indirect(dataStmt))),165 misplacedSpecificationStmt, invalidDeclarationStmt))),166 construct<DeclarationConstruct>(167 stmtErrorRecoveryStart >> skipStmtErrorRecovery))};168 169// R504 variant for many contexts (modules, submodules, BLOCK DATA subprograms,170// and interfaces) which have constraints on their specification parts that171// preclude FORMAT, ENTRY, and statement functions, and benefit from172// specialized error recovery in the event of a spurious executable173// statement.174constexpr auto limitedSpecificationPart{inContext("specification part"_en_US,175 construct<SpecificationPart>(many(openaccDeclarativeConstruct),176 many(openmpDeclarativeConstruct), many(indirect(compilerDirective)),177 many(statement(indirect(Parser<UseStmt>{}))),178 many(unambiguousStatement(indirect(Parser<ImportStmt>{}))),179 implicitPart, many(limitedDeclarationConstruct)))};180 181// R508 specification-construct ->182// derived-type-def | enum-def | generic-stmt | interface-block |183// parameter-stmt | procedure-declaration-stmt |184// other-specification-stmt | type-declaration-stmt185TYPE_CONTEXT_PARSER("specification construct"_en_US,186 first(construct<SpecificationConstruct>(indirect(Parser<DerivedTypeDef>{})),187 construct<SpecificationConstruct>(indirect(Parser<EnumDef>{})),188 construct<SpecificationConstruct>(189 statement(indirect(Parser<GenericStmt>{}))),190 construct<SpecificationConstruct>(indirect(interfaceBlock)),191 construct<SpecificationConstruct>(statement(indirect(parameterStmt))),192 construct<SpecificationConstruct>(193 statement(indirect(oldParameterStmt))),194 construct<SpecificationConstruct>(195 statement(indirect(Parser<ProcedureDeclarationStmt>{}))),196 construct<SpecificationConstruct>(197 statement(Parser<OtherSpecificationStmt>{})),198 construct<SpecificationConstruct>(199 statement(indirect(typeDeclarationStmt))),200 construct<SpecificationConstruct>(indirect(Parser<StructureDef>{})),201 construct<SpecificationConstruct>(202 indirect(openaccDeclarativeConstruct)),203 construct<SpecificationConstruct>(indirect(openmpDeclarativeConstruct)),204 construct<SpecificationConstruct>(205 indirect(openmpMisplacedEndDirective)),206 construct<SpecificationConstruct>(indirect(openmpInvalidDirective)),207 construct<SpecificationConstruct>(indirect(compilerDirective))))208 209// R513 other-specification-stmt ->210// access-stmt | allocatable-stmt | asynchronous-stmt | bind-stmt |211// codimension-stmt | contiguous-stmt | dimension-stmt | external-stmt |212// intent-stmt | intrinsic-stmt | namelist-stmt | optional-stmt |213// pointer-stmt | protected-stmt | save-stmt | target-stmt |214// volatile-stmt | value-stmt | common-stmt | equivalence-stmt |215// (CUDA) CUDA-attributes-stmt216TYPE_PARSER(first(217 construct<OtherSpecificationStmt>(indirect(Parser<AccessStmt>{})),218 construct<OtherSpecificationStmt>(indirect(Parser<AllocatableStmt>{})),219 construct<OtherSpecificationStmt>(indirect(Parser<AsynchronousStmt>{})),220 construct<OtherSpecificationStmt>(indirect(Parser<BindStmt>{})),221 construct<OtherSpecificationStmt>(indirect(Parser<CodimensionStmt>{})),222 construct<OtherSpecificationStmt>(indirect(Parser<ContiguousStmt>{})),223 construct<OtherSpecificationStmt>(indirect(Parser<DimensionStmt>{})),224 construct<OtherSpecificationStmt>(indirect(Parser<ExternalStmt>{})),225 construct<OtherSpecificationStmt>(indirect(Parser<IntentStmt>{})),226 construct<OtherSpecificationStmt>(indirect(Parser<IntrinsicStmt>{})),227 construct<OtherSpecificationStmt>(indirect(Parser<NamelistStmt>{})),228 construct<OtherSpecificationStmt>(indirect(Parser<OptionalStmt>{})),229 construct<OtherSpecificationStmt>(indirect(Parser<PointerStmt>{})),230 construct<OtherSpecificationStmt>(indirect(Parser<ProtectedStmt>{})),231 construct<OtherSpecificationStmt>(indirect(Parser<SaveStmt>{})),232 construct<OtherSpecificationStmt>(indirect(Parser<TargetStmt>{})),233 construct<OtherSpecificationStmt>(indirect(Parser<ValueStmt>{})),234 construct<OtherSpecificationStmt>(indirect(Parser<VolatileStmt>{})),235 construct<OtherSpecificationStmt>(indirect(Parser<CommonStmt>{})),236 construct<OtherSpecificationStmt>(indirect(Parser<EquivalenceStmt>{})),237 construct<OtherSpecificationStmt>(indirect(Parser<BasedPointerStmt>{})),238 construct<OtherSpecificationStmt>(indirect(Parser<CUDAAttributesStmt>{}))))239 240// R1401 main-program ->241// [program-stmt] [specification-part] [execution-part]242// [internal-subprogram-part] end-program-stmt243TYPE_CONTEXT_PARSER("main program"_en_US,244 construct<MainProgram>(maybe(statement(Parser<ProgramStmt>{})),245 specificationPart, executionPart, maybe(internalSubprogramPart),246 unterminatedStatement(Parser<EndProgramStmt>{})))247 248// R1402 program-stmt -> PROGRAM program-name249// PGI allows empty parentheses after the name.250TYPE_CONTEXT_PARSER("PROGRAM statement"_en_US,251 construct<ProgramStmt>("PROGRAM" >> name /252 maybe(extension<LanguageFeature::ProgramParentheses>(253 "nonstandard usage: parentheses in PROGRAM statement"_port_en_US,254 parenthesized(ok)))))255 256// R1403 end-program-stmt -> END [PROGRAM [program-name]]257TYPE_CONTEXT_PARSER("END PROGRAM statement"_en_US,258 construct<EndProgramStmt>(259 recovery("END" >> defaulted("PROGRAM" >> maybe(name)) / atEndOfStmt,260 progUnitEndStmtErrorRecovery)))261 262// R1404 module ->263// module-stmt [specification-part] [module-subprogram-part]264// end-module-stmt265TYPE_CONTEXT_PARSER("module"_en_US,266 construct<Module>(statement(Parser<ModuleStmt>{}), limitedSpecificationPart,267 maybe(Parser<ModuleSubprogramPart>{}),268 unterminatedStatement(Parser<EndModuleStmt>{})))269 270// R1405 module-stmt -> MODULE module-name271TYPE_CONTEXT_PARSER(272 "MODULE statement"_en_US, construct<ModuleStmt>("MODULE" >> name))273 274// R1406 end-module-stmt -> END [MODULE [module-name]]275TYPE_CONTEXT_PARSER("END MODULE statement"_en_US,276 construct<EndModuleStmt>(277 recovery("END" >> defaulted("MODULE" >> maybe(name)) / atEndOfStmt,278 progUnitEndStmtErrorRecovery)))279 280// R1407 module-subprogram-part -> contains-stmt [module-subprogram]...281TYPE_CONTEXT_PARSER("module subprogram part"_en_US,282 construct<ModuleSubprogramPart>(statement(containsStmt),283 many(StartNewSubprogram{} >> Parser<ModuleSubprogram>{})))284 285// R1408 module-subprogram ->286// function-subprogram | subroutine-subprogram |287// separate-module-subprogram288TYPE_PARSER(construct<ModuleSubprogram>(indirect(functionSubprogram)) ||289 construct<ModuleSubprogram>(indirect(subroutineSubprogram)) ||290 construct<ModuleSubprogram>(indirect(Parser<SeparateModuleSubprogram>{})) ||291 construct<ModuleSubprogram>(indirect(compilerDirective)))292 293// R1410 module-nature -> INTRINSIC | NON_INTRINSIC294constexpr auto moduleNature{295 "INTRINSIC" >> pure(UseStmt::ModuleNature::Intrinsic) ||296 "NON_INTRINSIC" >> pure(UseStmt::ModuleNature::Non_Intrinsic)};297 298// R1409 use-stmt ->299// USE [[, module-nature] ::] module-name [, rename-list] |300// USE [[, module-nature] ::] module-name , ONLY : [only-list]301// N.B. Lookahead to the end of the statement is necessary to resolve302// ambiguity with assignments and statement function definitions that303// begin with the letters "USE".304TYPE_PARSER(construct<UseStmt>("USE" >> optionalBeforeColons(moduleNature),305 name, ", ONLY :" >> optionalList(Parser<Only>{})) ||306 construct<UseStmt>("USE" >> optionalBeforeColons(moduleNature), name,307 defaulted("," >>308 nonemptyList("expected renamings"_err_en_US, Parser<Rename>{})) /309 lookAhead(endOfStmt)))310 311// R1411 rename ->312// local-name => use-name |313// OPERATOR ( local-defined-operator ) =>314// OPERATOR ( use-defined-operator )315TYPE_PARSER(construct<Rename>("OPERATOR (" >>316 construct<Rename::Operators>(317 definedOpName / ") => OPERATOR (", definedOpName / ")")) ||318 construct<Rename>(construct<Rename::Names>(name, "=>" >> name)))319 320// R1412 only -> generic-spec | only-use-name | rename321// R1413 only-use-name -> use-name322// N.B. generic-spec and only-use-name are ambiguous; resolved with symbols323TYPE_PARSER(construct<Only>(Parser<Rename>{}) ||324 construct<Only>(indirect(genericSpec)) || construct<Only>(name))325 326// R1416 submodule ->327// submodule-stmt [specification-part] [module-subprogram-part]328// end-submodule-stmt329TYPE_CONTEXT_PARSER("submodule"_en_US,330 construct<Submodule>(statement(Parser<SubmoduleStmt>{}),331 limitedSpecificationPart, maybe(Parser<ModuleSubprogramPart>{}),332 unterminatedStatement(Parser<EndSubmoduleStmt>{})))333 334// R1417 submodule-stmt -> SUBMODULE ( parent-identifier ) submodule-name335TYPE_CONTEXT_PARSER("SUBMODULE statement"_en_US,336 construct<SubmoduleStmt>(337 "SUBMODULE" >> parenthesized(Parser<ParentIdentifier>{}), name))338 339// R1418 parent-identifier -> ancestor-module-name [: parent-submodule-name]340TYPE_PARSER(construct<ParentIdentifier>(name, maybe(":" >> name)))341 342// R1419 end-submodule-stmt -> END [SUBMODULE [submodule-name]]343TYPE_CONTEXT_PARSER("END SUBMODULE statement"_en_US,344 construct<EndSubmoduleStmt>(345 recovery("END" >> defaulted("SUBMODULE" >> maybe(name)) / atEndOfStmt,346 progUnitEndStmtErrorRecovery)))347 348// R1420 block-data -> block-data-stmt [specification-part] end-block-data-stmt349TYPE_CONTEXT_PARSER("BLOCK DATA subprogram"_en_US,350 construct<BlockData>(statement(Parser<BlockDataStmt>{}),351 limitedSpecificationPart,352 unterminatedStatement(Parser<EndBlockDataStmt>{})))353 354// R1421 block-data-stmt -> BLOCK DATA [block-data-name]355TYPE_CONTEXT_PARSER("BLOCK DATA statement"_en_US,356 construct<BlockDataStmt>("BLOCK DATA" >> maybe(name)))357 358// R1422 end-block-data-stmt -> END [BLOCK DATA [block-data-name]]359TYPE_CONTEXT_PARSER("END BLOCK DATA statement"_en_US,360 construct<EndBlockDataStmt>(361 recovery("END" >> defaulted("BLOCK DATA" >> maybe(name)) / atEndOfStmt,362 progUnitEndStmtErrorRecovery)))363 364// R1501 interface-block ->365// interface-stmt [interface-specification]... end-interface-stmt366TYPE_PARSER(construct<InterfaceBlock>(statement(Parser<InterfaceStmt>{}),367 many(Parser<InterfaceSpecification>{}),368 statement(Parser<EndInterfaceStmt>{})))369 370// R1502 interface-specification -> interface-body | procedure-stmt371TYPE_PARSER(construct<InterfaceSpecification>(Parser<InterfaceBody>{}) ||372 construct<InterfaceSpecification>(statement(Parser<ProcedureStmt>{})))373 374// R1503 interface-stmt -> INTERFACE [generic-spec] | ABSTRACT INTERFACE375TYPE_PARSER(construct<InterfaceStmt>("INTERFACE" >> maybe(genericSpec)) ||376 construct<InterfaceStmt>(construct<Abstract>("ABSTRACT INTERFACE"_sptok)))377 378// R1504 end-interface-stmt -> END INTERFACE [generic-spec]379TYPE_PARSER(380 construct<EndInterfaceStmt>(recovery("END INTERFACE" >> maybe(genericSpec),381 constructEndStmtErrorRecovery >> pure<std::optional<GenericSpec>>())))382 383// R1505 interface-body ->384// function-stmt [specification-part] end-function-stmt |385// subroutine-stmt [specification-part] end-subroutine-stmt386TYPE_CONTEXT_PARSER("interface body"_en_US,387 construct<InterfaceBody>(388 construct<InterfaceBody::Function>(statement(functionStmt),389 indirect(limitedSpecificationPart), statement(endFunctionStmt))) ||390 construct<InterfaceBody>(construct<InterfaceBody::Subroutine>(391 statement(subroutineStmt), indirect(limitedSpecificationPart),392 statement(endSubroutineStmt))))393 394// R1507 specific-procedure -> procedure-name395constexpr auto specificProcedures{396 nonemptyList("expected specific procedure names"_err_en_US, name)};397 398// R1506 procedure-stmt -> [MODULE] PROCEDURE [::] specific-procedure-list399TYPE_PARSER(construct<ProcedureStmt>("MODULE PROCEDURE"_sptok >>400 pure(ProcedureStmt::Kind::ModuleProcedure),401 maybe("::"_tok) >> specificProcedures) ||402 construct<ProcedureStmt>(403 "PROCEDURE" >> pure(ProcedureStmt::Kind::Procedure),404 maybe("::"_tok) >> specificProcedures))405 406// R1508 generic-spec ->407// generic-name | OPERATOR ( defined-operator ) |408// ASSIGNMENT ( = ) | defined-io-generic-spec409// R1509 defined-io-generic-spec ->410// READ ( FORMATTED ) | READ ( UNFORMATTED ) |411// WRITE ( FORMATTED ) | WRITE ( UNFORMATTED )412TYPE_PARSER(sourced(first(construct<GenericSpec>("OPERATOR" >>413 parenthesized(Parser<DefinedOperator>{})),414 construct<GenericSpec>(415 construct<GenericSpec::Assignment>("ASSIGNMENT ( = )"_tok)),416 construct<GenericSpec>(417 construct<GenericSpec::ReadFormatted>("READ ( FORMATTED )"_tok)),418 construct<GenericSpec>(419 construct<GenericSpec::ReadUnformatted>("READ ( UNFORMATTED )"_tok)),420 construct<GenericSpec>(421 construct<GenericSpec::WriteFormatted>("WRITE ( FORMATTED )"_tok)),422 construct<GenericSpec>(423 construct<GenericSpec::WriteUnformatted>("WRITE ( UNFORMATTED )"_tok)),424 construct<GenericSpec>(name))))425 426// R1510 generic-stmt ->427// GENERIC [, access-spec] :: generic-spec => specific-procedure-list428TYPE_PARSER(construct<GenericStmt>("GENERIC" >> maybe("," >> accessSpec),429 "::" >> genericSpec, "=>" >> specificProcedures))430 431// R1511 external-stmt -> EXTERNAL [::] external-name-list432TYPE_PARSER(433 "EXTERNAL" >> maybe("::"_tok) >> construct<ExternalStmt>(listOfNames))434 435// R1512 procedure-declaration-stmt ->436// PROCEDURE ( [proc-interface] ) [[, proc-attr-spec]... ::]437// proc-decl-list438TYPE_PARSER("PROCEDURE" >>439 construct<ProcedureDeclarationStmt>(parenthesized(maybe(procInterface)),440 optionalListBeforeColons(Parser<ProcAttrSpec>{}),441 nonemptyList("expected procedure declarations"_err_en_US, procDecl)))442 443// R1513 proc-interface -> interface-name | declaration-type-spec444// R1516 interface-name -> name445// N.B. Simple names of intrinsic types (e.g., "REAL") are not446// ambiguous here - they take precedence over derived type names447// thanks to C1516.448TYPE_PARSER(449 construct<ProcInterface>(declarationTypeSpec / lookAhead(")"_tok)) ||450 construct<ProcInterface>(name))451 452// R1514 proc-attr-spec ->453// access-spec | proc-language-binding-spec | INTENT ( intent-spec ) |454// OPTIONAL | POINTER | PROTECTED | SAVE455TYPE_PARSER(construct<ProcAttrSpec>(accessSpec) ||456 construct<ProcAttrSpec>(languageBindingSpec) ||457 construct<ProcAttrSpec>("INTENT" >> parenthesized(intentSpec)) ||458 construct<ProcAttrSpec>(optional) || construct<ProcAttrSpec>(pointer) ||459 construct<ProcAttrSpec>(protectedAttr) || construct<ProcAttrSpec>(save))460 461// R1515 proc-decl -> procedure-entity-name [=> proc-pointer-init]462TYPE_PARSER(construct<ProcDecl>(name, maybe("=>" >> Parser<ProcPointerInit>{})))463 464// R1517 proc-pointer-init -> null-init | initial-proc-target465// R1518 initial-proc-target -> procedure-name466TYPE_PARSER(467 construct<ProcPointerInit>(nullInit) || construct<ProcPointerInit>(name))468 469// R1519 intrinsic-stmt -> INTRINSIC [::] intrinsic-procedure-name-list470TYPE_PARSER(471 "INTRINSIC" >> maybe("::"_tok) >> construct<IntrinsicStmt>(listOfNames))472 473// R1520 function-reference -> procedure-designator474// ( [actual-arg-spec-list] )475TYPE_CONTEXT_PARSER("function reference"_en_US,476 sourced(construct<FunctionReference>(477 construct<Call>(Parser<ProcedureDesignator>{},478 parenthesized(optionalList(actualArgSpec))))) /479 !"["_tok)480 481// R1521 call-stmt -> CALL procedure-designator [chevrons]482/// [( [actual-arg-spec-list] )]483// (CUDA) chevrons -> <<< * | scalar-expr, scalar-expr [, scalar-int-expr484// [, scalar-int-expr ] ] >>>485constexpr auto starOrExpr{486 construct<CallStmt::StarOrExpr>("*" >> pure<std::optional<ScalarExpr>>() ||487 applyFunction(presentOptional<ScalarExpr>, scalarExpr))};488TYPE_PARSER(extension<LanguageFeature::CUDA>(489 "<<<" >> construct<CallStmt::Chevrons>(starOrExpr, ", " >> scalarExpr,490 maybe("," >> scalarExpr), maybe("," >> scalarIntExpr)) /491 ">>>"))492constexpr auto actualArgSpecList{optionalList(actualArgSpec)};493TYPE_CONTEXT_PARSER("CALL statement"_en_US,494 construct<CallStmt>(495 sourced(construct<CallStmt>("CALL" >> Parser<ProcedureDesignator>{},496 maybe(Parser<CallStmt::Chevrons>{}) / space,497 "(" >> actualArgSpecList / ")" ||498 lookAhead(endOfStmt) >> defaulted(actualArgSpecList)))))499 500// R1522 procedure-designator ->501// procedure-name | proc-component-ref | data-ref % binding-name502TYPE_PARSER(construct<ProcedureDesignator>(Parser<ProcComponentRef>{}) ||503 construct<ProcedureDesignator>(name))504 505// R1523 actual-arg-spec -> [keyword =] actual-arg506TYPE_PARSER(construct<ActualArgSpec>(507 maybe(keyword / "=" / !"="_ch), Parser<ActualArg>{}))508 509// R1524 actual-arg ->510// expr | variable | procedure-name | proc-component-ref |511// alt-return-spec512// N.B. the "procedure-name" and "proc-component-ref" alternatives can't513// yet be distinguished from "variable", many instances of which can't be514// distinguished from "expr" anyway (to do so would misparse structure515// constructors and function calls as array elements).516// Semantics sorts it all out later.517TYPE_PARSER(construct<ActualArg>(expr) ||518 construct<ActualArg>(Parser<AltReturnSpec>{}) ||519 extension<LanguageFeature::PercentRefAndVal>(520 "nonstandard usage: %REF"_port_en_US,521 construct<ActualArg>(522 construct<ActualArg::PercentRef>("%REF" >> parenthesized(expr)))) ||523 extension<LanguageFeature::PercentRefAndVal>(524 "nonstandard usage: %VAL"_port_en_US,525 construct<ActualArg>(526 construct<ActualArg::PercentVal>("%VAL" >> parenthesized(expr)))))527 528// R1525 alt-return-spec -> * label529TYPE_PARSER(construct<AltReturnSpec>(star >> label))530 531// R1527 prefix-spec ->532// declaration-type-spec | ELEMENTAL | IMPURE | MODULE |533// NON_RECURSIVE | PURE | RECURSIVE |534// (CUDA) ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... ) |535// LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list)536TYPE_PARSER(first("DEVICE" >> pure(common::CUDASubprogramAttrs::Device),537 "GLOBAL" >> pure(common::CUDASubprogramAttrs::Global),538 "GRID_GLOBAL" >> pure(common::CUDASubprogramAttrs::Grid_Global),539 "HOST" >> pure(common::CUDASubprogramAttrs::Host)))540TYPE_PARSER(first(construct<PrefixSpec>(declarationTypeSpec),541 construct<PrefixSpec>(construct<PrefixSpec::Elemental>("ELEMENTAL"_tok)),542 construct<PrefixSpec>(construct<PrefixSpec::Impure>("IMPURE"_tok)),543 construct<PrefixSpec>(construct<PrefixSpec::Module>("MODULE"_tok)),544 construct<PrefixSpec>(545 construct<PrefixSpec::Non_Recursive>("NON_RECURSIVE"_tok)),546 construct<PrefixSpec>(construct<PrefixSpec::Pure>("PURE"_tok)),547 construct<PrefixSpec>(construct<PrefixSpec::Recursive>("RECURSIVE"_tok)),548 extension<LanguageFeature::CUDA>(549 construct<PrefixSpec>(construct<PrefixSpec::Attributes>("ATTRIBUTES" >>550 parenthesized(551 optionalList(Parser<common::CUDASubprogramAttrs>{}))))),552 extension<LanguageFeature::CUDA>(construct<PrefixSpec>(553 construct<PrefixSpec::Launch_Bounds>("LAUNCH_BOUNDS" >>554 parenthesized(nonemptyList(555 "expected launch bounds"_err_en_US, scalarIntConstantExpr))))),556 extension<LanguageFeature::CUDA>(construct<PrefixSpec>(557 construct<PrefixSpec::Cluster_Dims>("CLUSTER_DIMS" >>558 parenthesized(nonemptyList("expected cluster dimensions"_err_en_US,559 scalarIntConstantExpr)))))))560 561// R1529 function-subprogram ->562// function-stmt [specification-part] [execution-part]563// [internal-subprogram-part] end-function-stmt564TYPE_CONTEXT_PARSER("FUNCTION subprogram"_en_US,565 construct<FunctionSubprogram>(statement(functionStmt), specificationPart,566 executionPart, maybe(internalSubprogramPart),567 unterminatedStatement(endFunctionStmt)))568 569// R1532 suffix ->570// proc-language-binding-spec [RESULT ( result-name )] |571// RESULT ( result-name ) [proc-language-binding-spec]572TYPE_PARSER(construct<Suffix>(573 languageBindingSpec, maybe("RESULT" >> parenthesized(name))) ||574 construct<Suffix>(575 "RESULT" >> parenthesized(name), maybe(languageBindingSpec)))576 577// R1533 end-function-stmt -> END [FUNCTION [function-name]]578TYPE_PARSER(construct<EndFunctionStmt>(579 recovery("END" >> defaulted("FUNCTION" >> maybe(name)) / atEndOfStmt,580 progUnitEndStmtErrorRecovery)))581 582// R1534 subroutine-subprogram ->583// subroutine-stmt [specification-part] [execution-part]584// [internal-subprogram-part] end-subroutine-stmt585TYPE_CONTEXT_PARSER("SUBROUTINE subprogram"_en_US,586 construct<SubroutineSubprogram>(statement(subroutineStmt),587 specificationPart, executionPart, maybe(internalSubprogramPart),588 unterminatedStatement(endSubroutineStmt)))589 590// R1535 subroutine-stmt ->591// [prefix] SUBROUTINE subroutine-name [( [dummy-arg-list] )592// [proc-language-binding-spec]]593TYPE_PARSER(594 (construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,595 !"("_tok >> pure<std::list<DummyArg>>(),596 pure<std::optional<LanguageBindingSpec>>()) ||597 construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,598 defaulted(parenthesized(optionalList(dummyArg))),599 maybe(languageBindingSpec))) /600 checkEndOfKnownStmt)601 602// R1536 dummy-arg -> dummy-arg-name | *603TYPE_PARSER(construct<DummyArg>(name) || construct<DummyArg>(star))604 605// R1537 end-subroutine-stmt -> END [SUBROUTINE [subroutine-name]]606TYPE_PARSER(construct<EndSubroutineStmt>(607 recovery("END" >> defaulted("SUBROUTINE" >> maybe(name)) / atEndOfStmt,608 progUnitEndStmtErrorRecovery)))609 610// R1538 separate-module-subprogram ->611// mp-subprogram-stmt [specification-part] [execution-part]612// [internal-subprogram-part] end-mp-subprogram-stmt613TYPE_CONTEXT_PARSER("separate module subprogram"_en_US,614 construct<SeparateModuleSubprogram>(statement(Parser<MpSubprogramStmt>{}),615 specificationPart, executionPart, maybe(internalSubprogramPart),616 statement(Parser<EndMpSubprogramStmt>{})))617 618// R1539 mp-subprogram-stmt -> MODULE PROCEDURE procedure-name619TYPE_CONTEXT_PARSER("MODULE PROCEDURE statement"_en_US,620 construct<MpSubprogramStmt>("MODULE PROCEDURE"_sptok >> name))621 622// R1540 end-mp-subprogram-stmt -> END [PROCEDURE [procedure-name]]623TYPE_CONTEXT_PARSER("END PROCEDURE statement"_en_US,624 construct<EndMpSubprogramStmt>(625 recovery("END" >> defaulted("PROCEDURE" >> maybe(name)) / atEndOfStmt,626 progUnitEndStmtErrorRecovery)))627 628// R1541 entry-stmt -> ENTRY entry-name [( [dummy-arg-list] ) [suffix]]629TYPE_PARSER(630 "ENTRY" >> (construct<EntryStmt>(name,631 parenthesized(optionalList(dummyArg)), maybe(suffix)) ||632 construct<EntryStmt>(name, construct<std::list<DummyArg>>(),633 construct<std::optional<Suffix>>())))634 635// R1542 return-stmt -> RETURN [scalar-int-expr]636TYPE_CONTEXT_PARSER("RETURN statement"_en_US,637 construct<ReturnStmt>("RETURN" >> maybe(scalarIntExpr)))638 639// R1543 contains-stmt -> CONTAINS640TYPE_PARSER(construct<ContainsStmt>("CONTAINS"_tok))641 642// R1544 stmt-function-stmt ->643// function-name ( [dummy-arg-name-list] ) = scalar-expr644TYPE_CONTEXT_PARSER("statement function definition"_en_US,645 construct<StmtFunctionStmt>(646 name, parenthesized(optionalList(name)), "=" >> scalar(expr)))647} // namespace Fortran::parser648