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