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