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