llvm-project

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
// R502 program-unit ->
23
//        main-program | external-subprogram | module | submodule | block-data
24
// R503 external-subprogram -> function-subprogram | subroutine-subprogram
25
// N.B. "module" must precede "external-subprogram" in this sequence of
26
// alternatives to avoid ambiguity with the MODULE keyword prefix that
27
// they recognize.  I.e., "modulesubroutinefoo" should start a module
28
// "subroutinefoo", not a subroutine "foo" with the MODULE prefix.  The
29
// ambiguity is exacerbated by the extension that accepts a function
30
// statement without an otherwise empty list of dummy arguments.  That
31
// MODULE prefix is disallowed by a constraint (C1547) in this context,
32
// so the standard language is not ambiguous, but disabling its misrecognition
33
// here would require context-sensitive keyword recognition or variant parsers
34
// for several productions; giving the "module" production priority here is a
35
// cleaner solution, though regrettably subtle.
36
// Enforcing C1547 is done in semantics.
37
static constexpr auto programUnit{
38
    construct<ProgramUnit>(indirect(Parser<Module>{})) ||
39
    construct<ProgramUnit>(indirect(functionSubprogram)) ||
40
    construct<ProgramUnit>(indirect(subroutineSubprogram)) ||
41
    construct<ProgramUnit>(indirect(Parser<Submodule>{})) ||
42
    construct<ProgramUnit>(indirect(Parser<BlockData>{})) ||
43
    construct<ProgramUnit>(indirect(Parser<MainProgram>{}))};
44
static constexpr auto normalProgramUnit{StartNewSubprogram{} >> programUnit /
45
        skipMany(";"_tok) / space / recovery(endOfLine, SkipPast<'\n'>{})};
46
static constexpr auto globalCompilerDirective{
47
    construct<ProgramUnit>(indirect(compilerDirective))};
48

49
static constexpr auto globalOpenACCCompilerDirective{
50
    construct<ProgramUnit>(indirect(skipStuffBeforeStatement >>
51
        "!$ACC "_sptok >> Parser<OpenACCRoutineConstruct>{}))};
52

53
// R501 program -> program-unit [program-unit]...
54
// This is the top-level production for the Fortran language.
55
// F'2018 6.3.1 defines a program unit as a sequence of one or more lines,
56
// implying that a line can't be part of two distinct program units.
57
// Consequently, a program unit END statement should be the last statement
58
// on its line.  We parse those END statements via unterminatedStatement()
59
// and then skip over the end of the line here.
60
TYPE_PARSER(
61
    construct<Program>(extension<LanguageFeature::EmptySourceFile>(
62
                           "nonstandard usage: empty source file"_port_en_US,
63
                           skipStuffBeforeStatement >> !nextCh >>
64
                               pure<std::list<ProgramUnit>>()) ||
65
        some(globalCompilerDirective || globalOpenACCCompilerDirective ||
66
            normalProgramUnit) /
67
            skipStuffBeforeStatement))
68

69
// R504 specification-part ->
70
//         [use-stmt]... [import-stmt]... [implicit-part]
71
//         [declaration-construct]...
72
TYPE_CONTEXT_PARSER("specification part"_en_US,
73
    construct<SpecificationPart>(many(openaccDeclarativeConstruct),
74
        many(openmpDeclarativeConstruct), many(indirect(compilerDirective)),
75
        many(statement(indirect(Parser<UseStmt>{}))),
76
        many(unambiguousStatement(indirect(Parser<ImportStmt>{}))),
77
        implicitPart, many(declarationConstruct)))
78

79
// R507 declaration-construct ->
80
//        specification-construct | data-stmt | format-stmt |
81
//        entry-stmt | stmt-function-stmt
82
// N.B. These parsers incorporate recognition of some other statements that
83
// may have been misplaced in the sequence of statements that are acceptable
84
// as a specification part in order to improve error recovery.
85
// Also note that many instances of specification-part in the standard grammar
86
// are in contexts that impose constraints on the kinds of statements that
87
// are allowed, and so we have a variant production for declaration-construct
88
// that implements those constraints.
89
constexpr auto actionStmtLookAhead{first(actionStmt >> ok,
90
    // Also accept apparent action statements with errors if they might be
91
    // first in the execution part
92
    "ALLOCATE ("_tok, "CALL" >> name >> "("_tok, "GO TO"_tok, "OPEN ("_tok,
93
    "PRINT"_tok / space / !"("_tok, "READ ("_tok, "WRITE ("_tok)};
94
constexpr auto execPartLookAhead{first(actionStmtLookAhead >> ok,
95
    openaccConstruct >> ok, openmpConstruct >> ok, "ASSOCIATE ("_tok,
96
    "BLOCK"_tok, "SELECT"_tok, "CHANGE TEAM"_sptok, "CRITICAL"_tok, "DO"_tok,
97
    "IF ("_tok, "WHERE ("_tok, "FORALL ("_tok, "!$CUF"_tok)};
