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

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