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