98
constexpr auto declErrorRecovery{
99
    stmtErrorRecoveryStart >> !execPartLookAhead >> skipStmtErrorRecovery};
100
constexpr auto misplacedSpecificationStmt{Parser<UseStmt>{} >>
101
        fail<DeclarationConstruct>("misplaced USE statement"_err_en_US) ||
102
    Parser<ImportStmt>{} >>
103
        fail<DeclarationConstruct>(
104
            "IMPORT statements must follow any USE statements and precede all other declarations"_err_en_US) ||
105
    Parser<ImplicitStmt>{} >>
106
        fail<DeclarationConstruct>(
107
            "IMPLICIT statements must follow USE and IMPORT and precede all other declarations"_err_en_US)};
108

109
TYPE_PARSER(recovery(
110
    withMessage("expected declaration construct"_err_en_US,
111
        CONTEXT_PARSER("declaration construct"_en_US,
112
            first(construct<DeclarationConstruct>(specificationConstruct),
113
                construct<DeclarationConstruct>(statement(indirect(dataStmt))),
114
                construct<DeclarationConstruct>(
115
                    statement(indirect(formatStmt))),
116
                construct<DeclarationConstruct>(statement(indirect(entryStmt))),
117
                construct<DeclarationConstruct>(
118
                    statement(indirect(Parser<StmtFunctionStmt>{}))),
119
                misplacedSpecificationStmt))),
120
    construct<DeclarationConstruct>(declErrorRecovery)))
121

122
// R507 variant of declaration-construct for use in limitedSpecificationPart.
123
constexpr auto invalidDeclarationStmt{formatStmt >>
124
        fail<DeclarationConstruct>(
125
            "FORMAT statements are not permitted in this specification part"_err_en_US) ||
126
    entryStmt >>
127
        fail<DeclarationConstruct>(
128
            "ENTRY statements are not permitted in this specification part"_err_en_US)};
129

130
constexpr auto limitedDeclarationConstruct{recovery(
131
    withMessage("expected declaration construct"_err_en_US,
132
        inContext("declaration construct"_en_US,
133
            first(construct<DeclarationConstruct>(specificationConstruct),
134
                construct<DeclarationConstruct>(statement(indirect(dataStmt))),
135
                misplacedSpecificationStmt, invalidDeclarationStmt))),
136
    construct<DeclarationConstruct>(
137
        stmtErrorRecoveryStart >> skipStmtErrorRecovery))};
138

139
// R504 variant for many contexts (modules, submodules, BLOCK DATA subprograms,
140
// and interfaces) which have constraints on their specification parts that
141
// preclude FORMAT, ENTRY, and statement functions, and benefit from
142
// specialized error recovery in the event of a spurious executable
143
// statement.
144
constexpr auto limitedSpecificationPart{inContext("specification part"_en_US,
145
    construct<SpecificationPart>(many(openaccDeclarativeConstruct),
146
        many(openmpDeclarativeConstruct), many(indirect(compilerDirective)),
147
        many(statement(indirect(Parser<UseStmt>{}))),
148
        many(unambiguousStatement(indirect(Parser<ImportStmt>{}))),
149
        implicitPart, many(limitedDeclarationConstruct)))};
150

151
// R508 specification-construct ->
152
//        derived-type-def | enum-def | generic-stmt | interface-block |
153
//        parameter-stmt | procedure-declaration-stmt |
154
//        other-specification-stmt | type-declaration-stmt
155
TYPE_CONTEXT_PARSER("specification construct"_en_US,
156
    first(construct<SpecificationConstruct>(indirect(Parser<DerivedTypeDef>{})),
157
        construct<SpecificationConstruct>(indirect(Parser<EnumDef>{})),
158
        construct<SpecificationConstruct>(
159
            statement(indirect(Parser<GenericStmt>{}))),
160
        construct<SpecificationConstruct>(indirect(interfaceBlock)),
161
        construct<SpecificationConstruct>(statement(indirect(parameterStmt))),
162
        construct<SpecificationConstruct>(
163
            statement(indirect(oldParameterStmt))),
164
        construct<SpecificationConstruct>(
165
            statement(indirect(Parser<ProcedureDeclarationStmt>{}))),
166
        construct<SpecificationConstruct>(
167
            statement(Parser<OtherSpecificationStmt>{})),
168
        construct<SpecificationConstruct>(
169
            statement(indirect(typeDeclarationStmt))),
170
        construct<SpecificationConstruct>(indirect(Parser<StructureDef>{})),
171
        construct<SpecificationConstruct>(
172
            indirect(openaccDeclarativeConstruct)),
173
        construct<SpecificationConstruct>(indirect(openmpDeclarativeConstruct)),
174
        construct<SpecificationConstruct>(indirect(compilerDirective))))
