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