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

source code of flang/lib/Parser/program-parsers.cpp