175

176
// R513 other-specification-stmt ->
177
//        access-stmt | allocatable-stmt | asynchronous-stmt | bind-stmt |
178
//        codimension-stmt | contiguous-stmt | dimension-stmt | external-stmt |
179
//        intent-stmt | intrinsic-stmt | namelist-stmt | optional-stmt |
180
//        pointer-stmt | protected-stmt | save-stmt | target-stmt |
181
//        volatile-stmt | value-stmt | common-stmt | equivalence-stmt |
182
// (CUDA) CUDA-attributes-stmt
183
TYPE_PARSER(first(
184
    construct<OtherSpecificationStmt>(indirect(Parser<AccessStmt>{})),
185
    construct<OtherSpecificationStmt>(indirect(Parser<AllocatableStmt>{})),
186
    construct<OtherSpecificationStmt>(indirect(Parser<AsynchronousStmt>{})),
187
    construct<OtherSpecificationStmt>(indirect(Parser<BindStmt>{})),
188
    construct<OtherSpecificationStmt>(indirect(Parser<CodimensionStmt>{})),
189
    construct<OtherSpecificationStmt>(indirect(Parser<ContiguousStmt>{})),
190
    construct<OtherSpecificationStmt>(indirect(Parser<DimensionStmt>{})),
191
    construct<OtherSpecificationStmt>(indirect(Parser<ExternalStmt>{})),
192
    construct<OtherSpecificationStmt>(indirect(Parser<IntentStmt>{})),
193
    construct<OtherSpecificationStmt>(indirect(Parser<IntrinsicStmt>{})),
194
    construct<OtherSpecificationStmt>(indirect(Parser<NamelistStmt>{})),
195
    construct<OtherSpecificationStmt>(indirect(Parser<OptionalStmt>{})),
196
    construct<OtherSpecificationStmt>(indirect(Parser<PointerStmt>{})),
197
    construct<OtherSpecificationStmt>(indirect(Parser<ProtectedStmt>{})),
198
    construct<OtherSpecificationStmt>(indirect(Parser<SaveStmt>{})),
199
    construct<OtherSpecificationStmt>(indirect(Parser<TargetStmt>{})),
200
    construct<OtherSpecificationStmt>(indirect(Parser<ValueStmt>{})),
201
    construct<OtherSpecificationStmt>(indirect(Parser<VolatileStmt>{})),
202
    construct<OtherSpecificationStmt>(indirect(Parser<CommonStmt>{})),
203
    construct<OtherSpecificationStmt>(indirect(Parser<EquivalenceStmt>{})),
204
    construct<OtherSpecificationStmt>(indirect(Parser<BasedPointerStmt>{})),
205
    construct<OtherSpecificationStmt>(indirect(Parser<CUDAAttributesStmt>{}))))
206

207
// R1401 main-program ->
208
//         [program-stmt] [specification-part] [execution-part]
209
//         [internal-subprogram-part] end-program-stmt
210
TYPE_CONTEXT_PARSER("main program"_en_US,
211
    construct<MainProgram>(maybe(statement(Parser<ProgramStmt>{})),
212
        specificationPart, executionPart, maybe(internalSubprogramPart),
213
        unterminatedStatement(Parser<EndProgramStmt>{})))
214

215
// R1402 program-stmt -> PROGRAM program-name
216
// PGI allows empty parentheses after the name.
217
TYPE_CONTEXT_PARSER("PROGRAM statement"_en_US,
218
    construct<ProgramStmt>("PROGRAM" >> name /
219
            maybe(extension<LanguageFeature::ProgramParentheses>(
220
                "nonstandard usage: parentheses in PROGRAM statement"_port_en_US,
221
                parenthesized(ok)))))
222

223
// R1403 end-program-stmt -> END [PROGRAM [program-name]]
224
TYPE_CONTEXT_PARSER("END PROGRAM statement"_en_US,
225
    construct<EndProgramStmt>(recovery(
226
        "END PROGRAM" >> maybe(name) || bareEnd, progUnitEndStmtErrorRecovery)))
227

228
// R1404 module ->
229
//         module-stmt [specification-part] [module-subprogram-part]
230
//         end-module-stmt
231
TYPE_CONTEXT_PARSER("module"_en_US,
232
    construct<Module>(statement(Parser<ModuleStmt>{}), limitedSpecificationPart,
233
        maybe(Parser<ModuleSubprogramPart>{}),
234
        unterminatedStatement(Parser<EndModuleStmt>{})))
235

236
// R1405 module-stmt -> MODULE module-name
237
TYPE_CONTEXT_PARSER(
238
    "MODULE statement"_en_US, construct<ModuleStmt>("MODULE" >> name))
