1//===-- lib/Parser/Fortran-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// Top-level grammar specification for Fortran. These parsers drive
10// the tokenization parsers in cooked-tokens.h to consume characters,
11// recognize the productions of Fortran, and to construct a parse tree.
12// See ParserCombinators.md for documentation on the parser combinator
13// library used here to implement an LL recursive descent recognizer.
14
15// The productions that follow are derived from the draft Fortran 2018
16// standard, with some necessary modifications to remove left recursion
17// and some generalization in order to defer cases where parses depend
18// on the definitions of symbols. The "Rxxx" numbers that appear in
19// comments refer to these numbered requirements in the Fortran standard.
20
21// The whole Fortran grammar originally constituted one header file,
22// but that turned out to require more memory to compile with current
23// C++ compilers than some people were willing to accept, so now the
24// various per-type parsers are partitioned into several C++ source
25// files. This file contains parsers for constants, types, declarations,
26// and misfits (mostly clauses 7, 8, & 9 of Fortran 2018). The others:
27// executable-parsers.cpp Executable statements
28// expr-parsers.cpp Expressions
29// io-parsers.cpp I/O statements and FORMAT
30// openmp-parsers.cpp OpenMP directives
31// program-parsers.cpp Program units
32
33#include "basic-parsers.h"
34#include "expr-parsers.h"
35#include "misc-parsers.h"
36#include "stmt-parser.h"
37#include "token-parsers.h"
38#include "type-parser-implementation.h"
39#include "flang/Parser/parse-tree.h"
40#include "flang/Parser/user-state.h"
41
42namespace Fortran::parser {
43
44// R601 alphanumeric-character -> letter | digit | underscore
45// R603 name -> letter [alphanumeric-character]...
46constexpr auto nonDigitIdChar{letter || otherIdChar};
47constexpr auto rawName{nonDigitIdChar >> many(nonDigitIdChar || digit)};
48TYPE_PARSER(space >> sourced(rawName >> construct<Name>()))
49
50// R608 intrinsic-operator ->
51// power-op | mult-op | add-op | concat-op | rel-op |
52// not-op | and-op | or-op | equiv-op
53// R610 extended-intrinsic-op -> intrinsic-operator
54// These parsers must be ordered carefully to avoid misrecognition.
55constexpr auto namedIntrinsicOperator{
56 ".LT." >> pure(DefinedOperator::IntrinsicOperator::LT) ||
57 ".LE." >> pure(DefinedOperator::IntrinsicOperator::LE) ||
58 ".EQ." >> pure(DefinedOperator::IntrinsicOperator::EQ) ||
59 ".NE." >> pure(DefinedOperator::IntrinsicOperator::NE) ||
60 ".GE." >> pure(DefinedOperator::IntrinsicOperator::GE) ||
61 ".GT." >> pure(DefinedOperator::IntrinsicOperator::GT) ||
62 ".NOT." >> pure(DefinedOperator::IntrinsicOperator::NOT) ||
63 ".AND." >> pure(DefinedOperator::IntrinsicOperator::AND) ||
64 ".OR." >> pure(DefinedOperator::IntrinsicOperator::OR) ||
65 ".EQV." >> pure(DefinedOperator::IntrinsicOperator::EQV) ||
66 ".NEQV." >> pure(DefinedOperator::IntrinsicOperator::NEQV) ||
67 extension<LanguageFeature::XOROperator>(
68 "nonstandard usage: .XOR. spelling of .NEQV."_port_en_US,
69 ".XOR." >> pure(DefinedOperator::IntrinsicOperator::NEQV)) ||
70 extension<LanguageFeature::LogicalAbbreviations>(
71 "nonstandard usage: abbreviated logical operator"_port_en_US,
72 ".N." >> pure(DefinedOperator::IntrinsicOperator::NOT) ||
73 ".A." >> pure(DefinedOperator::IntrinsicOperator::AND) ||
74 ".O." >> pure(DefinedOperator::IntrinsicOperator::OR) ||
75 extension<LanguageFeature::XOROperator>(
76 "nonstandard usage: .X. spelling of .NEQV."_port_en_US,
77 ".X." >> pure(DefinedOperator::IntrinsicOperator::NEQV)))};
78
79constexpr auto intrinsicOperator{
80 "**" >> pure(DefinedOperator::IntrinsicOperator::Power) ||
81 "*" >> pure(DefinedOperator::IntrinsicOperator::Multiply) ||
82 "//" >> pure(DefinedOperator::IntrinsicOperator::Concat) ||
83 "/=" >> pure(DefinedOperator::IntrinsicOperator::NE) ||
84 "/" >> pure(DefinedOperator::IntrinsicOperator::Divide) ||
85 "+" >> pure(DefinedOperator::IntrinsicOperator::Add) ||
86 "-" >> pure(DefinedOperator::IntrinsicOperator::Subtract) ||
87 "<=" >> pure(DefinedOperator::IntrinsicOperator::LE) ||
88 extension<LanguageFeature::AlternativeNE>(
89 "nonstandard usage: <> spelling of /= or .NE."_port_en_US,
90 "<>" >> pure(DefinedOperator::IntrinsicOperator::NE)) ||
91 "<" >> pure(DefinedOperator::IntrinsicOperator::LT) ||
92 "==" >> pure(DefinedOperator::IntrinsicOperator::EQ) ||
93 ">=" >> pure(DefinedOperator::IntrinsicOperator::GE) ||
94 ">" >> pure(DefinedOperator::IntrinsicOperator::GT) ||
95 namedIntrinsicOperator};
96
97// R609 defined-operator ->
98// defined-unary-op | defined-binary-op | extended-intrinsic-op
99TYPE_PARSER(construct<DefinedOperator>(intrinsicOperator) ||
100 construct<DefinedOperator>(definedOpName))
101
102// R505 implicit-part -> [implicit-part-stmt]... implicit-stmt
103// N.B. PARAMETER, FORMAT, & ENTRY statements that appear before any
104// other kind of declaration-construct will be parsed into the
105// implicit-part.
106TYPE_CONTEXT_PARSER("implicit part"_en_US,
107 construct<ImplicitPart>(many(Parser<ImplicitPartStmt>{})))
108
109// R506 implicit-part-stmt ->
110// implicit-stmt | parameter-stmt | format-stmt | entry-stmt
111TYPE_PARSER(first(
112 construct<ImplicitPartStmt>(statement(indirect(Parser<ImplicitStmt>{}))),
113 construct<ImplicitPartStmt>(statement(indirect(parameterStmt))),
114 construct<ImplicitPartStmt>(statement(indirect(oldParameterStmt))),
115 construct<ImplicitPartStmt>(statement(indirect(formatStmt))),
116 construct<ImplicitPartStmt>(statement(indirect(entryStmt))),
117 construct<ImplicitPartStmt>(indirect(compilerDirective)),
118 construct<ImplicitPartStmt>(indirect(openaccDeclarativeConstruct))))
119
120// R512 internal-subprogram -> function-subprogram | subroutine-subprogram
121// Internal subprograms are not program units, so their END statements
122// can be followed by ';' and another statement on the same line.
123TYPE_CONTEXT_PARSER("internal subprogram"_en_US,
124 (construct<InternalSubprogram>(indirect(functionSubprogram)) ||
125 construct<InternalSubprogram>(indirect(subroutineSubprogram))) /
126 forceEndOfStmt ||
127 construct<InternalSubprogram>(indirect(compilerDirective)))
128
129// R511 internal-subprogram-part -> contains-stmt [internal-subprogram]...
130TYPE_CONTEXT_PARSER("internal subprogram part"_en_US,
131 construct<InternalSubprogramPart>(statement(containsStmt),
132 many(StartNewSubprogram{} >> Parser<InternalSubprogram>{})))
133
134// R605 literal-constant ->
135// int-literal-constant | real-literal-constant |
136// complex-literal-constant | logical-literal-constant |
137// char-literal-constant | boz-literal-constant |
138// unsigned-literal-constant
139TYPE_PARSER(
140 first(construct<LiteralConstant>(Parser<HollerithLiteralConstant>{}),
141 construct<LiteralConstant>(realLiteralConstant),
142 construct<LiteralConstant>(intLiteralConstant),
143 construct<LiteralConstant>(Parser<ComplexLiteralConstant>{}),
144 construct<LiteralConstant>(Parser<BOZLiteralConstant>{}),
145 construct<LiteralConstant>(charLiteralConstant),
146 construct<LiteralConstant>(Parser<LogicalLiteralConstant>{}),
147 construct<LiteralConstant>(unsignedLiteralConstant)))
148
149// R606 named-constant -> name
150TYPE_PARSER(construct<NamedConstant>(name))
151
152// R701 type-param-value -> scalar-int-expr | * | :
153TYPE_PARSER(construct<TypeParamValue>(scalarIntExpr) ||
154 construct<TypeParamValue>(star) ||
155 construct<TypeParamValue>(construct<TypeParamValue::Deferred>(":"_tok)))
156
157// R702 type-spec -> intrinsic-type-spec | derived-type-spec
158// N.B. This type-spec production is one of two instances in the Fortran
159// grammar where intrinsic types and bare derived type names can clash;
160// the other is below in R703 declaration-type-spec. Look-ahead is required
161// to disambiguate the cases where a derived type name begins with the name
162// of an intrinsic type, e.g., REALITY.
163TYPE_CONTEXT_PARSER("type spec"_en_US,
164 construct<TypeSpec>(intrinsicTypeSpec / lookAhead("::"_tok || ")"_tok)) ||
165 construct<TypeSpec>(derivedTypeSpec))
166
167// R703 declaration-type-spec ->
168// intrinsic-type-spec | TYPE ( intrinsic-type-spec ) |
169// TYPE ( derived-type-spec ) | CLASS ( derived-type-spec ) |
170// CLASS ( * ) | TYPE ( * )
171// N.B. It is critical to distribute "parenthesized()" over the alternatives
172// for TYPE (...), rather than putting the alternatives within it, which
173// would fail on "TYPE(real_derived)" with a misrecognition of "real" as an
174// intrinsic-type-spec.
175// N.B. TYPE(x) is a derived type if x is a one-word extension intrinsic
176// type (BYTE or DOUBLECOMPLEX), not the extension intrinsic type.
177TYPE_CONTEXT_PARSER("declaration type spec"_en_US,
178 construct<DeclarationTypeSpec>(intrinsicTypeSpec) ||
179 "TYPE" >>
180 (parenthesized(construct<DeclarationTypeSpec>(
181 !"DOUBLECOMPLEX"_tok >> !"BYTE"_tok >> intrinsicTypeSpec)) ||
182 parenthesized(construct<DeclarationTypeSpec>(
183 construct<DeclarationTypeSpec::Type>(derivedTypeSpec))) ||
184 construct<DeclarationTypeSpec>(
185 "( * )" >> construct<DeclarationTypeSpec::TypeStar>())) ||
186 "CLASS" >> parenthesized(construct<DeclarationTypeSpec>(
187 construct<DeclarationTypeSpec::Class>(
188 derivedTypeSpec)) ||
189 construct<DeclarationTypeSpec>("*" >>
190 construct<DeclarationTypeSpec::ClassStar>())) ||
191 extension<LanguageFeature::DECStructures>(
192 "nonstandard usage: STRUCTURE"_port_en_US,
193 construct<DeclarationTypeSpec>(
194 // As is also done for the STRUCTURE statement, the name of
195 // the structure includes the surrounding slashes to avoid
196 // name clashes.
197 construct<DeclarationTypeSpec::Record>(
198 "RECORD" >> sourced("/" >> name / "/")))) ||
199 construct<DeclarationTypeSpec>(vectorTypeSpec))
200
201// R704 intrinsic-type-spec ->
202// integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |
203// COMPLEX [kind-selector] | CHARACTER [char-selector] |
204// LOGICAL [kind-selector]
205// Extensions: DOUBLE COMPLEX, BYTE
206TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,
207 first(construct<IntrinsicTypeSpec>(integerTypeSpec),
208 construct<IntrinsicTypeSpec>(
209 construct<IntrinsicTypeSpec::Real>("REAL" >> maybe(kindSelector))),
210 construct<IntrinsicTypeSpec>("DOUBLE PRECISION" >>
211 construct<IntrinsicTypeSpec::DoublePrecision>()),
212 construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Complex>(
213 "COMPLEX" >> maybe(kindSelector))),
214 construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Character>(
215 "CHARACTER" >> maybe(Parser<CharSelector>{}))),
216 construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Logical>(
217 "LOGICAL" >> maybe(kindSelector))),
218 construct<IntrinsicTypeSpec>(unsignedTypeSpec),
219 extension<LanguageFeature::DoubleComplex>(
220 "nonstandard usage: DOUBLE COMPLEX"_port_en_US,
221 construct<IntrinsicTypeSpec>("DOUBLE COMPLEX"_sptok >>
222 construct<IntrinsicTypeSpec::DoubleComplex>())),
223 extension<LanguageFeature::Byte>("nonstandard usage: BYTE"_port_en_US,
224 construct<IntrinsicTypeSpec>(construct<IntegerTypeSpec>(
225 "BYTE" >> construct<std::optional<KindSelector>>(pure(1)))))))
226
227// Extension: Vector type
228// VECTOR(intrinsic-type-spec) | __VECTOR_PAIR | __VECTOR_QUAD
229TYPE_CONTEXT_PARSER("vector type spec"_en_US,
230 extension<LanguageFeature::PPCVector>(
231 "nonstandard usage: Vector type"_port_en_US,
232 first(construct<VectorTypeSpec>(intrinsicVectorTypeSpec),
233 construct<VectorTypeSpec>("__VECTOR_PAIR" >>
234 construct<VectorTypeSpec::PairVectorTypeSpec>()),
235 construct<VectorTypeSpec>("__VECTOR_QUAD" >>
236 construct<VectorTypeSpec::QuadVectorTypeSpec>()))))
237
238// VECTOR(integer-type-spec) | VECTOR(real-type-spec) |
239// VECTOR(unsigned-type-spec) |
240TYPE_PARSER(construct<IntrinsicVectorTypeSpec>("VECTOR" >>
241 parenthesized(construct<VectorElementType>(integerTypeSpec) ||
242 construct<VectorElementType>(unsignedTypeSpec) ||
243 construct<VectorElementType>(construct<IntrinsicTypeSpec::Real>(
244 "REAL" >> maybe(kindSelector))))))
245
246// UNSIGNED type
247TYPE_PARSER(construct<UnsignedTypeSpec>("UNSIGNED" >> maybe(kindSelector)))
248
249// R705 integer-type-spec -> INTEGER [kind-selector]
250TYPE_PARSER(construct<IntegerTypeSpec>("INTEGER" >> maybe(kindSelector)))
251
252// R706 kind-selector -> ( [KIND =] scalar-int-constant-expr )
253// Legacy extension: kind-selector -> * digit-string
254TYPE_PARSER(construct<KindSelector>(
255 parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) ||
256 extension<LanguageFeature::StarKind>(
257 "nonstandard usage: TYPE*KIND syntax"_port_en_US,
258 construct<KindSelector>(construct<KindSelector::StarSize>(
259 "*" >> digitString64 / spaceCheck))))
260
261constexpr auto noSpace{
262 recovery(withMessage("invalid space"_err_en_US, !" "_ch), space)};
263
264// R707 signed-int-literal-constant -> [sign] int-literal-constant
265TYPE_PARSER(sourced(
266 construct<SignedIntLiteralConstant>(SignedIntLiteralConstantWithoutKind{},
267 maybe(noSpace >> underscore >> noSpace >> kindParam))))
268
269// R708 int-literal-constant -> digit-string [_ kind-param]
270// The negated look-ahead for a trailing underscore prevents misrecognition
271// when the digit string is a numeric kind parameter of a character literal.
272TYPE_PARSER(construct<IntLiteralConstant>(space >> digitString / !"u"_ch,
273 maybe(underscore >> noSpace >> kindParam) / !underscore))
274
275// unsigned-literal-constant -> digit-string U [_ kind-param]
276TYPE_PARSER(construct<UnsignedLiteralConstant>(space >> digitString / "u"_ch,
277 maybe(underscore >> noSpace >> kindParam) / !underscore))
278
279// R709 kind-param -> digit-string | scalar-int-constant-name
280TYPE_PARSER(construct<KindParam>(digitString64) ||
281 construct<KindParam>(
282 scalar(integer(constant(sourced(rawName >> construct<Name>()))))))
283
284// R712 sign -> + | -
285// N.B. A sign constitutes a whole token, so a space is allowed in free form
286// after the sign and before a real-literal-constant or
287// complex-literal-constant. A sign is not a unary operator in these contexts.
288constexpr auto sign{
289 "+"_tok >> pure(Sign::Positive) || "-"_tok >> pure(Sign::Negative)};
290
291// R713 signed-real-literal-constant -> [sign] real-literal-constant
292constexpr auto signedRealLiteralConstant{
293 construct<SignedRealLiteralConstant>(maybe(sign), realLiteralConstant)};
294
295// R714 real-literal-constant ->
296// significand [exponent-letter exponent] [_ kind-param] |
297// digit-string exponent-letter exponent [_ kind-param]
298// R715 significand -> digit-string . [digit-string] | . digit-string
299// R716 exponent-letter -> E | D
300// Extension: Q
301// R717 exponent -> signed-digit-string
302constexpr auto exponentPart{
303 ("ed"_ch ||
304 extension<LanguageFeature::QuadPrecision>(
305 "nonstandard usage: Q exponent"_port_en_US, "q"_ch)) >>
306 SignedDigitString{}};
307
308TYPE_CONTEXT_PARSER("REAL literal constant"_en_US,
309 space >>
310 construct<RealLiteralConstant>(
311 sourced((digitString >> "."_ch >>
312 !(some(letter) >>
313 "."_ch /* don't misinterpret 1.AND. */) >>
314 maybe(digitString) >> maybe(exponentPart) >> ok ||
315 "."_ch >> digitString >> maybe(exponentPart) >> ok ||
316 digitString >> exponentPart >> ok) >>
317 construct<RealLiteralConstant::Real>()),
318 maybe(noSpace >> underscore >> noSpace >> kindParam)))
319
320// R718 complex-literal-constant -> ( real-part , imag-part )
321TYPE_CONTEXT_PARSER("COMPLEX literal constant"_en_US,
322 parenthesized(construct<ComplexLiteralConstant>(
323 Parser<ComplexPart>{} / ",", Parser<ComplexPart>{})))
324
325// PGI/Intel extension: signed complex literal constant
326TYPE_PARSER(construct<SignedComplexLiteralConstant>(
327 sign, Parser<ComplexLiteralConstant>{}))
328
329// R719 real-part ->
330// signed-int-literal-constant | signed-real-literal-constant |
331// named-constant
332// R720 imag-part ->
333// signed-int-literal-constant | signed-real-literal-constant |
334// named-constant
335TYPE_PARSER(construct<ComplexPart>(signedRealLiteralConstant) ||
336 construct<ComplexPart>(signedIntLiteralConstant) ||
337 construct<ComplexPart>(namedConstant))
338
339// R721 char-selector ->
340// length-selector |
341// ( LEN = type-param-value , KIND = scalar-int-constant-expr ) |
342// ( type-param-value , [KIND =] scalar-int-constant-expr ) |
343// ( KIND = scalar-int-constant-expr [, LEN = type-param-value] )
344TYPE_PARSER(construct<CharSelector>(Parser<LengthSelector>{}) ||
345 parenthesized(construct<CharSelector>(
346 "LEN =" >> typeParamValue, ", KIND =" >> scalarIntConstantExpr)) ||
347 parenthesized(construct<CharSelector>(
348 typeParamValue / ",", maybe("KIND ="_tok) >> scalarIntConstantExpr)) ||
349 parenthesized(construct<CharSelector>(
350 "KIND =" >> scalarIntConstantExpr, maybe(", LEN =" >> typeParamValue))))
351
352// R722 length-selector -> ( [LEN =] type-param-value ) | * char-length [,]
353// N.B. The trailing [,] in the production is permitted by the Standard
354// only in the context of a type-declaration-stmt, but even with that
355// limitation, it would seem to be unnecessary and buggy to consume the comma
356// here.
357TYPE_PARSER(construct<LengthSelector>(
358 parenthesized(maybe("LEN ="_tok) >> typeParamValue)) ||
359 construct<LengthSelector>("*" >> charLength /* / maybe(","_tok) */))
360
361// R723 char-length -> ( type-param-value ) | digit-string
362TYPE_PARSER(construct<CharLength>(parenthesized(typeParamValue)) ||
363 construct<CharLength>(space >> digitString64 / spaceCheck))
364
365// R724 char-literal-constant ->
366// [kind-param _] ' [rep-char]... ' |
367// [kind-param _] " [rep-char]... "
368// "rep-char" is any non-control character. Doubled interior quotes are
369// combined. Backslash escapes can be enabled.
370// N.B. the parsing of "kind-param" takes care to not consume the '_'.
371TYPE_CONTEXT_PARSER("CHARACTER literal constant"_en_US,
372 construct<CharLiteralConstant>(
373 kindParam / underscore, charLiteralConstantWithoutKind) ||
374 construct<CharLiteralConstant>(construct<std::optional<KindParam>>(),
375 space >> charLiteralConstantWithoutKind))
376
377TYPE_CONTEXT_PARSER(
378 "Hollerith"_en_US, construct<HollerithLiteralConstant>(rawHollerithLiteral))
379
380// R725 logical-literal-constant ->
381// .TRUE. [_ kind-param] | .FALSE. [_ kind-param]
382// Also accept .T. and .F. as extensions.
383TYPE_PARSER(construct<LogicalLiteralConstant>(logicalTRUE,
384 maybe(noSpace >> underscore >> noSpace >> kindParam)) ||
385 construct<LogicalLiteralConstant>(
386 logicalFALSE, maybe(noSpace >> underscore >> noSpace >> kindParam)))
387
388// R726 derived-type-def ->
389// derived-type-stmt [type-param-def-stmt]...
390// [private-or-sequence]... [component-part]
391// [type-bound-procedure-part] end-type-stmt
392// R735 component-part -> [component-def-stmt]...
393TYPE_CONTEXT_PARSER("derived type definition"_en_US,
394 construct<DerivedTypeDef>(statement(Parser<DerivedTypeStmt>{}),
395 many(unambiguousStatement(Parser<TypeParamDefStmt>{})),
396 many(statement(Parser<PrivateOrSequence>{})),
397 many(inContext("component"_en_US,
398 unambiguousStatement(Parser<ComponentDefStmt>{}))),
399 maybe(Parser<TypeBoundProcedurePart>{}),
400 statement(Parser<EndTypeStmt>{})))
401
402// R727 derived-type-stmt ->
403// TYPE [[, type-attr-spec-list] ::] type-name [(
404// type-param-name-list )]
405TYPE_CONTEXT_PARSER("TYPE statement"_en_US,
406 construct<DerivedTypeStmt>(
407 "TYPE" >> optionalListBeforeColons(Parser<TypeAttrSpec>{}), name,
408 defaulted(parenthesized(nonemptyList(name)))))
409
410// R728 type-attr-spec ->
411// ABSTRACT | access-spec | BIND(C) | EXTENDS ( parent-type-name )
412TYPE_PARSER(construct<TypeAttrSpec>(construct<Abstract>("ABSTRACT"_tok)) ||
413 construct<TypeAttrSpec>(construct<TypeAttrSpec::BindC>("BIND ( C )"_tok)) ||
414 construct<TypeAttrSpec>(
415 construct<TypeAttrSpec::Extends>("EXTENDS" >> parenthesized(name))) ||
416 construct<TypeAttrSpec>(accessSpec))
417
418// R729 private-or-sequence -> private-components-stmt | sequence-stmt
419TYPE_PARSER(construct<PrivateOrSequence>(Parser<PrivateStmt>{}) ||
420 construct<PrivateOrSequence>(Parser<SequenceStmt>{}))
421
422// R730 end-type-stmt -> END TYPE [type-name]
423TYPE_PARSER(construct<EndTypeStmt>(
424 recovery("END TYPE" >> maybe(name), namedConstructEndStmtErrorRecovery)))
425
426// R731 sequence-stmt -> SEQUENCE
427TYPE_PARSER(construct<SequenceStmt>("SEQUENCE"_tok))
428
429// R732 type-param-def-stmt ->
430// integer-type-spec , type-param-attr-spec :: type-param-decl-list
431// R734 type-param-attr-spec -> KIND | LEN
432constexpr auto kindOrLen{"KIND" >> pure(common::TypeParamAttr::Kind) ||
433 "LEN" >> pure(common::TypeParamAttr::Len)};
434TYPE_PARSER(construct<TypeParamDefStmt>(integerTypeSpec / ",", kindOrLen,
435 "::" >> nonemptyList("expected type parameter declarations"_err_en_US,
436 Parser<TypeParamDecl>{})))
437
438// R733 type-param-decl -> type-param-name [= scalar-int-constant-expr]
439TYPE_PARSER(construct<TypeParamDecl>(name, maybe("=" >> scalarIntConstantExpr)))
440
441// R736 component-def-stmt -> data-component-def-stmt |
442// proc-component-def-stmt
443// Accidental extension not enabled here: PGI accepts type-param-def-stmt in
444// component-part of derived-type-def.
445TYPE_PARSER(recovery(
446 withMessage("expected component definition"_err_en_US,
447 first(construct<ComponentDefStmt>(Parser<DataComponentDefStmt>{}),
448 construct<ComponentDefStmt>(Parser<ProcComponentDefStmt>{}),
449 construct<ComponentDefStmt>(indirect(compilerDirective)))),
450 construct<ComponentDefStmt>(inStmtErrorRecovery)))
451
452// R737 data-component-def-stmt ->
453// declaration-type-spec [[, component-attr-spec-list] ::]
454// component-decl-list
455// N.B. The standard requires double colons if there's an initializer.
456TYPE_PARSER(construct<DataComponentDefStmt>(declarationTypeSpec,
457 optionalListBeforeColons(Parser<ComponentAttrSpec>{}),
458 nonemptyList("expected component declarations"_err_en_US,
459 Parser<ComponentOrFill>{})))
460
461// R738 component-attr-spec ->
462// access-spec | ALLOCATABLE |
463// CODIMENSION lbracket coarray-spec rbracket |
464// CONTIGUOUS | DIMENSION ( component-array-spec ) | POINTER |
465// CUDA-data-attr
466TYPE_PARSER(construct<ComponentAttrSpec>(accessSpec) ||
467 construct<ComponentAttrSpec>(allocatable) ||
468 construct<ComponentAttrSpec>("CODIMENSION" >> coarraySpec) ||
469 construct<ComponentAttrSpec>(contiguous) ||
470 construct<ComponentAttrSpec>("DIMENSION" >> componentArraySpec) ||
471 construct<ComponentAttrSpec>(pointer) ||
472 extension<LanguageFeature::CUDA>(
473 construct<ComponentAttrSpec>(Parser<common::CUDADataAttr>{})) ||
474 construct<ComponentAttrSpec>(recovery(
475 fail<ErrorRecovery>(
476 "type parameter definitions must appear before component declarations"_err_en_US),
477 kindOrLen >> construct<ErrorRecovery>())))
478
479// R739 component-decl ->
480// component-name [( component-array-spec )]
481// [lbracket coarray-spec rbracket] [* char-length]
482// [component-initialization] |
483// (ext.) component-name *char-length [(component-array-spec)]
484// [lbracket coarray-spec rbracket] [* char-length]
485// [component-initialization]
486TYPE_CONTEXT_PARSER("component declaration"_en_US,
487 construct<ComponentDecl>(name, "*" >> charLength, maybe(componentArraySpec),
488 maybe(coarraySpec), maybe(initialization)) ||
489 construct<ComponentDecl>(name, maybe(componentArraySpec),
490 maybe(coarraySpec), maybe("*" >> charLength),
491 maybe(initialization)))
492// The source field of the Name will be replaced with a distinct generated name.
493TYPE_CONTEXT_PARSER("%FILL item"_en_US,
494 extension<LanguageFeature::DECStructures>(
495 "nonstandard usage: %FILL"_port_en_US,
496 construct<FillDecl>(space >> sourced("%FILL" >> construct<Name>()),
497 maybe(componentArraySpec), maybe("*" >> charLength))))
498TYPE_PARSER(construct<ComponentOrFill>(Parser<ComponentDecl>{}) ||
499 construct<ComponentOrFill>(Parser<FillDecl>{}))
500
501// R740 component-array-spec ->
502// explicit-shape-spec-list | deferred-shape-spec-list
503// N.B. Parenthesized here rather than around references to this production.
504TYPE_PARSER(construct<ComponentArraySpec>(parenthesized(
505 nonemptyList("expected explicit shape specifications"_err_en_US,
506 explicitShapeSpec))) ||
507 construct<ComponentArraySpec>(parenthesized(deferredShapeSpecList)))
508
509// R741 proc-component-def-stmt ->
510// PROCEDURE ( [proc-interface] ) , proc-component-attr-spec-list
511// :: proc-decl-list
512TYPE_CONTEXT_PARSER("PROCEDURE component definition statement"_en_US,
513 construct<ProcComponentDefStmt>(
514 "PROCEDURE" >> parenthesized(maybe(procInterface)),
515 localRecovery("expected PROCEDURE component attributes"_err_en_US,
516 "," >> nonemptyList(Parser<ProcComponentAttrSpec>{}), ok),
517 localRecovery("expected PROCEDURE declarations"_err_en_US,
518 "::" >> nonemptyList(procDecl), SkipTo<'\n'>{})))
519
520// R742 proc-component-attr-spec ->
521// access-spec | NOPASS | PASS [(arg-name)] | POINTER
522constexpr auto noPass{construct<NoPass>("NOPASS"_tok)};
523constexpr auto pass{construct<Pass>("PASS" >> maybe(parenthesized(name)))};
524TYPE_PARSER(construct<ProcComponentAttrSpec>(accessSpec) ||
525 construct<ProcComponentAttrSpec>(noPass) ||
526 construct<ProcComponentAttrSpec>(pass) ||
527 construct<ProcComponentAttrSpec>(pointer))
528
529// R744 initial-data-target -> designator
530constexpr auto initialDataTarget{indirect(designator)};
531
532// R743 component-initialization ->
533// = constant-expr | => null-init | => initial-data-target
534// R805 initialization ->
535// = constant-expr | => null-init | => initial-data-target
536// Universal extension: initialization -> / data-stmt-value-list /
537TYPE_PARSER(construct<Initialization>("=>" >> nullInit) ||
538 construct<Initialization>("=>" >> initialDataTarget) ||
539 construct<Initialization>("=" >> constantExpr) ||
540 extension<LanguageFeature::SlashInitialization>(
541 "nonstandard usage: /initialization/"_port_en_US,
542 construct<Initialization>(
543 "/" >> nonemptyList("expected values"_err_en_US,
544 indirect(Parser<DataStmtValue>{})) /
545 "/")))
546
547// R745 private-components-stmt -> PRIVATE
548// R747 binding-private-stmt -> PRIVATE
549TYPE_PARSER(construct<PrivateStmt>("PRIVATE"_tok))
550
551// R746 type-bound-procedure-part ->
552// contains-stmt [binding-private-stmt] [type-bound-proc-binding]...
553TYPE_CONTEXT_PARSER("type bound procedure part"_en_US,
554 construct<TypeBoundProcedurePart>(statement(containsStmt),
555 maybe(statement(Parser<PrivateStmt>{})),
556 many(statement(Parser<TypeBoundProcBinding>{}))))
557
558// R748 type-bound-proc-binding ->
559// type-bound-procedure-stmt | type-bound-generic-stmt |
560// final-procedure-stmt
561TYPE_CONTEXT_PARSER("type bound procedure binding"_en_US,
562 recovery(
563 first(construct<TypeBoundProcBinding>(Parser<TypeBoundProcedureStmt>{}),
564 construct<TypeBoundProcBinding>(Parser<TypeBoundGenericStmt>{}),
565 construct<TypeBoundProcBinding>(Parser<FinalProcedureStmt>{})),
566 construct<TypeBoundProcBinding>(
567 !"END"_tok >> SkipTo<'\n'>{} >> construct<ErrorRecovery>())))
568
569// R749 type-bound-procedure-stmt ->
570// PROCEDURE [[, bind-attr-list] ::] type-bound-proc-decl-list |
571// PROCEDURE ( interface-name ) , bind-attr-list :: binding-name-list
572// The "::" is required by the standard (C768) in the first production if
573// any type-bound-proc-decl has a "=>', but it's not strictly necessary to
574// avoid a bad parse.
575TYPE_CONTEXT_PARSER("type bound PROCEDURE statement"_en_US,
576 "PROCEDURE" >>
577 (construct<TypeBoundProcedureStmt>(
578 construct<TypeBoundProcedureStmt::WithInterface>(
579 parenthesized(name),
580 localRecovery("expected list of binding attributes"_err_en_US,
581 "," >> nonemptyList(Parser<BindAttr>{}), ok),
582 localRecovery("expected list of binding names"_err_en_US,
583 "::" >> listOfNames, SkipTo<'\n'>{}))) ||
584 construct<TypeBoundProcedureStmt>(construct<
585 TypeBoundProcedureStmt::WithoutInterface>(
586 pure<std::list<BindAttr>>(),
587 nonemptyList(
588 "expected type bound procedure declarations"_err_en_US,
589 construct<TypeBoundProcDecl>(name,
590 maybe(extension<LanguageFeature::MissingColons>(
591 "type-bound procedure statement should have '::' if it has '=>'"_port_en_US,
592 "=>" >> name)))))) ||
593 construct<TypeBoundProcedureStmt>(
594 construct<TypeBoundProcedureStmt::WithoutInterface>(
595 optionalListBeforeColons(Parser<BindAttr>{}),
596 nonemptyList(
597 "expected type bound procedure declarations"_err_en_US,
598 Parser<TypeBoundProcDecl>{})))))
599
600// R750 type-bound-proc-decl -> binding-name [=> procedure-name]
601TYPE_PARSER(construct<TypeBoundProcDecl>(name, maybe("=>" >> name)))
602
603// R751 type-bound-generic-stmt ->
604// GENERIC [, access-spec] :: generic-spec => binding-name-list
605TYPE_CONTEXT_PARSER("type bound GENERIC statement"_en_US,
606 construct<TypeBoundGenericStmt>("GENERIC" >> maybe("," >> accessSpec),
607 "::" >> indirect(genericSpec), "=>" >> listOfNames))
608
609// R752 bind-attr ->
610// access-spec | DEFERRED | NON_OVERRIDABLE | NOPASS | PASS [(arg-name)]
611TYPE_PARSER(construct<BindAttr>(accessSpec) ||
612 construct<BindAttr>(construct<BindAttr::Deferred>("DEFERRED"_tok)) ||
613 construct<BindAttr>(
614 construct<BindAttr::Non_Overridable>("NON_OVERRIDABLE"_tok)) ||
615 construct<BindAttr>(noPass) || construct<BindAttr>(pass))
616
617// R753 final-procedure-stmt -> FINAL [::] final-subroutine-name-list
618TYPE_CONTEXT_PARSER("FINAL statement"_en_US,
619 construct<FinalProcedureStmt>("FINAL" >> maybe("::"_tok) >> listOfNames))
620
621// R754 derived-type-spec -> type-name [(type-param-spec-list)]
622TYPE_PARSER(construct<DerivedTypeSpec>(name,
623 defaulted(parenthesized(nonemptyList(
624 "expected type parameters"_err_en_US, Parser<TypeParamSpec>{})))))
625
626// R755 type-param-spec -> [keyword =] type-param-value
627TYPE_PARSER(construct<TypeParamSpec>(maybe(keyword / "="), typeParamValue))
628
629// R756 structure-constructor -> derived-type-spec ( [component-spec-list] )
630TYPE_PARSER((construct<StructureConstructor>(derivedTypeSpec,
631 parenthesized(optionalList(Parser<ComponentSpec>{}))) ||
632 // This alternative corrects misrecognition of the
633 // component-spec-list as the type-param-spec-list in
634 // derived-type-spec.
635 construct<StructureConstructor>(
636 construct<DerivedTypeSpec>(
637 name, construct<std::list<TypeParamSpec>>()),
638 parenthesized(optionalList(Parser<ComponentSpec>{})))) /
639 !"("_tok)
640
641// R757 component-spec -> [keyword =] component-data-source
642TYPE_PARSER(construct<ComponentSpec>(
643 maybe(keyword / "="), Parser<ComponentDataSource>{}))
644
645// R758 component-data-source -> expr | data-target | proc-target
646TYPE_PARSER(construct<ComponentDataSource>(indirect(expr)))
647
648// R759 enum-def ->
649// enum-def-stmt enumerator-def-stmt [enumerator-def-stmt]...
650// end-enum-stmt
651TYPE_CONTEXT_PARSER("enum definition"_en_US,
652 construct<EnumDef>(statement(Parser<EnumDefStmt>{}),
653 some(unambiguousStatement(Parser<EnumeratorDefStmt>{})),
654 statement(Parser<EndEnumStmt>{})))
655
656// R760 enum-def-stmt -> ENUM, BIND(C)
657TYPE_PARSER(construct<EnumDefStmt>("ENUM , BIND ( C )"_tok))
658
659// R761 enumerator-def-stmt -> ENUMERATOR [::] enumerator-list
660TYPE_CONTEXT_PARSER("ENUMERATOR statement"_en_US,
661 construct<EnumeratorDefStmt>("ENUMERATOR" >> maybe("::"_tok) >>
662 nonemptyList("expected enumerators"_err_en_US, Parser<Enumerator>{})))
663
664// R762 enumerator -> named-constant [= scalar-int-constant-expr]
665TYPE_PARSER(
666 construct<Enumerator>(namedConstant, maybe("=" >> scalarIntConstantExpr)))
667
668// R763 end-enum-stmt -> END ENUM
669TYPE_PARSER(recovery("END ENUM"_tok, constructEndStmtErrorRecovery) >>
670 construct<EndEnumStmt>())
671
672// R801 type-declaration-stmt ->
673// declaration-type-spec [[, attr-spec]... ::] entity-decl-list
674constexpr auto entityDeclWithoutEqInit{
675 construct<EntityDecl>(name, "*" >> charLength, maybe(arraySpec),
676 maybe(coarraySpec), !"="_tok >> maybe(initialization)) ||
677 construct<EntityDecl>(name, maybe(arraySpec), maybe(coarraySpec),
678 maybe("*" >> charLength),
679 !"="_tok >>
680 maybe(initialization) /* old-style REAL A/0/ still works */)};
681TYPE_PARSER(
682 construct<TypeDeclarationStmt>(declarationTypeSpec,
683 defaulted("," >> nonemptyList(Parser<AttrSpec>{})) / "::",
684 nonemptyList("expected entity declarations"_err_en_US, entityDecl)) ||
685 // C806: no initializers allowed without colons ("REALA=1" is ambiguous)
686 construct<TypeDeclarationStmt>(declarationTypeSpec,
687 construct<std::list<AttrSpec>>(),
688 nonemptyList("expected entity declarations"_err_en_US,
689 entityDeclWithoutEqInit)) ||
690 // PGI-only extension: comma in place of doubled colons
691 extension<LanguageFeature::MissingColons>(
692 "nonstandard usage: ',' in place of '::'"_port_en_US,
693 construct<TypeDeclarationStmt>(declarationTypeSpec,
694 defaulted("," >> nonemptyList(Parser<AttrSpec>{})),
695 withMessage("expected entity declarations"_err_en_US,
696 "," >> nonemptyList(entityDecl)))))
697
698// R802 attr-spec ->
699// access-spec | ALLOCATABLE | ASYNCHRONOUS |
700// CODIMENSION lbracket coarray-spec rbracket | CONTIGUOUS |
701// DIMENSION ( array-spec ) | EXTERNAL | INTENT ( intent-spec ) |
702// INTRINSIC | language-binding-spec | OPTIONAL | PARAMETER | POINTER |
703// PROTECTED | SAVE | TARGET | VALUE | VOLATILE |
704// CUDA-data-attr
705TYPE_PARSER(construct<AttrSpec>(accessSpec) ||
706 construct<AttrSpec>(allocatable) ||
707 construct<AttrSpec>(construct<Asynchronous>("ASYNCHRONOUS"_tok)) ||
708 construct<AttrSpec>("CODIMENSION" >> coarraySpec) ||
709 construct<AttrSpec>(contiguous) ||
710 construct<AttrSpec>("DIMENSION" >> arraySpec) ||
711 construct<AttrSpec>(construct<External>("EXTERNAL"_tok)) ||
712 construct<AttrSpec>("INTENT" >> parenthesized(intentSpec)) ||
713 construct<AttrSpec>(construct<Intrinsic>("INTRINSIC"_tok)) ||
714 construct<AttrSpec>(languageBindingSpec) || construct<AttrSpec>(optional) ||
715 construct<AttrSpec>(construct<Parameter>("PARAMETER"_tok)) ||
716 construct<AttrSpec>(pointer) || construct<AttrSpec>(protectedAttr) ||
717 construct<AttrSpec>(save) ||
718 construct<AttrSpec>(construct<Target>("TARGET"_tok)) ||
719 construct<AttrSpec>(construct<Value>("VALUE"_tok)) ||
720 construct<AttrSpec>(construct<Volatile>("VOLATILE"_tok)) ||
721 extension<LanguageFeature::CUDA>(
722 construct<AttrSpec>(Parser<common::CUDADataAttr>{})))
723
724// CUDA-data-attr ->
725// CONSTANT | DEVICE | MANAGED | PINNED | SHARED | TEXTURE | UNIFIED
726TYPE_PARSER("CONSTANT" >> pure(common::CUDADataAttr::Constant) ||
727 "DEVICE" >> pure(common::CUDADataAttr::Device) ||
728 "MANAGED" >> pure(common::CUDADataAttr::Managed) ||
729 "PINNED" >> pure(common::CUDADataAttr::Pinned) ||
730 "SHARED" >> pure(common::CUDADataAttr::Shared) ||
731 "TEXTURE" >> pure(common::CUDADataAttr::Texture) ||
732 "UNIFIED" >> pure(common::CUDADataAttr::Unified))
733
734// R804 object-name -> name
735constexpr auto objectName{name};
736
737// R803 entity-decl ->
738// object-name [( array-spec )] [lbracket coarray-spec rbracket]
739// [* char-length] [initialization] |
740// function-name [* char-length] |
741// (ext.) object-name *char-length [(array-spec)]
742// [lbracket coarray-spec rbracket] [initialization]
743TYPE_PARSER(construct<EntityDecl>(objectName, "*" >> charLength,
744 maybe(arraySpec), maybe(coarraySpec), maybe(initialization)) ||
745 construct<EntityDecl>(objectName, maybe(arraySpec), maybe(coarraySpec),
746 maybe("*" >> charLength), maybe(initialization)))
747
748// R806 null-init -> function-reference ... which must resolve to NULL()
749TYPE_PARSER(lookAhead(name / "( )") >> construct<NullInit>(expr))
750
751// R807 access-spec -> PUBLIC | PRIVATE
752TYPE_PARSER(construct<AccessSpec>("PUBLIC" >> pure(AccessSpec::Kind::Public)) ||
753 construct<AccessSpec>("PRIVATE" >> pure(AccessSpec::Kind::Private)))
754
755// R808 language-binding-spec ->
756// BIND ( C [, NAME = scalar-default-char-constant-expr] )
757// R1528 proc-language-binding-spec -> language-binding-spec
758TYPE_PARSER(construct<LanguageBindingSpec>(
759 "BIND ( C" >> maybe(", NAME =" >> scalarDefaultCharConstantExpr),
760 (", CDEFINED" >> pure(true) || pure(false)) / ")"))
761
762// R809 coarray-spec -> deferred-coshape-spec-list | explicit-coshape-spec
763// N.B. Bracketed here rather than around references, for consistency with
764// array-spec.
765TYPE_PARSER(
766 construct<CoarraySpec>(bracketed(Parser<DeferredCoshapeSpecList>{})) ||
767 construct<CoarraySpec>(bracketed(Parser<ExplicitCoshapeSpec>{})))
768
769// R810 deferred-coshape-spec -> :
770// deferred-coshape-spec-list - just a list of colons
771inline int listLength(std::list<Success> &&xs) { return xs.size(); }
772
773TYPE_PARSER(construct<DeferredCoshapeSpecList>(
774 applyFunction(listLength, nonemptyList(":"_tok))))
775
776// R811 explicit-coshape-spec ->
777// [[lower-cobound :] upper-cobound ,]... [lower-cobound :] *
778// R812 lower-cobound -> specification-expr
779// R813 upper-cobound -> specification-expr
780TYPE_PARSER(construct<ExplicitCoshapeSpec>(
781 many(explicitShapeSpec / ","), maybe(specificationExpr / ":") / "*"))
782
783// R815 array-spec ->
784// explicit-shape-spec-list | assumed-shape-spec-list |
785// deferred-shape-spec-list | assumed-size-spec | implied-shape-spec |
786// implied-shape-or-assumed-size-spec | assumed-rank-spec
787// N.B. Parenthesized here rather than around references to avoid
788// a need for forced look-ahead.
789// Shape specs that could be deferred-shape-spec or assumed-shape-spec
790// (e.g. '(:,:)') are parsed as the former.
791TYPE_PARSER(
792 construct<ArraySpec>(parenthesized(nonemptyList(explicitShapeSpec))) ||
793 construct<ArraySpec>(parenthesized(deferredShapeSpecList)) ||
794 construct<ArraySpec>(
795 parenthesized(nonemptyList(Parser<AssumedShapeSpec>{}))) ||
796 construct<ArraySpec>(parenthesized(Parser<AssumedSizeSpec>{})) ||
797 construct<ArraySpec>(parenthesized(Parser<ImpliedShapeSpec>{})) ||
798 construct<ArraySpec>(parenthesized(Parser<AssumedRankSpec>{})))
799
800// R816 explicit-shape-spec -> [lower-bound :] upper-bound
801// R817 lower-bound -> specification-expr
802// R818 upper-bound -> specification-expr
803TYPE_PARSER(construct<ExplicitShapeSpec>(
804 maybe(specificationExpr / ":"), specificationExpr))
805
806// R819 assumed-shape-spec -> [lower-bound] :
807TYPE_PARSER(construct<AssumedShapeSpec>(maybe(specificationExpr) / ":"))
808
809// R820 deferred-shape-spec -> :
810// deferred-shape-spec-list - just a list of colons
811TYPE_PARSER(construct<DeferredShapeSpecList>(
812 applyFunction(listLength, nonemptyList(":"_tok))))
813
814// R821 assumed-implied-spec -> [lower-bound :] *
815TYPE_PARSER(construct<AssumedImpliedSpec>(maybe(specificationExpr / ":") / "*"))
816
817// R822 assumed-size-spec -> explicit-shape-spec-list , assumed-implied-spec
818TYPE_PARSER(construct<AssumedSizeSpec>(
819 nonemptyList(explicitShapeSpec) / ",", assumedImpliedSpec))
820
821// R823 implied-shape-or-assumed-size-spec -> assumed-implied-spec
822// R824 implied-shape-spec -> assumed-implied-spec , assumed-implied-spec-list
823// I.e., when the assumed-implied-spec-list has a single item, it constitutes an
824// implied-shape-or-assumed-size-spec; otherwise, an implied-shape-spec.
825TYPE_PARSER(construct<ImpliedShapeSpec>(nonemptyList(assumedImpliedSpec)))
826
827// R825 assumed-rank-spec -> ..
828TYPE_PARSER(construct<AssumedRankSpec>(".."_tok))
829
830// R826 intent-spec -> IN | OUT | INOUT
831TYPE_PARSER(construct<IntentSpec>("IN OUT" >> pure(IntentSpec::Intent::InOut) ||
832 "IN" >> pure(IntentSpec::Intent::In) ||
833 "OUT" >> pure(IntentSpec::Intent::Out)))
834
835// R827 access-stmt -> access-spec [[::] access-id-list]
836TYPE_PARSER(construct<AccessStmt>(accessSpec,
837 defaulted(maybe("::"_tok) >>
838 nonemptyList("expected names and generic specifications"_err_en_US,
839 Parser<AccessId>{}))))
840
841// R828 access-id -> access-name | generic-spec
842// "access-name" is ambiguous with "generic-spec"
843TYPE_PARSER(construct<AccessId>(indirect(genericSpec)))
844
845// R829 allocatable-stmt -> ALLOCATABLE [::] allocatable-decl-list
846TYPE_PARSER(construct<AllocatableStmt>("ALLOCATABLE" >> maybe("::"_tok) >>
847 nonemptyList(
848 "expected object declarations"_err_en_US, Parser<ObjectDecl>{})))
849
850// R830 allocatable-decl ->
851// object-name [( array-spec )] [lbracket coarray-spec rbracket]
852// R860 target-decl ->
853// object-name [( array-spec )] [lbracket coarray-spec rbracket]
854TYPE_PARSER(
855 construct<ObjectDecl>(objectName, maybe(arraySpec), maybe(coarraySpec)))
856
857// R831 asynchronous-stmt -> ASYNCHRONOUS [::] object-name-list
858TYPE_PARSER(construct<AsynchronousStmt>("ASYNCHRONOUS" >> maybe("::"_tok) >>
859 nonemptyList("expected object names"_err_en_US, objectName)))
860
861// R832 bind-stmt -> language-binding-spec [::] bind-entity-list
862TYPE_PARSER(construct<BindStmt>(languageBindingSpec / maybe("::"_tok),
863 nonemptyList("expected bind entities"_err_en_US, Parser<BindEntity>{})))
864
865// R833 bind-entity -> entity-name | / common-block-name /
866TYPE_PARSER(construct<BindEntity>(pure(BindEntity::Kind::Object), name) ||
867 construct<BindEntity>("/" >> pure(BindEntity::Kind::Common), name / "/"))
868
869// R834 codimension-stmt -> CODIMENSION [::] codimension-decl-list
870TYPE_PARSER(construct<CodimensionStmt>("CODIMENSION" >> maybe("::"_tok) >>
871 nonemptyList("expected codimension declarations"_err_en_US,
872 Parser<CodimensionDecl>{})))
873
874// R835 codimension-decl -> coarray-name lbracket coarray-spec rbracket
875TYPE_PARSER(construct<CodimensionDecl>(name, coarraySpec))
876
877// R836 contiguous-stmt -> CONTIGUOUS [::] object-name-list
878TYPE_PARSER(construct<ContiguousStmt>("CONTIGUOUS" >> maybe("::"_tok) >>
879 nonemptyList("expected object names"_err_en_US, objectName)))
880
881// R837 data-stmt -> DATA data-stmt-set [[,] data-stmt-set]...
882TYPE_CONTEXT_PARSER("DATA statement"_en_US,
883 construct<DataStmt>(
884 "DATA" >> nonemptySeparated(Parser<DataStmtSet>{}, maybe(","_tok))))
885
886// R838 data-stmt-set -> data-stmt-object-list / data-stmt-value-list /
887TYPE_PARSER(construct<DataStmtSet>(
888 nonemptyList(
889 "expected DATA statement objects"_err_en_US, Parser<DataStmtObject>{}),
890 withMessage("expected DATA statement value list"_err_en_US,
891 "/"_tok >> nonemptyList("expected DATA statement values"_err_en_US,
892 Parser<DataStmtValue>{})) /
893 "/"))
894
895// R839 data-stmt-object -> variable | data-implied-do
896TYPE_PARSER(construct<DataStmtObject>(indirect(variable)) ||
897 construct<DataStmtObject>(dataImpliedDo))
898
899// R840 data-implied-do ->
900// ( data-i-do-object-list , [integer-type-spec ::] data-i-do-variable
901// = scalar-int-constant-expr , scalar-int-constant-expr
902// [, scalar-int-constant-expr] )
903// R842 data-i-do-variable -> do-variable
904TYPE_PARSER(parenthesized(construct<DataImpliedDo>(
905 nonemptyList(Parser<DataIDoObject>{} / lookAhead(","_tok)) / ",",
906 maybe(integerTypeSpec / "::"), loopBounds(scalarIntConstantExpr))))
907
908// R841 data-i-do-object ->
909// array-element | scalar-structure-component | data-implied-do
910TYPE_PARSER(construct<DataIDoObject>(scalar(indirect(designator))) ||
911 construct<DataIDoObject>(indirect(dataImpliedDo)))
912
913// R843 data-stmt-value -> [data-stmt-repeat *] data-stmt-constant
914TYPE_PARSER(construct<DataStmtValue>(
915 maybe(Parser<DataStmtRepeat>{} / "*"), Parser<DataStmtConstant>{}))
916
917// R847 constant-subobject -> designator
918// R846 int-constant-subobject -> constant-subobject
919constexpr auto constantSubobject{constant(indirect(designator))};
920
921// R844 data-stmt-repeat -> scalar-int-constant | scalar-int-constant-subobject
922// R607 int-constant -> constant
923// Factored into: constant -> literal-constant -> int-literal-constant
924// The named-constant alternative of constant is subsumed by constant-subobject
925TYPE_PARSER(construct<DataStmtRepeat>(intLiteralConstant) ||
926 construct<DataStmtRepeat>(scalar(integer(constantSubobject))))
927
928// R845 data-stmt-constant ->
929// scalar-constant | scalar-constant-subobject |
930// signed-int-literal-constant | signed-real-literal-constant |
931// null-init | initial-data-target |
932// constant-structure-constructor
933// N.B. scalar-constant and scalar-constant-subobject are ambiguous with
934// initial-data-target; null-init and structure-constructor are ambiguous
935// in the absence of parameters and components; structure-constructor with
936// components can be ambiguous with a scalar-constant-subobject.
937// So we parse literal constants, designator, null-init, and
938// structure-constructor, so that semantics can figure things out later
939// with the symbol table. A literal constant substring must be attempted
940// first to avoid a partial match with a literal constant.
941TYPE_PARSER(sourced(first(
942 construct<DataStmtConstant>(indirect(charLiteralConstantSubstring)),
943 construct<DataStmtConstant>(literalConstant),
944 construct<DataStmtConstant>(signedRealLiteralConstant),
945 construct<DataStmtConstant>(signedIntLiteralConstant),
946 extension<LanguageFeature::SignedComplexLiteral>(
947 "nonstandard usage: signed COMPLEX literal"_port_en_US,
948 construct<DataStmtConstant>(Parser<SignedComplexLiteralConstant>{})),
949 construct<DataStmtConstant>(nullInit),
950 construct<DataStmtConstant>(indirect(designator) / !"("_tok),
951 construct<DataStmtConstant>(Parser<StructureConstructor>{}))))
952
953// R848 dimension-stmt ->
954// DIMENSION [::] array-name ( array-spec )
955// [, array-name ( array-spec )]...
956TYPE_CONTEXT_PARSER("DIMENSION statement"_en_US,
957 construct<DimensionStmt>("DIMENSION" >> maybe("::"_tok) >>
958 nonemptyList("expected array specifications"_err_en_US,
959 construct<DimensionStmt::Declaration>(name, arraySpec))))
960
961// R849 intent-stmt -> INTENT ( intent-spec ) [::] dummy-arg-name-list
962TYPE_CONTEXT_PARSER("INTENT statement"_en_US,
963 construct<IntentStmt>(
964 "INTENT" >> parenthesized(intentSpec) / maybe("::"_tok), listOfNames))
965
966// R850 optional-stmt -> OPTIONAL [::] dummy-arg-name-list
967TYPE_PARSER(
968 construct<OptionalStmt>("OPTIONAL" >> maybe("::"_tok) >> listOfNames))
969
970// R851 parameter-stmt -> PARAMETER ( named-constant-def-list )
971// Legacy extension: omitted parentheses, no implicit typing from names
972TYPE_CONTEXT_PARSER("PARAMETER statement"_en_US,
973 construct<ParameterStmt>(
974 "PARAMETER" >> parenthesized(nonemptyList(Parser<NamedConstantDef>{}))))
975TYPE_CONTEXT_PARSER("old style PARAMETER statement"_en_US,
976 extension<LanguageFeature::OldStyleParameter>(
977 "nonstandard usage: PARAMETER without parentheses"_port_en_US,
978 construct<OldParameterStmt>(
979 "PARAMETER" >> nonemptyList(Parser<NamedConstantDef>{}))))
980
981// R852 named-constant-def -> named-constant = constant-expr
982TYPE_PARSER(construct<NamedConstantDef>(namedConstant, "=" >> constantExpr))
983
984// R853 pointer-stmt -> POINTER [::] pointer-decl-list
985TYPE_PARSER(construct<PointerStmt>("POINTER" >> maybe("::"_tok) >>
986 nonemptyList(
987 "expected pointer declarations"_err_en_US, Parser<PointerDecl>{})))
988
989// R854 pointer-decl ->
990// object-name [( deferred-shape-spec-list )] | proc-entity-name
991TYPE_PARSER(
992 construct<PointerDecl>(name, maybe(parenthesized(deferredShapeSpecList))))
993
994// R855 protected-stmt -> PROTECTED [::] entity-name-list
995TYPE_PARSER(
996 construct<ProtectedStmt>("PROTECTED" >> maybe("::"_tok) >> listOfNames))
997
998// R856 save-stmt -> SAVE [[::] saved-entity-list]
999TYPE_PARSER(construct<SaveStmt>(
1000 "SAVE" >> defaulted(maybe("::"_tok) >>
1001 nonemptyList("expected SAVE entities"_err_en_US,
1002 Parser<SavedEntity>{}))))
1003
1004// R857 saved-entity -> object-name | proc-pointer-name | / common-block-name /
1005// R858 proc-pointer-name -> name
1006TYPE_PARSER(construct<SavedEntity>(pure(SavedEntity::Kind::Entity), name) ||
1007 construct<SavedEntity>("/" >> pure(SavedEntity::Kind::Common), name / "/"))
1008
1009// R859 target-stmt -> TARGET [::] target-decl-list
1010TYPE_PARSER(construct<TargetStmt>("TARGET" >> maybe("::"_tok) >>
1011 nonemptyList("expected objects"_err_en_US, Parser<ObjectDecl>{})))
1012
1013// R861 value-stmt -> VALUE [::] dummy-arg-name-list
1014TYPE_PARSER(construct<ValueStmt>("VALUE" >> maybe("::"_tok) >> listOfNames))
1015
1016// R862 volatile-stmt -> VOLATILE [::] object-name-list
1017TYPE_PARSER(construct<VolatileStmt>("VOLATILE" >> maybe("::"_tok) >>
1018 nonemptyList("expected object names"_err_en_US, objectName)))
1019
1020// R866 implicit-name-spec -> EXTERNAL | TYPE
1021constexpr auto implicitNameSpec{
1022 "EXTERNAL" >> pure(ImplicitStmt::ImplicitNoneNameSpec::External) ||
1023 "TYPE" >> pure(ImplicitStmt::ImplicitNoneNameSpec::Type)};
1024
1025// R863 implicit-stmt ->
1026// IMPLICIT implicit-spec-list |
1027// IMPLICIT NONE [( [implicit-name-spec-list] )]
1028TYPE_CONTEXT_PARSER("IMPLICIT statement"_en_US,
1029 construct<ImplicitStmt>(
1030 "IMPLICIT" >> nonemptyList("expected IMPLICIT specifications"_err_en_US,
1031 Parser<ImplicitSpec>{})) ||
1032 construct<ImplicitStmt>("IMPLICIT NONE"_sptok >>
1033 defaulted(parenthesized(optionalList(implicitNameSpec)))))
1034
1035// R864 implicit-spec -> declaration-type-spec ( letter-spec-list )
1036// The variant form of declarationTypeSpec is meant to avoid misrecognition
1037// of a letter-spec as a simple parenthesized expression for kind or character
1038// length, e.g., PARAMETER(I=5,N=1); IMPLICIT REAL(I-N)(O-Z) vs.
1039// IMPLICIT REAL(I-N). The variant form needs to attempt to reparse only
1040// types with optional parenthesized kind/length expressions, so derived
1041// type specs, DOUBLE PRECISION, and DOUBLE COMPLEX need not be considered.
1042constexpr auto noKindSelector{construct<std::optional<KindSelector>>()};
1043constexpr auto implicitSpecDeclarationTypeSpecRetry{
1044 construct<DeclarationTypeSpec>(first(
1045 construct<IntrinsicTypeSpec>(
1046 construct<IntegerTypeSpec>("INTEGER" >> noKindSelector)),
1047 construct<IntrinsicTypeSpec>(
1048 construct<IntrinsicTypeSpec::Real>("REAL" >> noKindSelector)),
1049 construct<IntrinsicTypeSpec>(
1050 construct<IntrinsicTypeSpec::Complex>("COMPLEX" >> noKindSelector)),
1051 construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Character>(
1052 "CHARACTER" >> construct<std::optional<CharSelector>>())),
1053 construct<IntrinsicTypeSpec>(
1054 construct<IntrinsicTypeSpec::Logical>("LOGICAL" >> noKindSelector)),
1055 construct<IntrinsicTypeSpec>(
1056 construct<UnsignedTypeSpec>("UNSIGNED" >> noKindSelector))))};
1057
1058TYPE_PARSER(construct<ImplicitSpec>(declarationTypeSpec,
1059 parenthesized(nonemptyList(Parser<LetterSpec>{}))) ||
1060 construct<ImplicitSpec>(implicitSpecDeclarationTypeSpecRetry,
1061 parenthesized(nonemptyList(Parser<LetterSpec>{}))))
1062
1063// R865 letter-spec -> letter [- letter]
1064TYPE_PARSER(space >> (construct<LetterSpec>(letter, maybe("-" >> letter)) ||
1065 construct<LetterSpec>(otherIdChar,
1066 construct<std::optional<const char *>>())))
1067
1068// R867 import-stmt ->
1069// IMPORT [[::] import-name-list] |
1070// IMPORT , ONLY : import-name-list | IMPORT , NONE | IMPORT , ALL
1071TYPE_CONTEXT_PARSER("IMPORT statement"_en_US,
1072 construct<ImportStmt>(
1073 "IMPORT , ONLY :" >> pure(common::ImportKind::Only), listOfNames) ||
1074 construct<ImportStmt>(
1075 "IMPORT , NONE" >> pure(common::ImportKind::None)) ||
1076 construct<ImportStmt>(
1077 "IMPORT , ALL" >> pure(common::ImportKind::All)) ||
1078 construct<ImportStmt>(
1079 "IMPORT" >> maybe("::"_tok) >> optionalList(name)))
1080
1081// R868 namelist-stmt ->
1082// NAMELIST / namelist-group-name / namelist-group-object-list
1083// [[,] / namelist-group-name / namelist-group-object-list]...
1084// R869 namelist-group-object -> variable-name
1085TYPE_PARSER(construct<NamelistStmt>("NAMELIST" >>
1086 nonemptySeparated(
1087 construct<NamelistStmt::Group>("/" >> name / "/", listOfNames),
1088 maybe(","_tok))))
1089
1090// R870 equivalence-stmt -> EQUIVALENCE equivalence-set-list
1091// R871 equivalence-set -> ( equivalence-object , equivalence-object-list )
1092TYPE_PARSER(construct<EquivalenceStmt>("EQUIVALENCE" >>
1093 nonemptyList(
1094 parenthesized(nonemptyList("expected EQUIVALENCE objects"_err_en_US,
1095 Parser<EquivalenceObject>{})))))
1096
1097// R872 equivalence-object -> variable-name | array-element | substring
1098TYPE_PARSER(construct<EquivalenceObject>(indirect(designator)))
1099
1100// R873 common-stmt ->
1101// COMMON [/ [common-block-name] /] common-block-object-list
1102// [[,] / [common-block-name] / common-block-object-list]...
1103TYPE_PARSER(
1104 construct<CommonStmt>("COMMON" >> defaulted("/" >> maybe(name) / "/"),
1105 nonemptyList("expected COMMON block objects"_err_en_US,
1106 Parser<CommonBlockObject>{}),
1107 many(maybe(","_tok) >>
1108 construct<CommonStmt::Block>("/" >> maybe(name) / "/",
1109 nonemptyList("expected COMMON block objects"_err_en_US,
1110 Parser<CommonBlockObject>{})))))
1111
1112// R874 common-block-object -> variable-name [( array-spec )]
1113TYPE_PARSER(construct<CommonBlockObject>(name, maybe(arraySpec)))
1114
1115// R901 designator -> object-name | array-element | array-section |
1116// coindexed-named-object | complex-part-designator |
1117// structure-component | substring
1118// The Standard's productions for designator and its alternatives are
1119// ambiguous without recourse to a symbol table. Many of the alternatives
1120// for designator (viz., array-element, coindexed-named-object,
1121// and structure-component) are all syntactically just data-ref.
1122// What designator boils down to is this:
1123// It starts with either a name or a character literal.
1124// If it starts with a character literal, it must be a substring.
1125// If it starts with a name, it's a sequence of %-separated parts;
1126// each part is a name, maybe a (section-subscript-list), and
1127// maybe an [image-selector].
1128// If it's a substring, it ends with (substring-range).
1129TYPE_CONTEXT_PARSER("designator"_en_US,
1130 sourced(construct<Designator>(substring) || construct<Designator>(dataRef)))
1131
1132constexpr auto percentOrDot{"%"_tok ||
1133 // legacy VAX extension for RECORD field access
1134 extension<LanguageFeature::DECStructures>(
1135 "nonstandard usage: component access with '.' in place of '%'"_port_en_US,
1136 "."_tok / lookAhead(OldStructureComponentName{}))};
1137
1138// R902 variable -> designator | function-reference
1139// This production appears to be left-recursive in the grammar via
1140// function-reference -> procedure-designator -> proc-component-ref ->
1141// scalar-variable
1142// and would be so if we were to allow functions to be called via procedure
1143// pointer components within derived type results of other function references
1144// (a reasonable extension, esp. in the case of procedure pointer components
1145// that are NOPASS). However, Fortran constrains the use of a variable in a
1146// proc-component-ref to be a data-ref without coindices (C1027).
1147// Some array element references will be misrecognized as function references.
1148constexpr auto noMoreAddressing{!"("_tok >> !"["_tok >> !percentOrDot};
1149TYPE_CONTEXT_PARSER("variable"_en_US,
1150 construct<Variable>(indirect(functionReference / noMoreAddressing)) ||
1151 construct<Variable>(indirect(designator)))
1152
1153// R908 substring -> parent-string ( substring-range )
1154// R909 parent-string ->
1155// scalar-variable-name | array-element | coindexed-named-object |
1156// scalar-structure-component | scalar-char-literal-constant |
1157// scalar-named-constant
1158TYPE_PARSER(
1159 construct<Substring>(dataRef, parenthesized(Parser<SubstringRange>{})))
1160
1161TYPE_PARSER(construct<CharLiteralConstantSubstring>(
1162 charLiteralConstant, parenthesized(Parser<SubstringRange>{})))
1163
1164TYPE_PARSER(sourced(construct<SubstringInquiry>(Parser<Substring>{}) /
1165 ("%LEN"_tok || "%KIND"_tok)))
1166
1167// R910 substring-range -> [scalar-int-expr] : [scalar-int-expr]
1168TYPE_PARSER(construct<SubstringRange>(
1169 maybe(scalarIntExpr), ":" >> maybe(scalarIntExpr)))
1170
1171// R911 data-ref -> part-ref [% part-ref]...
1172// R914 coindexed-named-object -> data-ref
1173// R917 array-element -> data-ref
1174TYPE_PARSER(
1175 construct<DataRef>(nonemptySeparated(Parser<PartRef>{}, percentOrDot)))
1176
1177// R912 part-ref -> part-name [( section-subscript-list )] [image-selector]
1178TYPE_PARSER(construct<PartRef>(name,
1179 defaulted(
1180 parenthesized(nonemptyList(Parser<SectionSubscript>{})) / !"=>"_tok),
1181 maybe(Parser<ImageSelector>{})))
1182
1183// R913 structure-component -> data-ref
1184// The final part-ref in the data-ref is not allowed to have subscripts.
1185TYPE_CONTEXT_PARSER("component"_en_US,
1186 construct<StructureComponent>(
1187 construct<DataRef>(some(Parser<PartRef>{} / percentOrDot)), name))
1188
1189// R919 subscript -> scalar-int-expr
1190constexpr auto subscript{scalarIntExpr};
1191
1192// R920 section-subscript -> subscript | subscript-triplet | vector-subscript
1193// R923 vector-subscript -> int-expr
1194// N.B. The distinction that needs to be made between "subscript" and
1195// "vector-subscript" is deferred to semantic analysis.
1196TYPE_PARSER(construct<SectionSubscript>(Parser<SubscriptTriplet>{}) ||
1197 construct<SectionSubscript>(intExpr))
1198
1199// R921 subscript-triplet -> [subscript] : [subscript] [: stride]
1200TYPE_PARSER(construct<SubscriptTriplet>(
1201 maybe(subscript), ":" >> maybe(subscript), maybe(":" >> subscript)))
1202
1203// R925 cosubscript -> scalar-int-expr
1204constexpr auto cosubscript{scalarIntExpr};
1205
1206// R924 image-selector ->
1207// lbracket cosubscript-list [, image-selector-spec-list] rbracket
1208TYPE_CONTEXT_PARSER("image selector"_en_US,
1209 construct<ImageSelector>(
1210 "[" >> nonemptyList(cosubscript / lookAhead(space / ",]"_ch)),
1211 defaulted("," >> nonemptyList(Parser<ImageSelectorSpec>{})) / "]"))
1212
1213// R926 image-selector-spec ->
1214// STAT = stat-variable | TEAM = team-value |
1215// TEAM_NUMBER = scalar-int-expr
1216TYPE_PARSER(construct<ImageSelectorSpec>(construct<ImageSelectorSpec::Stat>(
1217 "STAT =" >> scalar(integer(indirect(variable))))) ||
1218 construct<ImageSelectorSpec>(construct<TeamValue>("TEAM =" >> teamValue)) ||
1219 construct<ImageSelectorSpec>(construct<ImageSelectorSpec::Team_Number>(
1220 "TEAM_NUMBER =" >> scalarIntExpr)))
1221
1222// R927 allocate-stmt ->
1223// ALLOCATE ( [type-spec ::] allocation-list [, alloc-opt-list] )
1224TYPE_CONTEXT_PARSER("ALLOCATE statement"_en_US,
1225 construct<AllocateStmt>("ALLOCATE (" >> maybe(typeSpec / "::"),
1226 nonemptyList(Parser<Allocation>{}),
1227 defaulted("," >> nonemptyList(Parser<AllocOpt>{})) / ")"))
1228
1229// R928 alloc-opt ->
1230// ERRMSG = errmsg-variable | MOLD = source-expr |
1231// SOURCE = source-expr | STAT = stat-variable |
1232// (CUDA) STREAM = scalar-int-expr
1233// PINNED = scalar-logical-variable
1234// R931 source-expr -> expr
1235TYPE_PARSER(construct<AllocOpt>(
1236 construct<AllocOpt::Mold>("MOLD =" >> indirect(expr))) ||
1237 construct<AllocOpt>(
1238 construct<AllocOpt::Source>("SOURCE =" >> indirect(expr))) ||
1239 construct<AllocOpt>(statOrErrmsg) ||
1240 extension<LanguageFeature::CUDA>(
1241 construct<AllocOpt>(construct<AllocOpt::Stream>(
1242 "STREAM =" >> indirect(scalarIntExpr))) ||
1243 construct<AllocOpt>(construct<AllocOpt::Pinned>(
1244 "PINNED =" >> indirect(scalarLogicalVariable)))))
1245
1246// R929 stat-variable -> scalar-int-variable
1247TYPE_PARSER(construct<StatVariable>(scalar(integer(variable))))
1248
1249// R932 allocation ->
1250// allocate-object [( allocate-shape-spec-list )]
1251// [lbracket allocate-coarray-spec rbracket]
1252TYPE_PARSER(construct<Allocation>(Parser<AllocateObject>{},
1253 defaulted(parenthesized(nonemptyList(Parser<AllocateShapeSpec>{}))),
1254 maybe(bracketed(Parser<AllocateCoarraySpec>{}))))
1255
1256// R933 allocate-object -> variable-name | structure-component
1257TYPE_PARSER(construct<AllocateObject>(structureComponent) ||
1258 construct<AllocateObject>(name / !"="_tok))
1259
1260// R934 allocate-shape-spec -> [lower-bound-expr :] upper-bound-expr
1261// R938 allocate-coshape-spec -> [lower-bound-expr :] upper-bound-expr
1262TYPE_PARSER(construct<AllocateShapeSpec>(maybe(boundExpr / ":"), boundExpr))
1263
1264// R937 allocate-coarray-spec ->
1265// [allocate-coshape-spec-list ,] [lower-bound-expr :] *
1266TYPE_PARSER(construct<AllocateCoarraySpec>(
1267 defaulted(nonemptyList(Parser<AllocateShapeSpec>{}) / ","),
1268 maybe(boundExpr / ":") / "*"))
1269
1270// R939 nullify-stmt -> NULLIFY ( pointer-object-list )
1271TYPE_CONTEXT_PARSER("NULLIFY statement"_en_US,
1272 "NULLIFY" >> parenthesized(construct<NullifyStmt>(
1273 nonemptyList(Parser<PointerObject>{}))))
1274
1275// R940 pointer-object ->
1276// variable-name | structure-component | proc-pointer-name
1277TYPE_PARSER(construct<PointerObject>(structureComponent) ||
1278 construct<PointerObject>(name))
1279
1280// R941 deallocate-stmt ->
1281// DEALLOCATE ( allocate-object-list [, dealloc-opt-list] )
1282TYPE_CONTEXT_PARSER("DEALLOCATE statement"_en_US,
1283 construct<DeallocateStmt>(
1284 "DEALLOCATE (" >> nonemptyList(Parser<AllocateObject>{}),
1285 defaulted("," >> nonemptyList(statOrErrmsg)) / ")"))
1286
1287// R942 dealloc-opt -> STAT = stat-variable | ERRMSG = errmsg-variable
1288// R1165 sync-stat -> STAT = stat-variable | ERRMSG = errmsg-variable
1289TYPE_PARSER(construct<StatOrErrmsg>("STAT =" >> statVariable) ||
1290 construct<StatOrErrmsg>("ERRMSG =" >> msgVariable))
1291
1292// Directives, extensions, and deprecated statements
1293// !DIR$ IGNORE_TKR [ [(tkrdmac...)] name ]...
1294// !DIR$ LOOP COUNT (n1[, n2]...)
1295// !DIR$ name[=value] [, name[=value]]...
1296// !DIR$ UNROLL [n]
1297// !DIR$ <anything else>
1298constexpr auto ignore_tkr{
1299 "IGNORE_TKR" >> optionalList(construct<CompilerDirective::IgnoreTKR>(
1300 maybe(parenthesized(many(letter))), name))};
1301constexpr auto loopCount{
1302 "LOOP COUNT" >> construct<CompilerDirective::LoopCount>(
1303 parenthesized(nonemptyList(digitString64)))};
1304constexpr auto assumeAligned{"ASSUME_ALIGNED" >>
1305 optionalList(construct<CompilerDirective::AssumeAligned>(
1306 indirect(designator), ":"_tok >> digitString64))};
1307constexpr auto vectorAlways{
1308 "VECTOR ALWAYS" >> construct<CompilerDirective::VectorAlways>()};
1309constexpr auto unroll{
1310 "UNROLL" >> construct<CompilerDirective::Unroll>(maybe(digitString64))};
1311constexpr auto unrollAndJam{"UNROLL_AND_JAM" >>
1312 construct<CompilerDirective::UnrollAndJam>(maybe(digitString64))};
1313constexpr auto novector{"NOVECTOR" >> construct<CompilerDirective::NoVector>()};
1314constexpr auto nounroll{"NOUNROLL" >> construct<CompilerDirective::NoUnroll>()};
1315constexpr auto nounrollAndJam{
1316 "NOUNROLL_AND_JAM" >> construct<CompilerDirective::NoUnrollAndJam>()};
1317TYPE_PARSER(beginDirective >> "DIR$ "_tok >>
1318 sourced((construct<CompilerDirective>(ignore_tkr) ||
1319 construct<CompilerDirective>(loopCount) ||
1320 construct<CompilerDirective>(assumeAligned) ||
1321 construct<CompilerDirective>(vectorAlways) ||
1322 construct<CompilerDirective>(unrollAndJam) ||
1323 construct<CompilerDirective>(unroll) ||
1324 construct<CompilerDirective>(novector) ||
1325 construct<CompilerDirective>(nounrollAndJam) ||
1326 construct<CompilerDirective>(nounroll) ||
1327 construct<CompilerDirective>(
1328 many(construct<CompilerDirective::NameValue>(
1329 name, maybe(("="_tok || ":"_tok) >> digitString64))))) /
1330 endOfStmt ||
1331 construct<CompilerDirective>(pure<CompilerDirective::Unrecognized>()) /
1332 SkipTo<'\n'>{}))
1333
1334TYPE_PARSER(extension<LanguageFeature::CrayPointer>(
1335 "nonstandard usage: based POINTER"_port_en_US,
1336 construct<BasedPointerStmt>(
1337 "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US,
1338 construct<BasedPointer>("(" >> objectName / ",",
1339 objectName, maybe(Parser<ArraySpec>{}) / ")")))))
1340
1341// CUDA-attributes-stmt -> ATTRIBUTES (CUDA-data-attr) [::] name-list
1342TYPE_PARSER(extension<LanguageFeature::CUDA>(construct<CUDAAttributesStmt>(
1343 "ATTRIBUTES" >> parenthesized(Parser<common::CUDADataAttr>{}),
1344 defaulted(
1345 maybe("::"_tok) >> nonemptyList("expected names"_err_en_US, name)))))
1346
1347// Subtle: A structure's name includes the surrounding slashes, which avoids
1348// clashes with other uses of the name in the same scope.
1349constexpr auto structureName{maybe(sourced("/" >> name / "/"))};
1350
1351// Note that Parser<StructureStmt>{} has a mandatory list of entity-decls
1352// and is used only by NestedStructureStmt{}.Parse() in user-state.cpp.
1353TYPE_PARSER(construct<StructureStmt>("STRUCTURE" >> structureName,
1354 localRecovery(
1355 "entity declarations are required on a nested structure"_err_en_US,
1356 nonemptyList(entityDecl), ok)))
1357
1358constexpr auto nestedStructureDef{
1359 CONTEXT_PARSER("nested STRUCTURE definition"_en_US,
1360 construct<StructureDef>(statement(NestedStructureStmt{}),
1361 many(Parser<StructureField>{}),
1362 statement(construct<StructureDef::EndStructureStmt>(
1363 "END STRUCTURE"_tok))))};
1364
1365TYPE_PARSER(construct<StructureField>(statement(StructureComponents{})) ||
1366 construct<StructureField>(indirect(Parser<Union>{})) ||
1367 construct<StructureField>(indirect(nestedStructureDef)))
1368
1369TYPE_CONTEXT_PARSER("STRUCTURE definition"_en_US,
1370 extension<LanguageFeature::DECStructures>(
1371 "nonstandard usage: STRUCTURE"_port_en_US,
1372 construct<StructureDef>(
1373 statement(construct<StructureStmt>(
1374 "STRUCTURE" >> structureName, optionalList(entityDecl))),
1375 many(Parser<StructureField>{}),
1376 statement(construct<StructureDef::EndStructureStmt>(
1377 "END STRUCTURE"_tok)))))
1378
1379TYPE_CONTEXT_PARSER("UNION definition"_en_US,
1380 construct<Union>(statement(construct<Union::UnionStmt>("UNION"_tok)),
1381 many(Parser<Map>{}),
1382 statement(construct<Union::EndUnionStmt>("END UNION"_tok))))
1383
1384TYPE_CONTEXT_PARSER("MAP definition"_en_US,
1385 construct<Map>(statement(construct<Map::MapStmt>("MAP"_tok)),
1386 many(Parser<StructureField>{}),
1387 statement(construct<Map::EndMapStmt>("END MAP"_tok))))
1388
1389TYPE_CONTEXT_PARSER("arithmetic IF statement"_en_US,
1390 deprecated<LanguageFeature::ArithmeticIF>(construct<ArithmeticIfStmt>(
1391 "IF" >> parenthesized(expr), label / ",", label / ",", label)))
1392
1393TYPE_CONTEXT_PARSER("ASSIGN statement"_en_US,
1394 deprecated<LanguageFeature::Assign>(
1395 construct<AssignStmt>("ASSIGN" >> label, "TO" >> name)))
1396
1397TYPE_CONTEXT_PARSER("assigned GOTO statement"_en_US,
1398 deprecated<LanguageFeature::AssignedGOTO>(construct<AssignedGotoStmt>(
1399 "GO TO" >> name,
1400 defaulted(maybe(","_tok) >>
1401 parenthesized(nonemptyList("expected labels"_err_en_US, label))))))
1402
1403TYPE_CONTEXT_PARSER("PAUSE statement"_en_US,
1404 deprecated<LanguageFeature::Pause>(
1405 construct<PauseStmt>("PAUSE" >> maybe(Parser<StopCode>{}))))
1406
1407// These requirement productions are defined by the Fortran standard but never
1408// used directly by the grammar:
1409// R620 delimiter -> ( | ) | / | [ | ] | (/ | /)
1410// R1027 numeric-expr -> expr
1411// R1031 int-constant-expr -> int-expr
1412// R1221 dtv-type-spec -> TYPE ( derived-type-spec ) |
1413// CLASS ( derived-type-spec )
1414//
1415// These requirement productions are defined and used, but need not be
1416// defined independently here in this file:
1417// R771 lbracket -> [
1418// R772 rbracket -> ]
1419//
1420// Further note that:
1421// R607 int-constant -> constant
1422// is used only once via R844 scalar-int-constant
1423// R904 logical-variable -> variable
1424// is used only via scalar-logical-variable
1425// R906 default-char-variable -> variable
1426// is used only via scalar-default-char-variable
1427// R907 int-variable -> variable
1428// is used only via scalar-int-variable
1429// R915 complex-part-designator -> designator % RE | designator % IM
1430// %RE and %IM are initially recognized as structure components
1431// R916 type-param-inquiry -> designator % type-param-name
1432// is occulted by structure component designators
1433// R918 array-section ->
1434// data-ref [( substring-range )] | complex-part-designator
1435// is not used because parsing is not sensitive to rank
1436// R1030 default-char-constant-expr -> default-char-expr
1437// is only used via scalar-default-char-constant-expr
1438} // namespace Fortran::parser
1439

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