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

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