239

240
// R1406 end-module-stmt -> END [MODULE [module-name]]
241
TYPE_CONTEXT_PARSER("END MODULE statement"_en_US,
242
    construct<EndModuleStmt>(recovery(
243
        "END MODULE" >> maybe(name) || bareEnd, progUnitEndStmtErrorRecovery)))
244

245
// R1407 module-subprogram-part -> contains-stmt [module-subprogram]...
246
TYPE_CONTEXT_PARSER("module subprogram part"_en_US,
247
    construct<ModuleSubprogramPart>(statement(containsStmt),
248
        many(StartNewSubprogram{} >> Parser<ModuleSubprogram>{})))
249

250
// R1408 module-subprogram ->
251
//         function-subprogram | subroutine-subprogram |
252
//         separate-module-subprogram
253
TYPE_PARSER(construct<ModuleSubprogram>(indirect(functionSubprogram)) ||
254
    construct<ModuleSubprogram>(indirect(subroutineSubprogram)) ||
255
    construct<ModuleSubprogram>(indirect(Parser<SeparateModuleSubprogram>{})) ||
256
    construct<ModuleSubprogram>(indirect(compilerDirective)))
257

258
// R1410 module-nature -> INTRINSIC | NON_INTRINSIC
259
constexpr auto moduleNature{
260
    "INTRINSIC" >> pure(UseStmt::ModuleNature::Intrinsic) ||
261
    "NON_INTRINSIC" >> pure(UseStmt::ModuleNature::Non_Intrinsic)};
262

263
// R1409 use-stmt ->
264
//         USE [[, module-nature] ::] module-name [, rename-list] |
265
//         USE [[, module-nature] ::] module-name , ONLY : [only-list]
266
// N.B. Lookahead to the end of the statement is necessary to resolve
267
// ambiguity with assignments and statement function definitions that
268
// begin with the letters "USE".
269
TYPE_PARSER(construct<UseStmt>("USE" >> optionalBeforeColons(moduleNature),
270
                name, ", ONLY :" >> optionalList(Parser<Only>{})) ||
271
    construct<UseStmt>("USE" >> optionalBeforeColons(moduleNature), name,
272
        defaulted("," >>
273
            nonemptyList("expected renamings"_err_en_US, Parser<Rename>{})) /
274
            lookAhead(endOfStmt)))
275

276
// R1411 rename ->
277
//         local-name => use-name |
278
//         OPERATOR ( local-defined-operator ) =>
279
//           OPERATOR ( use-defined-operator )
280
TYPE_PARSER(construct<Rename>("OPERATOR (" >>
281
                construct<Rename::Operators>(
282
                    definedOpName / ") => OPERATOR (", definedOpName / ")")) ||
283
    construct<Rename>(construct<Rename::Names>(name, "=>" >> name)))
284

285
// R1412 only -> generic-spec | only-use-name | rename
286
// R1413 only-use-name -> use-name
287
// N.B. generic-spec and only-use-name are ambiguous; resolved with symbols
288
TYPE_PARSER(construct<Only>(Parser<Rename>{}) ||
289
    construct<Only>(indirect(genericSpec)) || construct<Only>(name))
290

291
// R1416 submodule ->
292
//         submodule-stmt [specification-part] [module-subprogram-part]
293
//         end-submodule-stmt
294
TYPE_CONTEXT_PARSER("submodule"_en_US,
295
    construct<Submodule>(statement(Parser<SubmoduleStmt>{}),
296
        limitedSpecificationPart, maybe(Parser<ModuleSubprogramPart>{}),
297
        unterminatedStatement(Parser<EndSubmoduleStmt>{})))
298

299
// R1417 submodule-stmt -> SUBMODULE ( parent-identifier ) submodule-name
300
TYPE_CONTEXT_PARSER("SUBMODULE statement"_en_US,
301
    construct<SubmoduleStmt>(
302
        "SUBMODULE" >> parenthesized(Parser<ParentIdentifier>{}), name))
303

304
// R1418 parent-identifier -> ancestor-module-name [: parent-submodule-name]
305
TYPE_PARSER(construct<ParentIdentifier>(name, maybe(":" >> name)))
306

307
// R1419 end-submodule-stmt -> END [SUBMODULE [submodule-name]]
308
TYPE_CONTEXT_PARSER("END SUBMODULE statement"_en_US,
309
    construct<EndSubmoduleStmt>(
310
        recovery("END SUBMODULE" >> maybe(name) || bareEnd,
311
            progUnitEndStmtErrorRecovery)))
312

313
// R1420 block-data -> block-data-stmt [specification-part] end-block-data-stmt
314
TYPE_CONTEXT_PARSER("BLOCK DATA subprogram"_en_US,
315
    construct<BlockData>(statement(Parser<BlockDataStmt>{}),
316
        limitedSpecificationPart,
317
        unterminatedStatement(Parser<EndBlockDataStmt>{})))
