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