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