318

319
// R1421 block-data-stmt -> BLOCK DATA [block-data-name]
320
TYPE_CONTEXT_PARSER("BLOCK DATA statement"_en_US,
321
    construct<BlockDataStmt>("BLOCK DATA" >> maybe(name)))
322

323
// R1422 end-block-data-stmt -> END [BLOCK DATA [block-data-name]]
324
TYPE_CONTEXT_PARSER("END BLOCK DATA statement"_en_US,
325
    construct<EndBlockDataStmt>(
326
        recovery("END BLOCK DATA" >> maybe(name) || bareEnd,
327
            progUnitEndStmtErrorRecovery)))
328

329
// R1501 interface-block ->
330
//         interface-stmt [interface-specification]... end-interface-stmt
331
TYPE_PARSER(construct<InterfaceBlock>(statement(Parser<InterfaceStmt>{}),
332
    many(Parser<InterfaceSpecification>{}),
333
    statement(Parser<EndInterfaceStmt>{})))
334

335
// R1502 interface-specification -> interface-body | procedure-stmt
336
TYPE_PARSER(construct<InterfaceSpecification>(Parser<InterfaceBody>{}) ||
337
    construct<InterfaceSpecification>(statement(Parser<ProcedureStmt>{})))
338

339
// R1503 interface-stmt -> INTERFACE [generic-spec] | ABSTRACT INTERFACE
340
TYPE_PARSER(construct<InterfaceStmt>("INTERFACE" >> maybe(genericSpec)) ||
341
    construct<InterfaceStmt>(construct<Abstract>("ABSTRACT INTERFACE"_sptok)))
342

343
// R1504 end-interface-stmt -> END INTERFACE [generic-spec]
344
TYPE_PARSER(
345
    construct<EndInterfaceStmt>(recovery("END INTERFACE" >> maybe(genericSpec),
346
        constructEndStmtErrorRecovery >> pure<std::optional<GenericSpec>>())))
347

348
// R1505 interface-body ->
349
//         function-stmt [specification-part] end-function-stmt |
350
//         subroutine-stmt [specification-part] end-subroutine-stmt
351
TYPE_CONTEXT_PARSER("interface body"_en_US,
352
    construct<InterfaceBody>(
353
        construct<InterfaceBody::Function>(statement(functionStmt),
354
            indirect(limitedSpecificationPart), statement(endFunctionStmt))) ||
355
        construct<InterfaceBody>(construct<InterfaceBody::Subroutine>(
356
            statement(subroutineStmt), indirect(limitedSpecificationPart),
357
            statement(endSubroutineStmt))))
358

359
// R1507 specific-procedure -> procedure-name
360
constexpr auto specificProcedures{
361
    nonemptyList("expected specific procedure names"_err_en_US, name)};
362

363
// R1506 procedure-stmt -> [MODULE] PROCEDURE [::] specific-procedure-list
364
TYPE_PARSER(construct<ProcedureStmt>("MODULE PROCEDURE"_sptok >>
365
                    pure(ProcedureStmt::Kind::ModuleProcedure),
366
                maybe("::"_tok) >> specificProcedures) ||
367
    construct<ProcedureStmt>(
368
        "PROCEDURE" >> pure(ProcedureStmt::Kind::Procedure),
369
        maybe("::"_tok) >> specificProcedures))
370

371
// R1508 generic-spec ->
372
//         generic-name | OPERATOR ( defined-operator ) |
373
//         ASSIGNMENT ( = ) | defined-io-generic-spec
374
// R1509 defined-io-generic-spec ->
375
//         READ ( FORMATTED ) | READ ( UNFORMATTED ) |
376
//         WRITE ( FORMATTED ) | WRITE ( UNFORMATTED )
377
TYPE_PARSER(sourced(first(construct<GenericSpec>("OPERATOR" >>
378
                              parenthesized(Parser<DefinedOperator>{})),
379
    construct<GenericSpec>(
380
        construct<GenericSpec::Assignment>("ASSIGNMENT ( = )"_tok)),
381
    construct<GenericSpec>(
382
        construct<GenericSpec::ReadFormatted>("READ ( FORMATTED )"_tok)),
383
    construct<GenericSpec>(
384
        construct<GenericSpec::ReadUnformatted>("READ ( UNFORMATTED )"_tok)),
385
    construct<GenericSpec>(
386
        construct<GenericSpec::WriteFormatted>("WRITE ( FORMATTED )"_tok)),
387
    construct<GenericSpec>(
388
        construct<GenericSpec::WriteUnformatted>("WRITE ( UNFORMATTED )"_tok)),
389
    construct<GenericSpec>(name))))
