1 | //===-- lib/Parser/program-parsers.cpp ------------------------------------===// |
---|---|
2 | // |
3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
4 | // See https://llvm.org/LICENSE.txt for license information. |
5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
6 | // |
7 | //===----------------------------------------------------------------------===// |
8 | |
9 | // Per-type parsers for program units |
10 | |
11 | #include "basic-parsers.h" |
12 | #include "expr-parsers.h" |
13 | #include "misc-parsers.h" |
14 | #include "stmt-parser.h" |
15 | #include "token-parsers.h" |
16 | #include "type-parser-implementation.h" |
17 | #include "flang/Parser/characters.h" |
18 | #include "flang/Parser/parse-tree.h" |
19 | |
20 | namespace Fortran::parser { |
21 | |
22 | // 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 | |
27 | static 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. |
42 | TYPE_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. |
62 | static 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>{}))}; |
70 | static constexpr auto normalProgramUnit{StartNewSubprogram{} >> programUnit / |
71 | skipMany(";"_tok) / space / recovery(endOfLine, SkipPast<'\n'>{})}; |
72 | static constexpr auto globalCompilerDirective{ |
73 | construct<ProgramUnit>(indirect(compilerDirective))}; |
74 | |
75 | static 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. |
86 | TYPE_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. |
105 | constexpr 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)}; |
110 | constexpr 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)}; |
114 | constexpr auto declErrorRecovery{ |
115 | stmtErrorRecoveryStart >> !execPartLookAhead >> skipStmtErrorRecovery}; |
116 | constexpr 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 | |
125 | TYPE_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 | |
134 | constexpr 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]... |
142 | TYPE_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. |
150 | constexpr 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 | |
157 | constexpr 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. |
171 | constexpr 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 |
182 | TYPE_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 |
210 | TYPE_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 |
237 | TYPE_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. |
244 | TYPE_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]] |
251 | TYPE_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 |
259 | TYPE_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 |
265 | TYPE_CONTEXT_PARSER( |
266 | "MODULE statement"_en_US, construct<ModuleStmt>( "MODULE">> name)) |
267 | |
268 | // R1406 end-module-stmt -> END [MODULE [module-name]] |
269 | TYPE_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]... |
275 | TYPE_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 |
282 | TYPE_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 |
288 | constexpr 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". |
298 | TYPE_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 ) |
309 | TYPE_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 |
317 | TYPE_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 |
323 | TYPE_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 |
329 | TYPE_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] |
334 | TYPE_PARSER(construct<ParentIdentifier>(name, maybe(":">> name))) |
335 | |
336 | // R1419 end-submodule-stmt -> END [SUBMODULE [submodule-name]] |
337 | TYPE_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 |
343 | TYPE_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] |
349 | TYPE_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]] |
353 | TYPE_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 |
360 | TYPE_PARSER(construct<InterfaceBlock>(statement(Parser<InterfaceStmt>{}), |
361 | many(Parser<InterfaceSpecification>{}), |
362 | statement(Parser<EndInterfaceStmt>{}))) |
363 | |
364 | // R1502 interface-specification -> interface-body | procedure-stmt |
365 | TYPE_PARSER(construct<InterfaceSpecification>(Parser<InterfaceBody>{}) || |
366 | construct<InterfaceSpecification>(statement(Parser<ProcedureStmt>{}))) |
367 | |
368 | // R1503 interface-stmt -> INTERFACE [generic-spec] | ABSTRACT INTERFACE |
369 | TYPE_PARSER(construct<InterfaceStmt>("INTERFACE">> maybe(genericSpec)) || |
370 | construct<InterfaceStmt>(construct<Abstract>("ABSTRACT INTERFACE"_sptok))) |
371 | |
372 | // R1504 end-interface-stmt -> END INTERFACE [generic-spec] |
373 | TYPE_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 |
380 | TYPE_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 |
389 | constexpr auto specificProcedures{ |
390 | nonemptyList("expected specific procedure names"_err_en_US, name)}; |
391 | |
392 | // R1506 procedure-stmt -> [MODULE] PROCEDURE [::] specific-procedure-list |
393 | TYPE_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 ) |
406 | TYPE_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 |
422 | TYPE_PARSER(construct<GenericStmt>("GENERIC">> maybe( ",">> accessSpec), |
423 | "::">> genericSpec, "=>">> specificProcedures)) |
424 | |
425 | // R1511 external-stmt -> EXTERNAL [::] external-name-list |
426 | TYPE_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 |
432 | TYPE_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. |
442 | TYPE_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 |
449 | TYPE_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] |
456 | TYPE_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 |
460 | TYPE_PARSER( |
461 | construct<ProcPointerInit>(nullInit) || construct<ProcPointerInit>(name)) |
462 | |
463 | // R1519 intrinsic-stmt -> INTRINSIC [::] intrinsic-procedure-name-list |
464 | TYPE_PARSER( |
465 | "INTRINSIC">> maybe( "::"_tok) >> construct<IntrinsicStmt>(listOfNames)) |
466 | |
467 | // R1520 function-reference -> procedure-designator |
468 | // ( [actual-arg-spec-list] ) |
469 | TYPE_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 ] ] >>> |
479 | constexpr auto starOrExpr{ |
480 | construct<CallStmt::StarOrExpr>("*">> pure<std::optional<ScalarExpr>>() || |
481 | applyFunction(presentOptional<ScalarExpr>, scalarExpr))}; |
482 | TYPE_PARSER(extension<LanguageFeature::CUDA>( |
483 | "<<<">> construct<CallStmt::Chevrons>(starOrExpr, ", ">> scalarExpr, |
484 | maybe(",">> scalarIntExpr), maybe( ",">> scalarIntExpr)) / |
485 | ">>>")) |
486 | constexpr auto actualArgSpecList{optionalList(actualArgSpec)}; |
487 | TYPE_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 |
496 | TYPE_PARSER(construct<ProcedureDesignator>(Parser<ProcComponentRef>{}) || |
497 | construct<ProcedureDesignator>(name)) |
498 | |
499 | // R1523 actual-arg-spec -> [keyword =] actual-arg |
500 | TYPE_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. |
511 | TYPE_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 |
523 | TYPE_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) |
530 | TYPE_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))) |
534 | TYPE_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 |
558 | TYPE_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] |
566 | TYPE_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]] |
572 | TYPE_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 |
579 | TYPE_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]] |
587 | TYPE_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 | * |
597 | TYPE_PARSER(construct<DummyArg>(name) || construct<DummyArg>(star)) |
598 | |
599 | // R1537 end-subroutine-stmt -> END [SUBROUTINE [subroutine-name]] |
600 | TYPE_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 |
607 | TYPE_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 |
613 | TYPE_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]] |
617 | TYPE_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]] |
623 | TYPE_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] |
630 | TYPE_CONTEXT_PARSER("RETURN statement"_en_US, |
631 | construct<ReturnStmt>("RETURN">> maybe(scalarIntExpr))) |
632 | |
633 | // R1543 contains-stmt -> CONTAINS |
634 | TYPE_PARSER(construct<ContainsStmt>("CONTAINS"_tok)) |
635 | |
636 | // R1544 stmt-function-stmt -> |
637 | // function-name ( [dummy-arg-name-list] ) = scalar-expr |
638 | TYPE_CONTEXT_PARSER("statement function definition"_en_US, |
639 | construct<StmtFunctionStmt>( |
640 | name, parenthesized(optionalList(name)), "=">> scalar(expr))) |
641 | } // namespace Fortran::parser |
642 |
Definitions
- validFunctionStmt
- programUnit
- normalProgramUnit
- globalCompilerDirective
- globalOpenACCCompilerDirective
- actionStmtLookAhead
- execPartLookAhead
- declErrorRecovery
- misplacedSpecificationStmt
- recoveredDeclarationConstruct
- invalidDeclarationStmt
- limitedDeclarationConstruct
- limitedSpecificationPart
- moduleNature
- specificProcedures
- starOrExpr
Improve your Profiling and Debugging skills
Find out more