390

391
// R1510 generic-stmt ->
392
//         GENERIC [, access-spec] :: generic-spec => specific-procedure-list
393
TYPE_PARSER(construct<GenericStmt>("GENERIC" >> maybe("," >> accessSpec),
394
    "::" >> genericSpec, "=>" >> specificProcedures))
395

396
// R1511 external-stmt -> EXTERNAL [::] external-name-list
397
TYPE_PARSER(
398
    "EXTERNAL" >> maybe("::"_tok) >> construct<ExternalStmt>(listOfNames))
399

400
// R1512 procedure-declaration-stmt ->
401
//         PROCEDURE ( [proc-interface] ) [[, proc-attr-spec]... ::]
402
//         proc-decl-list
403
TYPE_PARSER("PROCEDURE" >>
404
    construct<ProcedureDeclarationStmt>(parenthesized(maybe(procInterface)),
405
        optionalListBeforeColons(Parser<ProcAttrSpec>{}),
406
        nonemptyList("expected procedure declarations"_err_en_US, procDecl)))
407

408
// R1513 proc-interface -> interface-name | declaration-type-spec
409
// R1516 interface-name -> name
410
// N.B. Simple names of intrinsic types (e.g., "REAL") are not
411
// ambiguous here - they take precedence over derived type names
412
// thanks to C1516.
413
TYPE_PARSER(
414
    construct<ProcInterface>(declarationTypeSpec / lookAhead(")"_tok)) ||
415
    construct<ProcInterface>(name))
416

417
// R1514 proc-attr-spec ->
418
//         access-spec | proc-language-binding-spec | INTENT ( intent-spec ) |
419
//         OPTIONAL | POINTER | PROTECTED | SAVE
420
TYPE_PARSER(construct<ProcAttrSpec>(accessSpec) ||
421
    construct<ProcAttrSpec>(languageBindingSpec) ||
422
    construct<ProcAttrSpec>("INTENT" >> parenthesized(intentSpec)) ||
423
    construct<ProcAttrSpec>(optional) || construct<ProcAttrSpec>(pointer) ||
424
    construct<ProcAttrSpec>(protectedAttr) || construct<ProcAttrSpec>(save))
425

426
// R1515 proc-decl -> procedure-entity-name [=> proc-pointer-init]
427
TYPE_PARSER(construct<ProcDecl>(name, maybe("=>" >> Parser<ProcPointerInit>{})))
428

429
// R1517 proc-pointer-init -> null-init | initial-proc-target
430
// R1518 initial-proc-target -> procedure-name
431
TYPE_PARSER(
432
    construct<ProcPointerInit>(nullInit) || construct<ProcPointerInit>(name))
433

434
// R1519 intrinsic-stmt -> INTRINSIC [::] intrinsic-procedure-name-list
435
TYPE_PARSER(
436
    "INTRINSIC" >> maybe("::"_tok) >> construct<IntrinsicStmt>(listOfNames))
437

438
// R1520 function-reference -> procedure-designator
439
//                               ( [actual-arg-spec-list] )
440
TYPE_CONTEXT_PARSER("function reference"_en_US,
441
    sourced(construct<FunctionReference>(
442
        construct<Call>(Parser<ProcedureDesignator>{},
443
            parenthesized(optionalList(actualArgSpec))))) /
444
        !"["_tok)
445

446
// R1521 call-stmt -> CALL procedure-designator [chevrons]
447
///                          [( [actual-arg-spec-list] )]
448
// (CUDA) chevrons -> <<< scalar-expr, scalar-expr [, scalar-int-expr
449
//                      [, scalar-int-expr ] ] >>>
450
TYPE_PARSER(extension<LanguageFeature::CUDA>(
451
    "<<<" >> construct<CallStmt::Chevrons>(scalarExpr, "," >> scalarExpr,
452
                 maybe("," >> scalarIntExpr), maybe("," >> scalarIntExpr)) /
453
        ">>>"))
454
constexpr auto actualArgSpecList{optionalList(actualArgSpec)};
455
TYPE_CONTEXT_PARSER("CALL statement"_en_US,
456
    construct<CallStmt>(
457
        sourced(construct<CallStmt>("CALL" >> Parser<ProcedureDesignator>{},
458
            maybe(Parser<CallStmt::Chevrons>{}) / space,
459
            "(" >> actualArgSpecList / ")" ||
460
                lookAhead(endOfStmt) >> defaulted(actualArgSpecList)))))
461

462
// R1522 procedure-designator ->
463
//         procedure-name | proc-component-ref | data-ref % binding-name
464
TYPE_PARSER(construct<ProcedureDesignator>(Parser<ProcComponentRef>{}) ||
465
    construct<ProcedureDesignator>(name))
466

467
// R1523 actual-arg-spec -> [keyword =] actual-arg
468
TYPE_PARSER(construct<ActualArgSpec>(
469
    maybe(keyword / "=" / !"="_ch), Parser<ActualArg>{}))
470

471
// R1524 actual-arg ->
472
//         expr | variable | procedure-name | proc-component-ref |
473
//         alt-return-spec
474
// N.B. the "procedure-name" and "proc-component-ref" alternatives can't
475
// yet be distinguished from "variable", many instances of which can't be
476
// distinguished from "expr" anyway (to do so would misparse structure
477
// constructors and function calls as array elements).
478
// Semantics sorts it all out later.
479
TYPE_PARSER(construct<ActualArg>(expr) ||
480
    construct<ActualArg>(Parser<AltReturnSpec>{}) ||
481
    extension<LanguageFeature::PercentRefAndVal>(
482
        "nonstandard usage: %REF"_port_en_US,
483
        construct<ActualArg>(
484
            construct<ActualArg::PercentRef>("%REF" >> parenthesized(expr)))) ||
485
    extension<LanguageFeature::PercentRefAndVal>(
486
        "nonstandard usage: %VAL"_port_en_US,
487
        construct<ActualArg>(
488
            construct<ActualArg::PercentVal>("%VAL" >> parenthesized(expr)))))
489

490
// R1525 alt-return-spec -> * label
491
TYPE_PARSER(construct<AltReturnSpec>(star >> label))
492

493
// R1527 prefix-spec ->
494
//         declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
495
//         NON_RECURSIVE | PURE | RECURSIVE |
496
// (CUDA)  ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... ) |
497
//         LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list)
498
TYPE_PARSER(first("DEVICE" >> pure(common::CUDASubprogramAttrs::Device),
499
    "GLOBAL" >> pure(common::CUDASubprogramAttrs::Global),
500
    "GRID_GLOBAL" >> pure(common::CUDASubprogramAttrs::Grid_Global),
501
    "HOST" >> pure(common::CUDASubprogramAttrs::Host)))
502
TYPE_PARSER(first(construct<PrefixSpec>(declarationTypeSpec),
503
    construct<PrefixSpec>(construct<PrefixSpec::Elemental>("ELEMENTAL"_tok)),
504
    construct<PrefixSpec>(construct<PrefixSpec::Impure>("IMPURE"_tok)),
505
    construct<PrefixSpec>(construct<PrefixSpec::Module>("MODULE"_tok)),
506
    construct<PrefixSpec>(
507
        construct<PrefixSpec::Non_Recursive>("NON_RECURSIVE"_tok)),
508
    construct<PrefixSpec>(construct<PrefixSpec::Pure>("PURE"_tok)),
509
    construct<PrefixSpec>(construct<PrefixSpec::Recursive>("RECURSIVE"_tok)),
510
    extension<LanguageFeature::CUDA>(
511
        construct<PrefixSpec>(construct<PrefixSpec::Attributes>("ATTRIBUTES" >>
512
            parenthesized(
513
                optionalList(Parser<common::CUDASubprogramAttrs>{}))))),
514
    extension<LanguageFeature::CUDA>(construct<PrefixSpec>(
515
        construct<PrefixSpec::Launch_Bounds>("LAUNCH_BOUNDS" >>
516
            parenthesized(nonemptyList(
517
                "expected launch bounds"_err_en_US, scalarIntConstantExpr))))),
518
    extension<LanguageFeature::CUDA>(construct<PrefixSpec>(
519
        construct<PrefixSpec::Cluster_Dims>("CLUSTER_DIMS" >>
520
            parenthesized(nonemptyList("expected cluster dimensions"_err_en_US,
521
                scalarIntConstantExpr)))))))
522

523
// R1529 function-subprogram ->
524
//         function-stmt [specification-part] [execution-part]
525
//         [internal-subprogram-part] end-function-stmt
526
TYPE_CONTEXT_PARSER("FUNCTION subprogram"_en_US,
527
    construct<FunctionSubprogram>(statement(functionStmt), specificationPart,
528
        executionPart, maybe(internalSubprogramPart),
529
        unterminatedStatement(endFunctionStmt)))
530

531
// R1530 function-stmt ->
532
//         [prefix] FUNCTION function-name ( [dummy-arg-name-list] ) [suffix]
533
// R1526 prefix -> prefix-spec [prefix-spec]...
534
// R1531 dummy-arg-name -> name
535
TYPE_CONTEXT_PARSER("FUNCTION statement"_en_US,
536
    construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,
537
        parenthesized(optionalList(name)), maybe(suffix)) ||
538
        extension<LanguageFeature::OmitFunctionDummies>(
539
            "nonstandard usage: FUNCTION statement without dummy argument list"_port_en_US,
540
            construct<FunctionStmt>( // PGI & Intel accept "FUNCTION F"
541
                many(prefixSpec), "FUNCTION" >> name,
542
                construct<std::list<Name>>(),
543
                construct<std::optional<Suffix>>())))
544

545
// R1532 suffix ->
546
//         proc-language-binding-spec [RESULT ( result-name )] |
547
//         RESULT ( result-name ) [proc-language-binding-spec]
548
TYPE_PARSER(construct<Suffix>(
549
                languageBindingSpec, maybe("RESULT" >> parenthesized(name))) ||
550
    construct<Suffix>(
551
        "RESULT" >> parenthesized(name), maybe(languageBindingSpec)))
552

553
// R1533 end-function-stmt -> END [FUNCTION [function-name]]
554
TYPE_PARSER(construct<EndFunctionStmt>(recovery(
555
    "END FUNCTION" >> maybe(name) || bareEnd, progUnitEndStmtErrorRecovery)))
556

557
// R1534 subroutine-subprogram ->
558
//         subroutine-stmt [specification-part] [execution-part]
559
//         [internal-subprogram-part] end-subroutine-stmt
560
TYPE_CONTEXT_PARSER("SUBROUTINE subprogram"_en_US,
561
    construct<SubroutineSubprogram>(statement(subroutineStmt),
562
        specificationPart, executionPart, maybe(internalSubprogramPart),
563
        unterminatedStatement(endSubroutineStmt)))
564

565
// R1535 subroutine-stmt ->
566
//         [prefix] SUBROUTINE subroutine-name [( [dummy-arg-list] )
567
//         [proc-language-binding-spec]]
568
TYPE_PARSER(
569
    construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,
570
        parenthesized(optionalList(dummyArg)), maybe(languageBindingSpec)) ||
571
    construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,
572
        pure<std::list<DummyArg>>(),
573
        pure<std::optional<LanguageBindingSpec>>()))
574

575
// R1536 dummy-arg -> dummy-arg-name | *
576
TYPE_PARSER(construct<DummyArg>(name) || construct<DummyArg>(star))
577

578
// R1537 end-subroutine-stmt -> END [SUBROUTINE [subroutine-name]]
579
TYPE_PARSER(construct<EndSubroutineStmt>(recovery(
580
    "END SUBROUTINE" >> maybe(name) || bareEnd, progUnitEndStmtErrorRecovery)))
581

582
// R1538 separate-module-subprogram ->
583
//         mp-subprogram-stmt [specification-part] [execution-part]
584
//         [internal-subprogram-part] end-mp-subprogram-stmt
585
TYPE_CONTEXT_PARSER("separate module subprogram"_en_US,
586
    construct<SeparateModuleSubprogram>(statement(Parser<MpSubprogramStmt>{}),
587
        specificationPart, executionPart, maybe(internalSubprogramPart),
588
        statement(Parser<EndMpSubprogramStmt>{})))
589

590
// R1539 mp-subprogram-stmt -> MODULE PROCEDURE procedure-name
591
TYPE_CONTEXT_PARSER("MODULE PROCEDURE statement"_en_US,
592
    construct<MpSubprogramStmt>("MODULE PROCEDURE"_sptok >> name))
593

594
// R1540 end-mp-subprogram-stmt -> END [PROCEDURE [procedure-name]]
595
TYPE_CONTEXT_PARSER("END PROCEDURE statement"_en_US,
596
    construct<EndMpSubprogramStmt>(
597
        recovery("END PROCEDURE" >> maybe(name) || bareEnd,
598
            progUnitEndStmtErrorRecovery)))
599

600
// R1541 entry-stmt -> ENTRY entry-name [( [dummy-arg-list] ) [suffix]]
601
TYPE_PARSER(
602
    "ENTRY" >> (construct<EntryStmt>(name,
603
                    parenthesized(optionalList(dummyArg)), maybe(suffix)) ||
604
                   construct<EntryStmt>(name, construct<std::list<DummyArg>>(),
605
                       construct<std::optional<Suffix>>())))
606

607
// R1542 return-stmt -> RETURN [scalar-int-expr]
608
TYPE_CONTEXT_PARSER("RETURN statement"_en_US,
609
    construct<ReturnStmt>("RETURN" >> maybe(scalarIntExpr)))
610

611
// R1543 contains-stmt -> CONTAINS
612
TYPE_PARSER(construct<ContainsStmt>("CONTAINS"_tok))
613

614
// R1544 stmt-function-stmt ->
615
//         function-name ( [dummy-arg-name-list] ) = scalar-expr
616
TYPE_CONTEXT_PARSER("statement function definition"_en_US,
617
    construct<StmtFunctionStmt>(
618
        name, parenthesized(optionalList(name)), "=" >> scalar(expr)))
619
} // namespace Fortran::parser
620