1 // Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved.
2 //
3 // Licensed under the Apache License, Version 2.0 (the "License");
4 // you may not use this file except in compliance with the License.
5 // You may obtain a copy of the License at
6 //
7 // http://www.apache.org/licenses/LICENSE-2.0
8 //
9 // Unless required by applicable law or agreed to in writing, software
10 // distributed under the License is distributed on an "AS IS" BASIS,
11 // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 // See the License for the specific language governing permissions and
13 // limitations under the License.
14
15 #ifndef FORTRAN_PARSER_PARSE_TREE_H_
16 #define FORTRAN_PARSER_PARSE_TREE_H_
17
18 // Defines the classes used to represent successful reductions of productions
19 // in the Fortran grammar. The names and content of these definitions
20 // adhere closely to the syntax specifications in the language standard (q.v.)
21 // that are transcribed here and referenced via their requirement numbers.
22 // The representations of some productions that may also be of use in the
23 // run-time I/O support library have been isolated into a distinct header file
24 // (viz., format-specification.h).
25
26 #include "char-block.h"
27 #include "characters.h"
28 #include "format-specification.h"
29 #include "message.h"
30 #include "provenance.h"
31 #include "../common/Fortran.h"
32 #include "../common/idioms.h"
33 #include "../common/indirection.h"
34 #include <cinttypes>
35 #include <list>
36 #include <memory>
37 #include <optional>
38 #include <string>
39 #include <tuple>
40 #include <type_traits>
41 #include <utility>
42 #include <variant>
43
44 // Parse tree node class types do not have default constructors. They
45 // explicitly declare "T() {} = delete;" to make this clear. This restriction
46 // prevents the introduction of what would be a viral requirement to include
47 // std::monostate among most std::variant<> discriminated union members.
48
49 // Parse tree node class types do not have copy constructors or copy assignment
50 // operators. They are explicitly declared "= delete;" to make this clear,
51 // although a C++ compiler wouldn't default them anyway due to the presence
52 // of explicitly defaulted move constructors and move assignments.
53
54 CLASS_TRAIT(EmptyTrait)
CLASS_TRAIT(WrapperTrait)55 CLASS_TRAIT(WrapperTrait)
56 CLASS_TRAIT(UnionTrait)
57 CLASS_TRAIT(TupleTrait)
58 CLASS_TRAIT(ConstraintTrait)
59
60 // Some parse tree nodes have fields in them to cache the results of a
61 // successful semantic analysis later. Their types are forward declared
62 // here.
63 namespace Fortran::semantics {
64 class Symbol;
65 class DeclTypeSpec;
66 class DerivedTypeSpec;
67 }
68
69 // Expressions in the parse tree have owning pointers that can be set to
70 // type-checked generic expression representations by semantic analysis.
71 namespace Fortran::evaluate {
72 struct GenericExprWrapper; // forward definition, wraps Expr<SomeType>
73 }
74
75 // Most non-template classes in this file use these default definitions
76 // for their move constructor and move assignment operator=, and disable
77 // their copy constructor and copy assignment operator=.
78 #define COPY_AND_ASSIGN_BOILERPLATE(classname) \
79 classname(classname &&) = default; \
80 classname &operator=(classname &&) = default; \
81 classname(const classname &) = delete; \
82 classname &operator=(const classname &) = delete
83
84 // Almost all classes in this file have no default constructor.
85 #define BOILERPLATE(classname) \
86 COPY_AND_ASSIGN_BOILERPLATE(classname); \
87 classname() = delete
88
89 // Empty classes are often used below as alternatives in std::variant<>
90 // discriminated unions.
91 #define EMPTY_CLASS(classname) \
92 struct classname { \
93 classname() {} \
94 classname(const classname &) {} \
95 classname(classname &&) {} \
96 classname &operator=(const classname &) { return *this; }; \
97 classname &operator=(classname &&) { return *this; }; \
98 using EmptyTrait = std::true_type; \
99 }
100
101 // Many classes below simply wrap a std::variant<> discriminated union,
102 // which is conventionally named "u".
103 #define UNION_CLASS_BOILERPLATE(classname) \
104 template<typename A, typename = common::NoLvalue<A>> \
105 classname(A &&x) : u(std::move(x)) {} \
106 using UnionTrait = std::true_type; \
107 BOILERPLATE(classname)
108
109 // Many other classes below simply wrap a std::tuple<> structure, which
110 // is conventionally named "t".
111 #define TUPLE_CLASS_BOILERPLATE(classname) \
112 template<typename... Ts, typename = common::NoLvalue<Ts...>> \
113 classname(Ts &&... args) : t(std::move(args)...) {} \
114 using TupleTrait = std::true_type; \
115 BOILERPLATE(classname)
116
117 // Many other classes below simply wrap a single data member, which is
118 // conventionally named "v".
119 #define WRAPPER_CLASS_BOILERPLATE(classname, type) \
120 BOILERPLATE(classname); \
121 classname(type &&x) : v(std::move(x)) {} \
122 using WrapperTrait = std::true_type; \
123 type v
124
125 #define WRAPPER_CLASS(classname, type) \
126 struct classname { \
127 WRAPPER_CLASS_BOILERPLATE(classname, type); \
128 }
129
130 namespace Fortran::parser {
131
132 // These are the unavoidable recursively-defined productions of Fortran.
133 // Some references to the representations of their parses require
134 // indirection. The Indirect<> pointer wrapper class is used to
135 // enforce ownership semantics and non-nullability.
136 struct SpecificationPart; // R504
137 struct ExecutableConstruct; // R514
138 struct ActionStmt; // R515
139 struct AcImpliedDo; // R774
140 struct DataImpliedDo; // R840
141 struct Designator; // R901
142 struct Variable; // R902
143 struct Expr; // R1001
144 struct WhereConstruct; // R1042
145 struct ForallConstruct; // R1050
146 struct InputImpliedDo; // R1218
147 struct OutputImpliedDo; // R1218
148 struct FunctionReference; // R1520
149 struct FunctionSubprogram; // R1529
150 struct SubroutineSubprogram; // R1534
151
152 // These additional forward references are declared so that the order of
153 // class definitions in this header file can remain reasonably consistent
154 // with order of the the requirement productions in the grammar.
155 struct DerivedTypeDef; // R726
156 struct EnumDef; // R759
157 struct TypeDeclarationStmt; // R801
158 struct AccessStmt; // R827
159 struct AllocatableStmt; // R829
160 struct AsynchronousStmt; // R831
161 struct BindStmt; // R832
162 struct CodimensionStmt; // R834
163 struct ContiguousStmt; // R836
164 struct DataStmt; // R837
165 struct DataStmtValue; // R843
166 struct DimensionStmt; // R848
167 struct IntentStmt; // R849
168 struct OptionalStmt; // R850
169 struct ParameterStmt; // R851
170 struct OldParameterStmt;
171 struct PointerStmt; // R853
172 struct ProtectedStmt; // R855
173 struct SaveStmt; // R856
174 struct TargetStmt; // R859
175 struct ValueStmt; // R861
176 struct VolatileStmt; // R862
177 struct ImplicitStmt; // R863
178 struct ImportStmt; // R867
179 struct NamelistStmt; // R868
180 struct EquivalenceStmt; // R870
181 struct CommonStmt; // R873
182 struct Substring; // R908
183 struct CharLiteralConstantSubstring;
184 struct DataRef; // R911
185 struct StructureComponent; // R913
186 struct CoindexedNamedObject; // R914
187 struct ArrayElement; // R917
188 struct AllocateStmt; // R927
189 struct NullifyStmt; // R939
190 struct DeallocateStmt; // R941
191 struct AssignmentStmt; // R1032
192 struct PointerAssignmentStmt; // R1033
193 struct WhereStmt; // R1041, R1045, R1046
194 struct ForallStmt; // R1055
195 struct AssociateConstruct; // R1102
196 struct BlockConstruct; // R1107
197 struct ChangeTeamConstruct; // R1111
198 struct CriticalConstruct; // R1116
199 struct DoConstruct; // R1119
200 struct LabelDoStmt; // R1121
201 struct ConcurrentHeader; // R1125
202 struct EndDoStmt; // R1132
203 struct CycleStmt; // R1133
204 struct IfConstruct; // R1134
205 struct IfStmt; // R1139
206 struct CaseConstruct; // R1140
207 struct SelectRankConstruct; // R1148
208 struct SelectTypeConstruct; // R1152
209 struct ExitStmt; // R1156
210 struct GotoStmt; // R1157
211 struct ComputedGotoStmt; // R1158
212 struct StopStmt; // R1160, R1161
213 struct SyncAllStmt; // R1164
214 struct SyncImagesStmt; // R1166
215 struct SyncMemoryStmt; // R1168
216 struct SyncTeamStmt; // R1169
217 struct EventPostStmt; // R1170, R1171
218 struct EventWaitStmt; // R1172, R1173, R1174
219 struct FormTeamStmt; // R1175, R1176, R1177
220 struct LockStmt; // R1178
221 struct UnlockStmt; // R1180
222 struct OpenStmt; // R1204
223 struct CloseStmt; // R1208
224 struct ReadStmt; // R1210
225 struct WriteStmt; // R1211
226 struct PrintStmt; // R1212
227 struct WaitStmt; // R1222
228 struct BackspaceStmt; // R1224
229 struct EndfileStmt; // R1225
230 struct RewindStmt; // R1226
231 struct FlushStmt; // R1228
232 struct InquireStmt; // R1230
233 struct FormatStmt; // R1301
234 struct MainProgram; // R1401
235 struct Module; // R1404
236 struct UseStmt; // R1409
237 struct Submodule; // R1416
238 struct BlockData; // R1420
239 struct InterfaceBlock; // R1501
240 struct GenericSpec; // R1508
241 struct GenericStmt; // R1510
242 struct ExternalStmt; // R1511
243 struct ProcedureDeclarationStmt; // R1512
244 struct IntrinsicStmt; // R1519
245 struct Call; // R1520 & R1521
246 struct CallStmt; // R1521
247 struct ProcedureDesignator; // R1522
248 struct ActualArg; // R1524
249 struct SeparateModuleSubprogram; // R1538
250 struct EntryStmt; // R1541
251 struct ReturnStmt; // R1542
252 struct StmtFunctionStmt; // R1544
253
254 // Directives, extensions, and deprecated statements
255 struct CompilerDirective;
256 struct BasedPointerStmt;
257 struct StructureDef;
258 struct ArithmeticIfStmt;
259 struct AssignStmt;
260 struct AssignedGotoStmt;
261 struct PauseStmt;
262 struct OpenMPConstruct;
263 struct OpenMPDeclarativeConstruct;
264 struct OmpEndLoopDirective;
265
266 // Cooked character stream locations
267 using Location = const char *;
268
269 // A parse tree node with provenance only
270 struct Verbatim {
271 BOILERPLATE(Verbatim);
272 using EmptyTrait = std::true_type;
273 CharBlock source;
274 };
275
276 // Implicit definitions of the Standard
277
278 // R403 scalar-xyz -> xyz
279 // These template class wrappers correspond to the Standard's modifiers
280 // scalar-xyz, constant-xzy, int-xzy, default-char-xyz, & logical-xyz.
281 template<typename A> struct Scalar {
282 using ConstraintTrait = std::true_type;
283 Scalar(Scalar &&that) = default;
ScalarScalar284 Scalar(A &&that) : thing(std::move(that)) {}
285 Scalar &operator=(Scalar &&) = default;
286 A thing;
287 };
288
289 template<typename A> struct Constant {
290 using ConstraintTrait = std::true_type;
291 Constant(Constant &&that) = default;
ConstantConstant292 Constant(A &&that) : thing(std::move(that)) {}
293 Constant &operator=(Constant &&) = default;
294 A thing;
295 };
296
297 template<typename A> struct Integer {
298 using ConstraintTrait = std::true_type;
299 Integer(Integer &&that) = default;
IntegerInteger300 Integer(A &&that) : thing(std::move(that)) {}
301 Integer &operator=(Integer &&) = default;
302 A thing;
303 };
304
305 template<typename A> struct Logical {
306 using ConstraintTrait = std::true_type;
307 Logical(Logical &&that) = default;
LogicalLogical308 Logical(A &&that) : thing(std::move(that)) {}
309 Logical &operator=(Logical &&) = default;
310 A thing;
311 };
312
313 template<typename A> struct DefaultChar {
314 using ConstraintTrait = std::true_type;
315 DefaultChar(DefaultChar &&that) = default;
DefaultCharDefaultChar316 DefaultChar(A &&that) : thing(std::move(that)) {}
317 DefaultChar &operator=(DefaultChar &&) = default;
318 A thing;
319 };
320
321 using LogicalExpr = Logical<common::Indirection<Expr>>; // R1024
322 using DefaultCharExpr = DefaultChar<common::Indirection<Expr>>; // R1025
323 using IntExpr = Integer<common::Indirection<Expr>>; // R1026
324 using ConstantExpr = Constant<common::Indirection<Expr>>; // R1029
325 using IntConstantExpr = Integer<ConstantExpr>; // R1031
326 using ScalarLogicalExpr = Scalar<LogicalExpr>;
327 using ScalarIntExpr = Scalar<IntExpr>;
328 using ScalarIntConstantExpr = Scalar<IntConstantExpr>;
329 using ScalarDefaultCharExpr = Scalar<DefaultCharExpr>;
330 // R1030 default-char-constant-expr is used in the Standard only as part of
331 // scalar-default-char-constant-expr.
332 using ScalarDefaultCharConstantExpr = Scalar<DefaultChar<ConstantExpr>>;
333
334 // R611 label -> digit [digit]...
335 using Label = std::uint64_t; // validated later, must be in [1..99999]
336
337 // A wrapper for xzy-stmt productions that are statements, so that
338 // source provenances and labels have a uniform representation.
339 template<typename A> struct UnlabeledStatement {
UnlabeledStatementUnlabeledStatement340 explicit UnlabeledStatement(A &&s) : statement(std::move(s)) {}
341 CharBlock source;
342 A statement;
343 };
344 template<typename A> struct Statement : public UnlabeledStatement<A> {
StatementStatement345 Statement(std::optional<long> &&lab, A &&s)
346 : UnlabeledStatement<A>{std::move(s)}, label(std::move(lab)) {}
347 std::optional<Label> label;
348 };
349
350 // Error recovery marker
351 EMPTY_CLASS(ErrorRecovery);
352
353 // R513 other-specification-stmt ->
354 // access-stmt | allocatable-stmt | asynchronous-stmt | bind-stmt |
355 // codimension-stmt | contiguous-stmt | dimension-stmt | external-stmt |
356 // intent-stmt | intrinsic-stmt | namelist-stmt | optional-stmt |
357 // pointer-stmt | protected-stmt | save-stmt | target-stmt |
358 // volatile-stmt | value-stmt | common-stmt | equivalence-stmt
359 // Extension: (Cray) based POINTER statement
360 struct OtherSpecificationStmt {
361 UNION_CLASS_BOILERPLATE(OtherSpecificationStmt);
362 std::variant<common::Indirection<AccessStmt>,
363 common::Indirection<AllocatableStmt>,
364 common::Indirection<AsynchronousStmt>, common::Indirection<BindStmt>,
365 common::Indirection<CodimensionStmt>, common::Indirection<ContiguousStmt>,
366 common::Indirection<DimensionStmt>, common::Indirection<ExternalStmt>,
367 common::Indirection<IntentStmt>, common::Indirection<IntrinsicStmt>,
368 common::Indirection<NamelistStmt>, common::Indirection<OptionalStmt>,
369 common::Indirection<PointerStmt>, common::Indirection<ProtectedStmt>,
370 common::Indirection<SaveStmt>, common::Indirection<TargetStmt>,
371 common::Indirection<ValueStmt>, common::Indirection<VolatileStmt>,
372 common::Indirection<CommonStmt>, common::Indirection<EquivalenceStmt>,
373 common::Indirection<BasedPointerStmt>>
374 u;
375 };
376
377 // R508 specification-construct ->
378 // derived-type-def | enum-def | generic-stmt | interface-block |
379 // parameter-stmt | procedure-declaration-stmt |
380 // other-specification-stmt | type-declaration-stmt
381 struct SpecificationConstruct {
382 UNION_CLASS_BOILERPLATE(SpecificationConstruct);
383 std::variant<common::Indirection<DerivedTypeDef>,
384 common::Indirection<EnumDef>, Statement<common::Indirection<GenericStmt>>,
385 common::Indirection<InterfaceBlock>,
386 Statement<common::Indirection<ParameterStmt>>,
387 Statement<common::Indirection<OldParameterStmt>>,
388 Statement<common::Indirection<ProcedureDeclarationStmt>>,
389 Statement<OtherSpecificationStmt>,
390 Statement<common::Indirection<TypeDeclarationStmt>>,
391 common::Indirection<StructureDef>,
392 common::Indirection<OpenMPDeclarativeConstruct>,
393 common::Indirection<CompilerDirective>>
394 u;
395 };
396
397 // R506 implicit-part-stmt ->
398 // implicit-stmt | parameter-stmt | format-stmt | entry-stmt
399 struct ImplicitPartStmt {
400 UNION_CLASS_BOILERPLATE(ImplicitPartStmt);
401 std::variant<Statement<common::Indirection<ImplicitStmt>>,
402 Statement<common::Indirection<ParameterStmt>>,
403 Statement<common::Indirection<OldParameterStmt>>,
404 Statement<common::Indirection<FormatStmt>>,
405 Statement<common::Indirection<EntryStmt>>>
406 u;
407 };
408
409 // R505 implicit-part -> [implicit-part-stmt]... implicit-stmt
410 WRAPPER_CLASS(ImplicitPart, std::list<ImplicitPartStmt>);
411
412 // R507 declaration-construct ->
413 // specification-construct | data-stmt | format-stmt |
414 // entry-stmt | stmt-function-stmt
415 struct DeclarationConstruct {
416 UNION_CLASS_BOILERPLATE(DeclarationConstruct);
417 std::variant<SpecificationConstruct, Statement<common::Indirection<DataStmt>>,
418 Statement<common::Indirection<FormatStmt>>,
419 Statement<common::Indirection<EntryStmt>>,
420 Statement<common::Indirection<StmtFunctionStmt>>, ErrorRecovery>
421 u;
422 };
423
424 // R504 specification-part -> [use-stmt]... [import-stmt]... [implicit-part]
425 // [declaration-construct]...
426 // TODO: transfer any statements after the last IMPLICIT (if any)
427 // from the implicit part to the declaration constructs
428 struct SpecificationPart {
429 TUPLE_CLASS_BOILERPLATE(SpecificationPart);
430 std::tuple<std::list<OpenMPDeclarativeConstruct>,
431 std::list<Statement<common::Indirection<UseStmt>>>,
432 std::list<Statement<common::Indirection<ImportStmt>>>, ImplicitPart,
433 std::list<DeclarationConstruct>>
434 t;
435 };
436
437 // R512 internal-subprogram -> function-subprogram | subroutine-subprogram
438 struct InternalSubprogram {
439 UNION_CLASS_BOILERPLATE(InternalSubprogram);
440 std::variant<common::Indirection<FunctionSubprogram>,
441 common::Indirection<SubroutineSubprogram>>
442 u;
443 };
444
445 // R1543 contains-stmt -> CONTAINS
446 EMPTY_CLASS(ContainsStmt);
447
448 // R511 internal-subprogram-part -> contains-stmt [internal-subprogram]...
449 struct InternalSubprogramPart {
450 TUPLE_CLASS_BOILERPLATE(InternalSubprogramPart);
451 std::tuple<Statement<ContainsStmt>, std::list<InternalSubprogram>> t;
452 };
453
454 // R1159 continue-stmt -> CONTINUE
455 EMPTY_CLASS(ContinueStmt);
456
457 // R1163 fail-image-stmt -> FAIL IMAGE
458 EMPTY_CLASS(FailImageStmt);
459
460 // R515 action-stmt ->
461 // allocate-stmt | assignment-stmt | backspace-stmt | call-stmt |
462 // close-stmt | continue-stmt | cycle-stmt | deallocate-stmt |
463 // endfile-stmt | error-stop-stmt | event-post-stmt | event-wait-stmt |
464 // exit-stmt | fail-image-stmt | flush-stmt | form-team-stmt |
465 // goto-stmt | if-stmt | inquire-stmt | lock-stmt | nullify-stmt |
466 // open-stmt | pointer-assignment-stmt | print-stmt | read-stmt |
467 // return-stmt | rewind-stmt | stop-stmt | sync-all-stmt |
468 // sync-images-stmt | sync-memory-stmt | sync-team-stmt | unlock-stmt |
469 // wait-stmt | where-stmt | write-stmt | computed-goto-stmt | forall-stmt
470 struct ActionStmt {
471 UNION_CLASS_BOILERPLATE(ActionStmt);
472 std::variant<common::Indirection<AllocateStmt>,
473 common::Indirection<AssignmentStmt>, common::Indirection<BackspaceStmt>,
474 common::Indirection<CallStmt>, common::Indirection<CloseStmt>,
475 ContinueStmt, common::Indirection<CycleStmt>,
476 common::Indirection<DeallocateStmt>, common::Indirection<EndfileStmt>,
477 common::Indirection<EventPostStmt>, common::Indirection<EventWaitStmt>,
478 common::Indirection<ExitStmt>, FailImageStmt,
479 common::Indirection<FlushStmt>, common::Indirection<FormTeamStmt>,
480 common::Indirection<GotoStmt>, common::Indirection<IfStmt>,
481 common::Indirection<InquireStmt>, common::Indirection<LockStmt>,
482 common::Indirection<NullifyStmt>, common::Indirection<OpenStmt>,
483 common::Indirection<PointerAssignmentStmt>,
484 common::Indirection<PrintStmt>, common::Indirection<ReadStmt>,
485 common::Indirection<ReturnStmt>, common::Indirection<RewindStmt>,
486 common::Indirection<StopStmt>, common::Indirection<SyncAllStmt>,
487 common::Indirection<SyncImagesStmt>, common::Indirection<SyncMemoryStmt>,
488 common::Indirection<SyncTeamStmt>, common::Indirection<UnlockStmt>,
489 common::Indirection<WaitStmt>, common::Indirection<WhereStmt>,
490 common::Indirection<WriteStmt>, common::Indirection<ComputedGotoStmt>,
491 common::Indirection<ForallStmt>, common::Indirection<ArithmeticIfStmt>,
492 common::Indirection<AssignStmt>, common::Indirection<AssignedGotoStmt>,
493 common::Indirection<PauseStmt>>
494 u;
495 };
496
497 // R514 executable-construct ->
498 // action-stmt | associate-construct | block-construct |
499 // case-construct | change-team-construct | critical-construct |
500 // do-construct | if-construct | select-rank-construct |
501 // select-type-construct | where-construct | forall-construct
502 struct ExecutableConstruct {
503 UNION_CLASS_BOILERPLATE(ExecutableConstruct);
504 std::variant<Statement<ActionStmt>, common::Indirection<AssociateConstruct>,
505 common::Indirection<BlockConstruct>, common::Indirection<CaseConstruct>,
506 common::Indirection<ChangeTeamConstruct>,
507 common::Indirection<CriticalConstruct>,
508 Statement<common::Indirection<LabelDoStmt>>,
509 Statement<common::Indirection<EndDoStmt>>,
510 common::Indirection<DoConstruct>, common::Indirection<IfConstruct>,
511 common::Indirection<SelectRankConstruct>,
512 common::Indirection<SelectTypeConstruct>,
513 common::Indirection<WhereConstruct>, common::Indirection<ForallConstruct>,
514 common::Indirection<CompilerDirective>,
515 common::Indirection<OpenMPConstruct>,
516 common::Indirection<OmpEndLoopDirective>>
517 u;
518 };
519
520 // R510 execution-part-construct ->
521 // executable-construct | format-stmt | entry-stmt | data-stmt
522 // Extension (PGI/Intel): also accept NAMELIST in execution part
523 struct ExecutionPartConstruct {
524 UNION_CLASS_BOILERPLATE(ExecutionPartConstruct);
525 std::variant<ExecutableConstruct, Statement<common::Indirection<FormatStmt>>,
526 Statement<common::Indirection<EntryStmt>>,
527 Statement<common::Indirection<DataStmt>>,
528 Statement<common::Indirection<NamelistStmt>>, ErrorRecovery>
529 u;
530 };
531
532 // R509 execution-part -> executable-construct [execution-part-construct]...
533 WRAPPER_CLASS(ExecutionPart, std::list<ExecutionPartConstruct>);
534
535 // R502 program-unit ->
536 // main-program | external-subprogram | module | submodule | block-data
537 // R503 external-subprogram -> function-subprogram | subroutine-subprogram
538 struct ProgramUnit {
539 UNION_CLASS_BOILERPLATE(ProgramUnit);
540 std::variant<common::Indirection<MainProgram>,
541 common::Indirection<FunctionSubprogram>,
542 common::Indirection<SubroutineSubprogram>, common::Indirection<Module>,
543 common::Indirection<Submodule>, common::Indirection<BlockData>>
544 u;
545 };
546
547 // R501 program -> program-unit [program-unit]...
548 // This is the top-level production.
549 WRAPPER_CLASS(Program, std::list<ProgramUnit>);
550
551 // R603 name -> letter [alphanumeric-character]...
552 struct Name {
ToStringName553 std::string ToString() const { return source.ToString(); }
554 CharBlock source;
555 mutable semantics::Symbol *symbol{nullptr}; // filled in during semantics
556 };
557
558 // R516 keyword -> name
559 WRAPPER_CLASS(Keyword, Name);
560
561 // R606 named-constant -> name
562 WRAPPER_CLASS(NamedConstant, Name);
563
564 // R1003 defined-unary-op -> . letter [letter]... .
565 // R1023 defined-binary-op -> . letter [letter]... .
566 // R1414 local-defined-operator -> defined-unary-op | defined-binary-op
567 // R1415 use-defined-operator -> defined-unary-op | defined-binary-op
568 // The Name here is stored with the dots; e.g., .FOO.
569 WRAPPER_CLASS(DefinedOpName, Name);
570
571 // R608 intrinsic-operator ->
572 // ** | * | / | + | - | // | .LT. | .LE. | .EQ. | .NE. | .GE. | .GT. |
573 // .NOT. | .AND. | .OR. | .EQV. | .NEQV.
574 // R609 defined-operator ->
575 // defined-unary-op | defined-binary-op | extended-intrinsic-op
576 // R610 extended-intrinsic-op -> intrinsic-operator
577 struct DefinedOperator {
578 UNION_CLASS_BOILERPLATE(DefinedOperator);
579 ENUM_CLASS(IntrinsicOperator, Power, Multiply, Divide, Add, Subtract, Concat,
580 LT, LE, EQ, NE, GE, GT, NOT, AND, OR, XOR, EQV, NEQV)
581 std::variant<DefinedOpName, IntrinsicOperator> u;
582 };
583
584 // R804 object-name -> name
585 using ObjectName = Name;
586
587 // R867 import-stmt ->
588 // IMPORT [[::] import-name-list] |
589 // IMPORT , ONLY : import-name-list | IMPORT , NONE | IMPORT , ALL
590 struct ImportStmt {
591 BOILERPLATE(ImportStmt);
ImportStmtImportStmt592 ImportStmt(common::ImportKind &&k) : kind{k} {}
ImportStmtImportStmt593 ImportStmt(std::list<Name> &&n) : names(std::move(n)) {}
594 ImportStmt(common::ImportKind &&, std::list<Name> &&);
595 common::ImportKind kind{common::ImportKind::Default};
596 std::list<Name> names;
597 };
598
599 // R868 namelist-stmt ->
600 // NAMELIST / namelist-group-name / namelist-group-object-list
601 // [[,] / namelist-group-name / namelist-group-object-list]...
602 // R869 namelist-group-object -> variable-name
603 struct NamelistStmt {
604 struct Group {
605 TUPLE_CLASS_BOILERPLATE(Group);
606 std::tuple<Name, std::list<Name>> t;
607 };
608 WRAPPER_CLASS_BOILERPLATE(NamelistStmt, std::list<Group>);
609 };
610
611 // R701 type-param-value -> scalar-int-expr | * | :
612 EMPTY_CLASS(Star);
613
614 struct TypeParamValue {
615 UNION_CLASS_BOILERPLATE(TypeParamValue);
616 EMPTY_CLASS(Deferred); // :
617 std::variant<ScalarIntExpr, Star, Deferred> u;
618 };
619
620 // R706 kind-selector -> ( [KIND =] scalar-int-constant-expr )
621 // Legacy extension: kind-selector -> * digit-string
622 // N.B. These are not semantically identical in the case of COMPLEX.
623 struct KindSelector {
624 UNION_CLASS_BOILERPLATE(KindSelector);
625 WRAPPER_CLASS(StarSize, std::uint64_t);
626 std::variant<ScalarIntConstantExpr, StarSize> u;
627 };
628
629 // R705 integer-type-spec -> INTEGER [kind-selector]
630 WRAPPER_CLASS(IntegerTypeSpec, std::optional<KindSelector>);
631
632 // R723 char-length -> ( type-param-value ) | digit-string
633 struct CharLength {
634 UNION_CLASS_BOILERPLATE(CharLength);
635 std::variant<TypeParamValue, std::uint64_t> u;
636 };
637
638 // R722 length-selector -> ( [LEN =] type-param-value ) | * char-length [,]
639 struct LengthSelector {
640 UNION_CLASS_BOILERPLATE(LengthSelector);
641 std::variant<TypeParamValue, CharLength> u;
642 };
643
644 // R721 char-selector ->
645 // length-selector |
646 // ( LEN = type-param-value , KIND = scalar-int-constant-expr ) |
647 // ( type-param-value , [KIND =] scalar-int-constant-expr ) |
648 // ( KIND = scalar-int-constant-expr [, LEN = type-param-value] )
649 struct CharSelector {
650 UNION_CLASS_BOILERPLATE(CharSelector);
651 struct LengthAndKind {
652 BOILERPLATE(LengthAndKind);
LengthAndKindCharSelector::LengthAndKind653 LengthAndKind(std::optional<TypeParamValue> &&l, ScalarIntConstantExpr &&k)
654 : length(std::move(l)), kind(std::move(k)) {}
655 std::optional<TypeParamValue> length;
656 ScalarIntConstantExpr kind;
657 };
CharSelectorCharSelector658 CharSelector(TypeParamValue &&l, ScalarIntConstantExpr &&k)
659 : u{LengthAndKind{std::make_optional(std::move(l)), std::move(k)}} {}
CharSelectorCharSelector660 CharSelector(ScalarIntConstantExpr &&k, std::optional<TypeParamValue> &&l)
661 : u{LengthAndKind{std::move(l), std::move(k)}} {}
662 std::variant<LengthSelector, LengthAndKind> u;
663 };
664
665 // R704 intrinsic-type-spec ->
666 // integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |
667 // COMPLEX [kind-selector] | CHARACTER [char-selector] |
668 // LOGICAL [kind-selector]
669 // Extensions: DOUBLE COMPLEX
670 struct IntrinsicTypeSpec {
671 UNION_CLASS_BOILERPLATE(IntrinsicTypeSpec);
672 struct Real {
673 BOILERPLATE(Real);
RealIntrinsicTypeSpec::Real674 Real(std::optional<KindSelector> &&k) : kind{std::move(k)} {}
675 std::optional<KindSelector> kind;
676 };
677 EMPTY_CLASS(DoublePrecision);
678 struct Complex {
679 BOILERPLATE(Complex);
ComplexIntrinsicTypeSpec::Complex680 Complex(std::optional<KindSelector> &&k) : kind{std::move(k)} {}
681 std::optional<KindSelector> kind;
682 };
683 struct Character {
684 BOILERPLATE(Character);
CharacterIntrinsicTypeSpec::Character685 Character(std::optional<CharSelector> &&s) : selector{std::move(s)} {}
686 std::optional<CharSelector> selector;
687 };
688 struct Logical {
689 BOILERPLATE(Logical);
LogicalIntrinsicTypeSpec::Logical690 Logical(std::optional<KindSelector> &&k) : kind{std::move(k)} {}
691 std::optional<KindSelector> kind;
692 };
693 EMPTY_CLASS(DoubleComplex);
694 std::variant<IntegerTypeSpec, Real, DoublePrecision, Complex, Character,
695 Logical, DoubleComplex>
696 u;
697 };
698
699 // R755 type-param-spec -> [keyword =] type-param-value
700 struct TypeParamSpec {
701 TUPLE_CLASS_BOILERPLATE(TypeParamSpec);
702 std::tuple<std::optional<Keyword>, TypeParamValue> t;
703 };
704
705 // R754 derived-type-spec -> type-name [(type-param-spec-list)]
706 struct DerivedTypeSpec {
707 TUPLE_CLASS_BOILERPLATE(DerivedTypeSpec);
708 mutable const semantics::DerivedTypeSpec *derivedTypeSpec{nullptr};
709 std::tuple<Name, std::list<TypeParamSpec>> t;
710 };
711
712 // R702 type-spec -> intrinsic-type-spec | derived-type-spec
713 struct TypeSpec {
714 UNION_CLASS_BOILERPLATE(TypeSpec);
715 mutable const semantics::DeclTypeSpec *declTypeSpec{nullptr};
716 std::variant<IntrinsicTypeSpec, DerivedTypeSpec> u;
717 };
718
719 // R703 declaration-type-spec ->
720 // intrinsic-type-spec | TYPE ( intrinsic-type-spec ) |
721 // TYPE ( derived-type-spec ) | CLASS ( derived-type-spec ) |
722 // CLASS ( * ) | TYPE ( * )
723 // Legacy extension: RECORD /struct/
724 struct DeclarationTypeSpec {
725 UNION_CLASS_BOILERPLATE(DeclarationTypeSpec);
726 struct Type {
727 BOILERPLATE(Type);
TypeDeclarationTypeSpec::Type728 Type(DerivedTypeSpec &&dt) : derived(std::move(dt)) {}
729 DerivedTypeSpec derived;
730 };
731 struct Class {
732 BOILERPLATE(Class);
ClassDeclarationTypeSpec::Class733 Class(DerivedTypeSpec &&dt) : derived(std::move(dt)) {}
734 DerivedTypeSpec derived;
735 };
736 EMPTY_CLASS(ClassStar);
737 EMPTY_CLASS(TypeStar);
738 WRAPPER_CLASS(Record, Name);
739 std::variant<IntrinsicTypeSpec, Type, Class, ClassStar, TypeStar, Record> u;
740 };
741
742 // R709 kind-param -> digit-string | scalar-int-constant-name
743 struct KindParam {
744 UNION_CLASS_BOILERPLATE(KindParam);
745 std::variant<std::uint64_t, Scalar<Integer<Constant<Name>>>> u;
746 };
747
748 // R707 signed-int-literal-constant -> [sign] int-literal-constant
749 struct SignedIntLiteralConstant {
750 TUPLE_CLASS_BOILERPLATE(SignedIntLiteralConstant);
751 CharBlock source;
752 std::tuple<CharBlock, std::optional<KindParam>> t;
753 };
754
755 // R708 int-literal-constant -> digit-string [_ kind-param]
756 struct IntLiteralConstant {
757 TUPLE_CLASS_BOILERPLATE(IntLiteralConstant);
758 std::tuple<CharBlock, std::optional<KindParam>> t;
759 };
760
761 // R712 sign -> + | -
762 enum class Sign { Positive, Negative };
763
764 // R714 real-literal-constant ->
765 // significand [exponent-letter exponent] [_ kind-param] |
766 // digit-string exponent-letter exponent [_ kind-param]
767 // R715 significand -> digit-string . [digit-string] | . digit-string
768 // R717 exponent -> signed-digit-string
769 struct RealLiteralConstant {
770 BOILERPLATE(RealLiteralConstant);
771 struct Real {
772 COPY_AND_ASSIGN_BOILERPLATE(Real);
RealRealLiteralConstant::Real773 Real() {}
774 CharBlock source;
775 };
RealLiteralConstantRealLiteralConstant776 RealLiteralConstant(Real &&r, std::optional<KindParam> &&k)
777 : real{std::move(r)}, kind{std::move(k)} {}
778 Real real;
779 std::optional<KindParam> kind;
780 };
781
782 // R713 signed-real-literal-constant -> [sign] real-literal-constant
783 struct SignedRealLiteralConstant {
784 TUPLE_CLASS_BOILERPLATE(SignedRealLiteralConstant);
785 std::tuple<std::optional<Sign>, RealLiteralConstant> t;
786 };
787
788 // R719 real-part ->
789 // signed-int-literal-constant | signed-real-literal-constant |
790 // named-constant
791 // R720 imag-part ->
792 // signed-int-literal-constant | signed-real-literal-constant |
793 // named-constant
794 struct ComplexPart {
795 UNION_CLASS_BOILERPLATE(ComplexPart);
796 std::variant<SignedIntLiteralConstant, SignedRealLiteralConstant,
797 NamedConstant>
798 u;
799 };
800
801 // R718 complex-literal-constant -> ( real-part , imag-part )
802 struct ComplexLiteralConstant {
803 TUPLE_CLASS_BOILERPLATE(ComplexLiteralConstant);
804 std::tuple<ComplexPart, ComplexPart> t; // real, imaginary
805 };
806
807 // Extension: signed COMPLEX constant
808 struct SignedComplexLiteralConstant {
809 TUPLE_CLASS_BOILERPLATE(SignedComplexLiteralConstant);
810 std::tuple<Sign, ComplexLiteralConstant> t;
811 };
812
813 // R724 char-literal-constant ->
814 // [kind-param _] ' [rep-char]... ' |
815 // [kind-param _] " [rep-char]... "
816 struct CharLiteralConstant {
817 TUPLE_CLASS_BOILERPLATE(CharLiteralConstant);
818 std::tuple<std::optional<KindParam>, std::string> t;
GetStringCharLiteralConstant819 std::string GetString() const { return std::get<std::string>(t); }
820 };
821
822 // legacy extension
823 struct HollerithLiteralConstant {
824 WRAPPER_CLASS_BOILERPLATE(HollerithLiteralConstant, std::string);
GetStringHollerithLiteralConstant825 std::string GetString() const { return v; }
826 };
827
828 // R725 logical-literal-constant ->
829 // .TRUE. [_ kind-param] | .FALSE. [_ kind-param]
830 struct LogicalLiteralConstant {
831 TUPLE_CLASS_BOILERPLATE(LogicalLiteralConstant);
832 std::tuple<bool, std::optional<KindParam>> t;
833 };
834
835 // R764 boz-literal-constant -> binary-constant | octal-constant | hex-constant
836 // R765 binary-constant -> B ' digit [digit]... ' | B " digit [digit]... "
837 // R766 octal-constant -> O ' digit [digit]... ' | O " digit [digit]... "
838 // R767 hex-constant ->
839 // Z ' hex-digit [hex-digit]... ' | Z " hex-digit [hex-digit]... "
840 // The constant must be large enough to hold any real or integer scalar
841 // of any supported kind (F'2018 7.7).
842 WRAPPER_CLASS(BOZLiteralConstant, std::string);
843
844 // R605 literal-constant ->
845 // int-literal-constant | real-literal-constant |
846 // complex-literal-constant | logical-literal-constant |
847 // char-literal-constant | boz-literal-constant
848 struct LiteralConstant {
849 UNION_CLASS_BOILERPLATE(LiteralConstant);
850 std::variant<HollerithLiteralConstant, IntLiteralConstant,
851 RealLiteralConstant, ComplexLiteralConstant, BOZLiteralConstant,
852 CharLiteralConstant, LogicalLiteralConstant>
853 u;
854 };
855
856 // R604 constant -> literal-constant | named-constant
857 // Renamed to dodge a clash with Constant<> template class.
858 struct ConstantValue {
859 UNION_CLASS_BOILERPLATE(ConstantValue);
860 std::variant<LiteralConstant, NamedConstant> u;
861 };
862
863 // R807 access-spec -> PUBLIC | PRIVATE
864 struct AccessSpec {
865 ENUM_CLASS(Kind, Public, Private)
866 WRAPPER_CLASS_BOILERPLATE(AccessSpec, Kind);
867 };
868
869 // R728 type-attr-spec ->
870 // ABSTRACT | access-spec | BIND(C) | EXTENDS ( parent-type-name )
871 EMPTY_CLASS(Abstract);
872 struct TypeAttrSpec {
873 UNION_CLASS_BOILERPLATE(TypeAttrSpec);
874 EMPTY_CLASS(BindC);
875 WRAPPER_CLASS(Extends, Name);
876 std::variant<Abstract, AccessSpec, BindC, Extends> u;
877 };
878
879 // R727 derived-type-stmt ->
880 // TYPE [[, type-attr-spec-list] ::] type-name [( type-param-name-list )]
881 struct DerivedTypeStmt {
882 TUPLE_CLASS_BOILERPLATE(DerivedTypeStmt);
883 std::tuple<std::list<TypeAttrSpec>, Name, std::list<Name>> t;
884 };
885
886 // R731 sequence-stmt -> SEQUENCE
887 EMPTY_CLASS(SequenceStmt);
888
889 // R745 private-components-stmt -> PRIVATE
890 // R747 binding-private-stmt -> PRIVATE
891 EMPTY_CLASS(PrivateStmt);
892
893 // R729 private-or-sequence -> private-components-stmt | sequence-stmt
894 struct PrivateOrSequence {
895 UNION_CLASS_BOILERPLATE(PrivateOrSequence);
896 std::variant<PrivateStmt, SequenceStmt> u;
897 };
898
899 // R733 type-param-decl -> type-param-name [= scalar-int-constant-expr]
900 struct TypeParamDecl {
901 TUPLE_CLASS_BOILERPLATE(TypeParamDecl);
902 std::tuple<Name, std::optional<ScalarIntConstantExpr>> t;
903 };
904
905 // R732 type-param-def-stmt ->
906 // integer-type-spec , type-param-attr-spec :: type-param-decl-list
907 // R734 type-param-attr-spec -> KIND | LEN
908 struct TypeParamDefStmt {
909 TUPLE_CLASS_BOILERPLATE(TypeParamDefStmt);
910 std::tuple<IntegerTypeSpec, common::TypeParamAttr, std::list<TypeParamDecl>>
911 t;
912 };
913
914 // R1028 specification-expr -> scalar-int-expr
915 WRAPPER_CLASS(SpecificationExpr, ScalarIntExpr);
916
917 // R816 explicit-shape-spec -> [lower-bound :] upper-bound
918 // R817 lower-bound -> specification-expr
919 // R818 upper-bound -> specification-expr
920 struct ExplicitShapeSpec {
921 TUPLE_CLASS_BOILERPLATE(ExplicitShapeSpec);
922 std::tuple<std::optional<SpecificationExpr>, SpecificationExpr> t;
923 };
924
925 // R810 deferred-coshape-spec -> :
926 // deferred-coshape-spec-list is just a count of the colons (i.e., the rank).
927 WRAPPER_CLASS(DeferredCoshapeSpecList, int);
928
929 // R811 explicit-coshape-spec ->
930 // [[lower-cobound :] upper-cobound ,]... [lower-cobound :] *
931 // R812 lower-cobound -> specification-expr
932 // R813 upper-cobound -> specification-expr
933 struct ExplicitCoshapeSpec {
934 TUPLE_CLASS_BOILERPLATE(ExplicitCoshapeSpec);
935 std::tuple<std::list<ExplicitShapeSpec>, std::optional<SpecificationExpr>> t;
936 };
937
938 // R809 coarray-spec -> deferred-coshape-spec-list | explicit-coshape-spec
939 struct CoarraySpec {
940 UNION_CLASS_BOILERPLATE(CoarraySpec);
941 std::variant<DeferredCoshapeSpecList, ExplicitCoshapeSpec> u;
942 };
943
944 // R820 deferred-shape-spec -> :
945 // deferred-shape-spec-list is just a count of the colons (i.e., the rank).
946 WRAPPER_CLASS(DeferredShapeSpecList, int);
947
948 // R740 component-array-spec ->
949 // explicit-shape-spec-list | deferred-shape-spec-list
950 struct ComponentArraySpec {
951 UNION_CLASS_BOILERPLATE(ComponentArraySpec);
952 std::variant<std::list<ExplicitShapeSpec>, DeferredShapeSpecList> u;
953 };
954
955 // R738 component-attr-spec ->
956 // access-spec | ALLOCATABLE |
957 // CODIMENSION lbracket coarray-spec rbracket |
958 // CONTIGUOUS | DIMENSION ( component-array-spec ) | POINTER
959 EMPTY_CLASS(Allocatable);
960 EMPTY_CLASS(Pointer);
961 EMPTY_CLASS(Contiguous);
962 struct ComponentAttrSpec {
963 UNION_CLASS_BOILERPLATE(ComponentAttrSpec);
964 std::variant<AccessSpec, Allocatable, CoarraySpec, Contiguous,
965 ComponentArraySpec, Pointer, ErrorRecovery>
966 u;
967 };
968
969 // R806 null-init -> function-reference
970 // TODO replace with semantic check on expression
971 EMPTY_CLASS(NullInit);
972
973 // R744 initial-data-target -> designator
974 using InitialDataTarget = common::Indirection<Designator>;
975
976 // R743 component-initialization ->
977 // = constant-expr | => null-init | => initial-data-target
978 // R805 initialization ->
979 // = constant-expr | => null-init | => initial-data-target
980 // Universal extension: initialization -> / data-stmt-value-list /
981 struct Initialization {
982 UNION_CLASS_BOILERPLATE(Initialization);
983 std::variant<ConstantExpr, NullInit, InitialDataTarget,
984 std::list<common::Indirection<DataStmtValue>>>
985 u;
986 };
987
988 // R739 component-decl ->
989 // component-name [( component-array-spec )]
990 // [lbracket coarray-spec rbracket] [* char-length]
991 // [component-initialization]
992 struct ComponentDecl {
993 TUPLE_CLASS_BOILERPLATE(ComponentDecl);
994 std::tuple<Name, std::optional<ComponentArraySpec>,
995 std::optional<CoarraySpec>, std::optional<CharLength>,
996 std::optional<Initialization>>
997 t;
998 };
999
1000 // R737 data-component-def-stmt ->
1001 // declaration-type-spec [[, component-attr-spec-list] ::]
1002 // component-decl-list
1003 struct DataComponentDefStmt {
1004 TUPLE_CLASS_BOILERPLATE(DataComponentDefStmt);
1005 std::tuple<DeclarationTypeSpec, std::list<ComponentAttrSpec>,
1006 std::list<ComponentDecl>>
1007 t;
1008 };
1009
1010 // R742 proc-component-attr-spec ->
1011 // access-spec | NOPASS | PASS [(arg-name)] | POINTER
1012 EMPTY_CLASS(NoPass);
1013 WRAPPER_CLASS(Pass, std::optional<Name>);
1014 struct ProcComponentAttrSpec {
1015 UNION_CLASS_BOILERPLATE(ProcComponentAttrSpec);
1016 std::variant<AccessSpec, NoPass, Pass, Pointer> u;
1017 };
1018
1019 // R1517 proc-pointer-init -> null-init | initial-proc-target
1020 // R1518 initial-proc-target -> procedure-name
1021 struct ProcPointerInit {
1022 UNION_CLASS_BOILERPLATE(ProcPointerInit);
1023 std::variant<NullInit, Name> u;
1024 };
1025
1026 // R1513 proc-interface -> interface-name | declaration-type-spec
1027 // R1516 interface-name -> name
1028 struct ProcInterface {
1029 UNION_CLASS_BOILERPLATE(ProcInterface);
1030 std::variant<Name, DeclarationTypeSpec> u;
1031 };
1032
1033 // R1515 proc-decl -> procedure-entity-name [=> proc-pointer-init]
1034 struct ProcDecl {
1035 TUPLE_CLASS_BOILERPLATE(ProcDecl);
1036 std::tuple<Name, std::optional<ProcPointerInit>> t;
1037 };
1038
1039 // R741 proc-component-def-stmt ->
1040 // PROCEDURE ( [proc-interface] ) , proc-component-attr-spec-list
1041 // :: proc-decl-list
1042 struct ProcComponentDefStmt {
1043 TUPLE_CLASS_BOILERPLATE(ProcComponentDefStmt);
1044 std::tuple<std::optional<ProcInterface>, std::list<ProcComponentAttrSpec>,
1045 std::list<ProcDecl>>
1046 t;
1047 };
1048
1049 // R736 component-def-stmt -> data-component-def-stmt | proc-component-def-stmt
1050 struct ComponentDefStmt {
1051 UNION_CLASS_BOILERPLATE(ComponentDefStmt);
1052 std::variant<DataComponentDefStmt, ProcComponentDefStmt, ErrorRecovery
1053 // , TypeParamDefStmt -- PGI accidental extension, not enabled
1054 >
1055 u;
1056 };
1057
1058 // R752 bind-attr ->
1059 // access-spec | DEFERRED | NON_OVERRIDABLE | NOPASS | PASS [(arg-name)]
1060 struct BindAttr {
1061 UNION_CLASS_BOILERPLATE(BindAttr);
1062 EMPTY_CLASS(Deferred);
1063 EMPTY_CLASS(Non_Overridable);
1064 std::variant<AccessSpec, Deferred, Non_Overridable, NoPass, Pass> u;
1065 };
1066
1067 // R750 type-bound-proc-decl -> binding-name [=> procedure-name]
1068 struct TypeBoundProcDecl {
1069 TUPLE_CLASS_BOILERPLATE(TypeBoundProcDecl);
1070 std::tuple<Name, std::optional<Name>> t;
1071 };
1072
1073 // R749 type-bound-procedure-stmt ->
1074 // PROCEDURE [[, bind-attr-list] ::] type-bound-proc-decl-list |
1075 // PROCEDURE ( interface-name ) , bind-attr-list :: binding-name-list
1076 // The second form, with interface-name, requires DEFERRED in bind-attr-list,
1077 // and thus can appear only in an abstract type.
1078 struct TypeBoundProcedureStmt {
1079 UNION_CLASS_BOILERPLATE(TypeBoundProcedureStmt);
1080 struct WithoutInterface {
1081 BOILERPLATE(WithoutInterface);
WithoutInterfaceTypeBoundProcedureStmt::WithoutInterface1082 WithoutInterface(
1083 std::list<BindAttr> &&as, std::list<TypeBoundProcDecl> &&ds)
1084 : attributes(std::move(as)), declarations(std::move(ds)) {}
1085 std::list<BindAttr> attributes;
1086 std::list<TypeBoundProcDecl> declarations;
1087 };
1088 struct WithInterface {
1089 BOILERPLATE(WithInterface);
WithInterfaceTypeBoundProcedureStmt::WithInterface1090 WithInterface(Name &&n, std::list<BindAttr> &&as, std::list<Name> &&bs)
1091 : interfaceName(std::move(n)), attributes(std::move(as)),
1092 bindingNames(std::move(bs)) {}
1093 Name interfaceName;
1094 std::list<BindAttr> attributes;
1095 std::list<Name> bindingNames;
1096 };
1097 std::variant<WithoutInterface, WithInterface> u;
1098 };
1099
1100 // R751 type-bound-generic-stmt ->
1101 // GENERIC [, access-spec] :: generic-spec => binding-name-list
1102 struct TypeBoundGenericStmt {
1103 TUPLE_CLASS_BOILERPLATE(TypeBoundGenericStmt);
1104 std::tuple<std::optional<AccessSpec>, common::Indirection<GenericSpec>,
1105 std::list<Name>>
1106 t;
1107 };
1108
1109 // R753 final-procedure-stmt -> FINAL [::] final-subroutine-name-list
1110 WRAPPER_CLASS(FinalProcedureStmt, std::list<Name>);
1111
1112 // R748 type-bound-proc-binding ->
1113 // type-bound-procedure-stmt | type-bound-generic-stmt |
1114 // final-procedure-stmt
1115 struct TypeBoundProcBinding {
1116 UNION_CLASS_BOILERPLATE(TypeBoundProcBinding);
1117 std::variant<TypeBoundProcedureStmt, TypeBoundGenericStmt, FinalProcedureStmt,
1118 ErrorRecovery>
1119 u;
1120 };
1121
1122 // R746 type-bound-procedure-part ->
1123 // contains-stmt [binding-private-stmt] [type-bound-proc-binding]...
1124 struct TypeBoundProcedurePart {
1125 TUPLE_CLASS_BOILERPLATE(TypeBoundProcedurePart);
1126 std::tuple<Statement<ContainsStmt>, std::optional<Statement<PrivateStmt>>,
1127 std::list<Statement<TypeBoundProcBinding>>>
1128 t;
1129 };
1130
1131 // R730 end-type-stmt -> END TYPE [type-name]
1132 WRAPPER_CLASS(EndTypeStmt, std::optional<Name>);
1133
1134 // R726 derived-type-def ->
1135 // derived-type-stmt [type-param-def-stmt]... [private-or-sequence]...
1136 // [component-part] [type-bound-procedure-part] end-type-stmt
1137 // R735 component-part -> [component-def-stmt]...
1138 struct DerivedTypeDef {
1139 TUPLE_CLASS_BOILERPLATE(DerivedTypeDef);
1140 std::tuple<Statement<DerivedTypeStmt>, std::list<Statement<TypeParamDefStmt>>,
1141 std::list<Statement<PrivateOrSequence>>,
1142 std::list<Statement<ComponentDefStmt>>,
1143 std::optional<TypeBoundProcedurePart>, Statement<EndTypeStmt>>
1144 t;
1145 };
1146
1147 // R758 component-data-source -> expr | data-target | proc-target
1148 // R1037 data-target -> expr
1149 // R1040 proc-target -> expr | procedure-name | proc-component-ref
1150 WRAPPER_CLASS(ComponentDataSource, common::Indirection<Expr>);
1151
1152 // R757 component-spec -> [keyword =] component-data-source
1153 struct ComponentSpec {
1154 TUPLE_CLASS_BOILERPLATE(ComponentSpec);
1155 std::tuple<std::optional<Keyword>, ComponentDataSource> t;
1156 };
1157
1158 // R756 structure-constructor -> derived-type-spec ( [component-spec-list] )
1159 struct StructureConstructor {
1160 TUPLE_CLASS_BOILERPLATE(StructureConstructor);
1161 std::tuple<DerivedTypeSpec, std::list<ComponentSpec>> t;
1162 };
1163
1164 // R760 enum-def-stmt -> ENUM, BIND(C)
1165 EMPTY_CLASS(EnumDefStmt);
1166
1167 // R762 enumerator -> named-constant [= scalar-int-constant-expr]
1168 struct Enumerator {
1169 TUPLE_CLASS_BOILERPLATE(Enumerator);
1170 std::tuple<NamedConstant, std::optional<ScalarIntConstantExpr>> t;
1171 };
1172
1173 // R761 enumerator-def-stmt -> ENUMERATOR [::] enumerator-list
1174 WRAPPER_CLASS(EnumeratorDefStmt, std::list<Enumerator>);
1175
1176 // R763 end-enum-stmt -> END ENUM
1177 EMPTY_CLASS(EndEnumStmt);
1178
1179 // R759 enum-def ->
1180 // enum-def-stmt enumerator-def-stmt [enumerator-def-stmt]...
1181 // end-enum-stmt
1182 struct EnumDef {
1183 TUPLE_CLASS_BOILERPLATE(EnumDef);
1184 std::tuple<Statement<EnumDefStmt>, std::list<Statement<EnumeratorDefStmt>>,
1185 Statement<EndEnumStmt>>
1186 t;
1187 };
1188
1189 // R773 ac-value -> expr | ac-implied-do
1190 struct AcValue {
1191 struct Triplet { // PGI/Intel extension
1192 TUPLE_CLASS_BOILERPLATE(Triplet);
1193 std::tuple<ScalarIntExpr, ScalarIntExpr, std::optional<ScalarIntExpr>> t;
1194 };
1195 UNION_CLASS_BOILERPLATE(AcValue);
1196 std::variant<Triplet, common::Indirection<Expr>,
1197 common::Indirection<AcImpliedDo>>
1198 u;
1199 };
1200
1201 // R770 ac-spec -> type-spec :: | [type-spec ::] ac-value-list
1202 struct AcSpec {
1203 BOILERPLATE(AcSpec);
AcSpecAcSpec1204 AcSpec(std::optional<TypeSpec> &&ts, std::list<AcValue> &&xs)
1205 : type(std::move(ts)), values(std::move(xs)) {}
AcSpecAcSpec1206 explicit AcSpec(TypeSpec &&ts) : type{std::move(ts)} {}
1207 std::optional<TypeSpec> type;
1208 std::list<AcValue> values;
1209 };
1210
1211 // R769 array-constructor -> (/ ac-spec /) | lbracket ac-spec rbracket
1212 WRAPPER_CLASS(ArrayConstructor, AcSpec);
1213
1214 // R1124 do-variable -> scalar-int-variable-name
1215 using DoVariable = Scalar<Integer<Name>>;
1216
1217 template<typename VAR, typename BOUND> struct LoopBounds {
1218 LoopBounds(LoopBounds &&that) = default;
LoopBoundsLoopBounds1219 LoopBounds(
1220 VAR &&name, BOUND &&lower, BOUND &&upper, std::optional<BOUND> &&step)
1221 : name{std::move(name)}, lower{std::move(lower)}, upper{std::move(upper)},
1222 step{std::move(step)} {}
1223 LoopBounds &operator=(LoopBounds &&) = default;
1224 VAR name;
1225 BOUND lower, upper;
1226 std::optional<BOUND> step;
1227 };
1228
1229 using ScalarName = Scalar<Name>;
1230 using ScalarExpr = Scalar<common::Indirection<Expr>>;
1231
1232 // R775 ac-implied-do-control ->
1233 // [integer-type-spec ::] ac-do-variable = scalar-int-expr ,
1234 // scalar-int-expr [, scalar-int-expr]
1235 // R776 ac-do-variable -> do-variable
1236 struct AcImpliedDoControl {
1237 TUPLE_CLASS_BOILERPLATE(AcImpliedDoControl);
1238 using Bounds = LoopBounds<DoVariable, ScalarIntExpr>;
1239 std::tuple<std::optional<IntegerTypeSpec>, Bounds> t;
1240 };
1241
1242 // R774 ac-implied-do -> ( ac-value-list , ac-implied-do-control )
1243 struct AcImpliedDo {
1244 TUPLE_CLASS_BOILERPLATE(AcImpliedDo);
1245 std::tuple<std::list<AcValue>, AcImpliedDoControl> t;
1246 };
1247
1248 // R808 language-binding-spec ->
1249 // BIND ( C [, NAME = scalar-default-char-constant-expr] )
1250 // R1528 proc-language-binding-spec -> language-binding-spec
1251 WRAPPER_CLASS(
1252 LanguageBindingSpec, std::optional<ScalarDefaultCharConstantExpr>);
1253
1254 // R852 named-constant-def -> named-constant = constant-expr
1255 struct NamedConstantDef {
1256 TUPLE_CLASS_BOILERPLATE(NamedConstantDef);
1257 std::tuple<NamedConstant, ConstantExpr> t;
1258 };
1259
1260 // R851 parameter-stmt -> PARAMETER ( named-constant-def-list )
1261 WRAPPER_CLASS(ParameterStmt, std::list<NamedConstantDef>);
1262
1263 // R819 assumed-shape-spec -> [lower-bound] :
1264 WRAPPER_CLASS(AssumedShapeSpec, std::optional<SpecificationExpr>);
1265
1266 // R821 assumed-implied-spec -> [lower-bound :] *
1267 WRAPPER_CLASS(AssumedImpliedSpec, std::optional<SpecificationExpr>);
1268
1269 // R822 assumed-size-spec -> explicit-shape-spec-list , assumed-implied-spec
1270 struct AssumedSizeSpec {
1271 TUPLE_CLASS_BOILERPLATE(AssumedSizeSpec);
1272 std::tuple<std::list<ExplicitShapeSpec>, AssumedImpliedSpec> t;
1273 };
1274
1275 // R823 implied-shape-or-assumed-size-spec -> assumed-implied-spec
1276 // R824 implied-shape-spec -> assumed-implied-spec , assumed-implied-spec-list
1277 // I.e., when the assumed-implied-spec-list has a single item, it constitutes an
1278 // implied-shape-or-assumed-size-spec; otherwise, an implied-shape-spec.
1279 WRAPPER_CLASS(ImpliedShapeSpec, std::list<AssumedImpliedSpec>);
1280
1281 // R825 assumed-rank-spec -> ..
1282 EMPTY_CLASS(AssumedRankSpec);
1283
1284 // R815 array-spec ->
1285 // explicit-shape-spec-list | assumed-shape-spec-list |
1286 // deferred-shape-spec-list | assumed-size-spec | implied-shape-spec |
1287 // implied-shape-or-assumed-size-spec | assumed-rank-spec
1288 struct ArraySpec {
1289 UNION_CLASS_BOILERPLATE(ArraySpec);
1290 std::variant<std::list<ExplicitShapeSpec>, std::list<AssumedShapeSpec>,
1291 DeferredShapeSpecList, AssumedSizeSpec, ImpliedShapeSpec, AssumedRankSpec>
1292 u;
1293 };
1294
1295 // R826 intent-spec -> IN | OUT | INOUT
1296 struct IntentSpec {
1297 ENUM_CLASS(Intent, In, Out, InOut)
1298 WRAPPER_CLASS_BOILERPLATE(IntentSpec, Intent);
1299 };
1300
1301 // R802 attr-spec ->
1302 // access-spec | ALLOCATABLE | ASYNCHRONOUS |
1303 // CODIMENSION lbracket coarray-spec rbracket | CONTIGUOUS |
1304 // DIMENSION ( array-spec ) | EXTERNAL | INTENT ( intent-spec ) |
1305 // INTRINSIC | language-binding-spec | OPTIONAL | PARAMETER | POINTER |
1306 // PROTECTED | SAVE | TARGET | VALUE | VOLATILE
1307 EMPTY_CLASS(Asynchronous);
1308 EMPTY_CLASS(External);
1309 EMPTY_CLASS(Intrinsic);
1310 EMPTY_CLASS(Optional);
1311 EMPTY_CLASS(Parameter);
1312 EMPTY_CLASS(Protected);
1313 EMPTY_CLASS(Save);
1314 EMPTY_CLASS(Target);
1315 EMPTY_CLASS(Value);
1316 EMPTY_CLASS(Volatile);
1317 struct AttrSpec {
1318 UNION_CLASS_BOILERPLATE(AttrSpec);
1319 std::variant<AccessSpec, Allocatable, Asynchronous, CoarraySpec, Contiguous,
1320 ArraySpec, External, IntentSpec, Intrinsic, LanguageBindingSpec, Optional,
1321 Parameter, Pointer, Protected, Save, Target, Value, Volatile>
1322 u;
1323 };
1324
1325 // R803 entity-decl ->
1326 // object-name [( array-spec )] [lbracket coarray-spec rbracket]
1327 // [* char-length] [initialization] |
1328 // function-name [* char-length]
1329 struct EntityDecl {
1330 TUPLE_CLASS_BOILERPLATE(EntityDecl);
1331 std::tuple<ObjectName, std::optional<ArraySpec>, std::optional<CoarraySpec>,
1332 std::optional<CharLength>, std::optional<Initialization>>
1333 t;
1334 };
1335
1336 // R801 type-declaration-stmt ->
1337 // declaration-type-spec [[, attr-spec]... ::] entity-decl-list
1338 struct TypeDeclarationStmt {
1339 TUPLE_CLASS_BOILERPLATE(TypeDeclarationStmt);
1340 std::tuple<DeclarationTypeSpec, std::list<AttrSpec>, std::list<EntityDecl>> t;
1341 };
1342
1343 // R828 access-id -> access-name | generic-spec
1344 struct AccessId {
1345 UNION_CLASS_BOILERPLATE(AccessId);
1346 std::variant<Name, common::Indirection<GenericSpec>> u;
1347 };
1348
1349 // R827 access-stmt -> access-spec [[::] access-id-list]
1350 struct AccessStmt {
1351 TUPLE_CLASS_BOILERPLATE(AccessStmt);
1352 std::tuple<AccessSpec, std::list<AccessId>> t;
1353 };
1354
1355 // R830 allocatable-decl ->
1356 // object-name [( array-spec )] [lbracket coarray-spec rbracket]
1357 // R860 target-decl ->
1358 // object-name [( array-spec )] [lbracket coarray-spec rbracket]
1359 struct ObjectDecl {
1360 TUPLE_CLASS_BOILERPLATE(ObjectDecl);
1361 std::tuple<ObjectName, std::optional<ArraySpec>, std::optional<CoarraySpec>>
1362 t;
1363 };
1364
1365 // R829 allocatable-stmt -> ALLOCATABLE [::] allocatable-decl-list
1366 WRAPPER_CLASS(AllocatableStmt, std::list<ObjectDecl>);
1367
1368 // R831 asynchronous-stmt -> ASYNCHRONOUS [::] object-name-list
1369 WRAPPER_CLASS(AsynchronousStmt, std::list<ObjectName>);
1370
1371 // R833 bind-entity -> entity-name | / common-block-name /
1372 struct BindEntity {
1373 TUPLE_CLASS_BOILERPLATE(BindEntity);
1374 ENUM_CLASS(Kind, Object, Common)
1375 std::tuple<Kind, Name> t;
1376 };
1377
1378 // R832 bind-stmt -> language-binding-spec [::] bind-entity-list
1379 struct BindStmt {
1380 TUPLE_CLASS_BOILERPLATE(BindStmt);
1381 std::tuple<LanguageBindingSpec, std::list<BindEntity>> t;
1382 };
1383
1384 // R835 codimension-decl -> coarray-name lbracket coarray-spec rbracket
1385 struct CodimensionDecl {
1386 TUPLE_CLASS_BOILERPLATE(CodimensionDecl);
1387 std::tuple<Name, CoarraySpec> t;
1388 };
1389
1390 // R834 codimension-stmt -> CODIMENSION [::] codimension-decl-list
1391 WRAPPER_CLASS(CodimensionStmt, std::list<CodimensionDecl>);
1392
1393 // R836 contiguous-stmt -> CONTIGUOUS [::] object-name-list
1394 WRAPPER_CLASS(ContiguousStmt, std::list<ObjectName>);
1395
1396 // R847 constant-subobject -> designator
1397 // R846 int-constant-subobject -> constant-subobject
1398 using ConstantSubobject = Constant<common::Indirection<Designator>>;
1399
1400 // R845 data-stmt-constant ->
1401 // scalar-constant | scalar-constant-subobject |
1402 // signed-int-literal-constant | signed-real-literal-constant |
1403 // null-init | initial-data-target | structure-constructor
1404 struct DataStmtConstant {
1405 UNION_CLASS_BOILERPLATE(DataStmtConstant);
1406 std::variant<Scalar<ConstantValue>, Scalar<ConstantSubobject>,
1407 SignedIntLiteralConstant, SignedRealLiteralConstant,
1408 SignedComplexLiteralConstant, NullInit, InitialDataTarget,
1409 StructureConstructor>
1410 u;
1411 };
1412
1413 // R844 data-stmt-repeat -> scalar-int-constant | scalar-int-constant-subobject
1414 // R607 int-constant -> constant
1415 // R604 constant -> literal-constant | named-constant
1416 // (only literal-constant -> int-literal-constant applies)
1417 struct DataStmtRepeat {
1418 UNION_CLASS_BOILERPLATE(DataStmtRepeat);
1419 std::variant<IntLiteralConstant, Scalar<Integer<NamedConstant>>,
1420 Scalar<Integer<ConstantSubobject>>>
1421 u;
1422 };
1423
1424 // R843 data-stmt-value -> [data-stmt-repeat *] data-stmt-constant
1425 struct DataStmtValue {
1426 TUPLE_CLASS_BOILERPLATE(DataStmtValue);
1427 std::tuple<std::optional<DataStmtRepeat>, DataStmtConstant> t;
1428 };
1429
1430 // R841 data-i-do-object ->
1431 // array-element | scalar-structure-component | data-implied-do
1432 struct DataIDoObject {
1433 UNION_CLASS_BOILERPLATE(DataIDoObject);
1434 std::variant<Scalar<common::Indirection<Designator>>,
1435 common::Indirection<DataImpliedDo>>
1436 u;
1437 };
1438
1439 // R840 data-implied-do ->
1440 // ( data-i-do-object-list , [integer-type-spec ::] data-i-do-variable
1441 // = scalar-int-constant-expr , scalar-int-constant-expr
1442 // [, scalar-int-constant-expr] )
1443 // R842 data-i-do-variable -> do-variable
1444 struct DataImpliedDo {
1445 TUPLE_CLASS_BOILERPLATE(DataImpliedDo);
1446 using Bounds = LoopBounds<DoVariable, ScalarIntConstantExpr>;
1447 std::tuple<std::list<DataIDoObject>, std::optional<IntegerTypeSpec>, Bounds>
1448 t;
1449 };
1450
1451 // R839 data-stmt-object -> variable | data-implied-do
1452 struct DataStmtObject {
1453 UNION_CLASS_BOILERPLATE(DataStmtObject);
1454 std::variant<common::Indirection<Variable>, DataImpliedDo> u;
1455 };
1456
1457 // R838 data-stmt-set -> data-stmt-object-list / data-stmt-value-list /
1458 struct DataStmtSet {
1459 TUPLE_CLASS_BOILERPLATE(DataStmtSet);
1460 std::tuple<std::list<DataStmtObject>, std::list<DataStmtValue>> t;
1461 };
1462
1463 // R837 data-stmt -> DATA data-stmt-set [[,] data-stmt-set]...
1464 WRAPPER_CLASS(DataStmt, std::list<DataStmtSet>);
1465
1466 // R848 dimension-stmt ->
1467 // DIMENSION [::] array-name ( array-spec )
1468 // [, array-name ( array-spec )]...
1469 struct DimensionStmt {
1470 struct Declaration {
1471 TUPLE_CLASS_BOILERPLATE(Declaration);
1472 std::tuple<Name, ArraySpec> t;
1473 };
1474 WRAPPER_CLASS_BOILERPLATE(DimensionStmt, std::list<Declaration>);
1475 };
1476
1477 // R849 intent-stmt -> INTENT ( intent-spec ) [::] dummy-arg-name-list
1478 struct IntentStmt {
1479 TUPLE_CLASS_BOILERPLATE(IntentStmt);
1480 std::tuple<IntentSpec, std::list<Name>> t;
1481 };
1482
1483 // R850 optional-stmt -> OPTIONAL [::] dummy-arg-name-list
1484 WRAPPER_CLASS(OptionalStmt, std::list<Name>);
1485
1486 // R854 pointer-decl ->
1487 // object-name [( deferred-shape-spec-list )] | proc-entity-name
1488 struct PointerDecl {
1489 TUPLE_CLASS_BOILERPLATE(PointerDecl);
1490 std::tuple<Name, std::optional<DeferredShapeSpecList>> t;
1491 };
1492
1493 // R853 pointer-stmt -> POINTER [::] pointer-decl-list
1494 WRAPPER_CLASS(PointerStmt, std::list<PointerDecl>);
1495
1496 // R855 protected-stmt -> PROTECTED [::] entity-name-list
1497 WRAPPER_CLASS(ProtectedStmt, std::list<Name>);
1498
1499 // R857 saved-entity -> object-name | proc-pointer-name | / common-block-name /
1500 // R858 proc-pointer-name -> name
1501 struct SavedEntity {
1502 TUPLE_CLASS_BOILERPLATE(SavedEntity);
1503 ENUM_CLASS(Kind, Entity, Common)
1504 std::tuple<Kind, Name> t;
1505 };
1506
1507 // R856 save-stmt -> SAVE [[::] saved-entity-list]
1508 WRAPPER_CLASS(SaveStmt, std::list<SavedEntity>);
1509
1510 // R859 target-stmt -> TARGET [::] target-decl-list
1511 WRAPPER_CLASS(TargetStmt, std::list<ObjectDecl>);
1512
1513 // R861 value-stmt -> VALUE [::] dummy-arg-name-list
1514 WRAPPER_CLASS(ValueStmt, std::list<Name>);
1515
1516 // R862 volatile-stmt -> VOLATILE [::] object-name-list
1517 WRAPPER_CLASS(VolatileStmt, std::list<ObjectName>);
1518
1519 // R865 letter-spec -> letter [- letter]
1520 struct LetterSpec {
1521 TUPLE_CLASS_BOILERPLATE(LetterSpec);
1522 std::tuple<Location, std::optional<Location>> t;
1523 };
1524
1525 // R864 implicit-spec -> declaration-type-spec ( letter-spec-list )
1526 struct ImplicitSpec {
1527 TUPLE_CLASS_BOILERPLATE(ImplicitSpec);
1528 std::tuple<DeclarationTypeSpec, std::list<LetterSpec>> t;
1529 };
1530
1531 // R863 implicit-stmt ->
1532 // IMPLICIT implicit-spec-list |
1533 // IMPLICIT NONE [( [implicit-name-spec-list] )]
1534 // R866 implicit-name-spec -> EXTERNAL | TYPE
1535 struct ImplicitStmt {
1536 UNION_CLASS_BOILERPLATE(ImplicitStmt);
1537 ENUM_CLASS(ImplicitNoneNameSpec, External, Type) // R866
1538 std::variant<std::list<ImplicitSpec>, std::list<ImplicitNoneNameSpec>> u;
1539 };
1540
1541 // R874 common-block-object -> variable-name [( array-spec )]
1542 struct CommonBlockObject {
1543 TUPLE_CLASS_BOILERPLATE(CommonBlockObject);
1544 std::tuple<Name, std::optional<ArraySpec>> t;
1545 };
1546
1547 // R873 common-stmt ->
1548 // COMMON [/ [common-block-name] /] common-block-object-list
1549 // [[,] / [common-block-name] / common-block-object-list]...
1550 struct CommonStmt {
1551 struct Block {
1552 TUPLE_CLASS_BOILERPLATE(Block);
1553 std::tuple<std::optional<Name>, std::list<CommonBlockObject>> t;
1554 };
1555 BOILERPLATE(CommonStmt);
1556 CommonStmt(std::optional<Name> &&, std::list<CommonBlockObject> &&,
1557 std::list<Block> &&);
1558 std::list<Block> blocks;
1559 };
1560
1561 // R872 equivalence-object -> variable-name | array-element | substring
1562 WRAPPER_CLASS(EquivalenceObject, common::Indirection<Designator>);
1563
1564 // R870 equivalence-stmt -> EQUIVALENCE equivalence-set-list
1565 // R871 equivalence-set -> ( equivalence-object , equivalence-object-list )
1566 WRAPPER_CLASS(EquivalenceStmt, std::list<std::list<EquivalenceObject>>);
1567
1568 // R910 substring-range -> [scalar-int-expr] : [scalar-int-expr]
1569 struct SubstringRange {
1570 TUPLE_CLASS_BOILERPLATE(SubstringRange);
1571 std::tuple<std::optional<ScalarIntExpr>, std::optional<ScalarIntExpr>> t;
1572 };
1573
1574 // R919 subscript -> scalar-int-expr
1575 using Subscript = ScalarIntExpr;
1576
1577 // R921 subscript-triplet -> [subscript] : [subscript] [: stride]
1578 struct SubscriptTriplet {
1579 TUPLE_CLASS_BOILERPLATE(SubscriptTriplet);
1580 std::tuple<std::optional<Subscript>, std::optional<Subscript>,
1581 std::optional<Subscript>>
1582 t;
1583 };
1584
1585 // R920 section-subscript -> subscript | subscript-triplet | vector-subscript
1586 // R923 vector-subscript -> int-expr
1587 struct SectionSubscript {
1588 UNION_CLASS_BOILERPLATE(SectionSubscript);
1589 std::variant<IntExpr, SubscriptTriplet> u;
1590 };
1591
1592 // R925 cosubscript -> scalar-int-expr
1593 using Cosubscript = ScalarIntExpr;
1594
1595 // R1115 team-value -> scalar-expr
1596 WRAPPER_CLASS(TeamValue, Scalar<common::Indirection<Expr>>);
1597
1598 // R926 image-selector-spec ->
1599 // STAT = stat-variable | TEAM = team-value |
1600 // TEAM_NUMBER = scalar-int-expr
1601 struct ImageSelectorSpec {
1602 WRAPPER_CLASS(Stat, Scalar<Integer<common::Indirection<Variable>>>);
1603 WRAPPER_CLASS(Team_Number, ScalarIntExpr);
1604 UNION_CLASS_BOILERPLATE(ImageSelectorSpec);
1605 std::variant<Stat, TeamValue, Team_Number> u;
1606 };
1607
1608 // R924 image-selector ->
1609 // lbracket cosubscript-list [, image-selector-spec-list] rbracket
1610 struct ImageSelector {
1611 TUPLE_CLASS_BOILERPLATE(ImageSelector);
1612 std::tuple<std::list<Cosubscript>, std::list<ImageSelectorSpec>> t;
1613 };
1614
1615 // R1001 - R1022 expressions
1616 struct Expr {
1617 UNION_CLASS_BOILERPLATE(Expr);
1618
1619 WRAPPER_CLASS(IntrinsicUnary, common::Indirection<Expr>);
1620 struct Parentheses : public IntrinsicUnary {
1621 using IntrinsicUnary::IntrinsicUnary;
1622 };
1623 struct UnaryPlus : public IntrinsicUnary {
1624 using IntrinsicUnary::IntrinsicUnary;
1625 };
1626 struct Negate : public IntrinsicUnary {
1627 using IntrinsicUnary::IntrinsicUnary;
1628 };
1629 struct NOT : public IntrinsicUnary {
1630 using IntrinsicUnary::IntrinsicUnary;
1631 };
1632
1633 WRAPPER_CLASS(
1634 PercentLoc, common::Indirection<Variable>); // %LOC(v) extension
1635
1636 struct DefinedUnary {
1637 TUPLE_CLASS_BOILERPLATE(DefinedUnary);
1638 std::tuple<DefinedOpName, common::Indirection<Expr>> t;
1639 };
1640
1641 struct IntrinsicBinary {
1642 TUPLE_CLASS_BOILERPLATE(IntrinsicBinary);
1643 std::tuple<common::Indirection<Expr>, common::Indirection<Expr>> t;
1644 };
1645 struct Power : public IntrinsicBinary {
1646 using IntrinsicBinary::IntrinsicBinary;
1647 };
1648 struct Multiply : public IntrinsicBinary {
1649 using IntrinsicBinary::IntrinsicBinary;
1650 };
1651 struct Divide : public IntrinsicBinary {
1652 using IntrinsicBinary::IntrinsicBinary;
1653 };
1654 struct Add : public IntrinsicBinary {
1655 using IntrinsicBinary::IntrinsicBinary;
1656 };
1657 struct Subtract : public IntrinsicBinary {
1658 using IntrinsicBinary::IntrinsicBinary;
1659 };
1660 struct Concat : public IntrinsicBinary {
1661 using IntrinsicBinary::IntrinsicBinary;
1662 };
1663 struct LT : public IntrinsicBinary {
1664 using IntrinsicBinary::IntrinsicBinary;
1665 };
1666 struct LE : public IntrinsicBinary {
1667 using IntrinsicBinary::IntrinsicBinary;
1668 };
1669 struct EQ : public IntrinsicBinary {
1670 using IntrinsicBinary::IntrinsicBinary;
1671 };
1672 struct NE : public IntrinsicBinary {
1673 using IntrinsicBinary::IntrinsicBinary;
1674 };
1675 struct GE : public IntrinsicBinary {
1676 using IntrinsicBinary::IntrinsicBinary;
1677 };
1678 struct GT : public IntrinsicBinary {
1679 using IntrinsicBinary::IntrinsicBinary;
1680 };
1681 struct AND : public IntrinsicBinary {
1682 using IntrinsicBinary::IntrinsicBinary;
1683 };
1684 struct OR : public IntrinsicBinary {
1685 using IntrinsicBinary::IntrinsicBinary;
1686 };
1687 struct EQV : public IntrinsicBinary {
1688 using IntrinsicBinary::IntrinsicBinary;
1689 };
1690 struct NEQV : public IntrinsicBinary {
1691 using IntrinsicBinary::IntrinsicBinary;
1692 };
1693 struct XOR : public IntrinsicBinary {
1694 using IntrinsicBinary::IntrinsicBinary;
1695 };
1696
1697 // PGI/XLF extension: (x,y), not both constant
1698 struct ComplexConstructor : public IntrinsicBinary {
1699 using IntrinsicBinary::IntrinsicBinary;
1700 };
1701
1702 struct DefinedBinary {
1703 TUPLE_CLASS_BOILERPLATE(DefinedBinary);
1704 std::tuple<DefinedOpName, common::Indirection<Expr>,
1705 common::Indirection<Expr>>
1706 t;
1707 };
1708
1709 explicit Expr(Designator &&);
1710 explicit Expr(FunctionReference &&);
1711
1712 // Filled in with expression after successful semantic analysis.
1713 using TypedExpr = std::unique_ptr<evaluate::GenericExprWrapper,
1714 common::Deleter<evaluate::GenericExprWrapper>>;
1715 mutable TypedExpr typedExpr;
1716
1717 CharBlock source;
1718
1719 std::variant<common::Indirection<CharLiteralConstantSubstring>,
1720 LiteralConstant, common::Indirection<Designator>, ArrayConstructor,
1721 StructureConstructor, common::Indirection<FunctionReference>, Parentheses,
1722 UnaryPlus, Negate, NOT, PercentLoc, DefinedUnary, Power, Multiply, Divide,
1723 Add, Subtract, Concat, LT, LE, EQ, NE, GE, GT, AND, OR, EQV, NEQV, XOR,
1724 DefinedBinary, ComplexConstructor>
1725 u;
1726 };
1727
1728 // R912 part-ref -> part-name [( section-subscript-list )] [image-selector]
1729 struct PartRef {
1730 BOILERPLATE(PartRef);
PartRefPartRef1731 PartRef(Name &&n, std::list<SectionSubscript> &&ss,
1732 std::optional<ImageSelector> &&is)
1733 : name{std::move(n)},
1734 subscripts(std::move(ss)), imageSelector{std::move(is)} {}
1735 Name name;
1736 std::list<SectionSubscript> subscripts;
1737 std::optional<ImageSelector> imageSelector;
1738 };
1739
1740 // R911 data-ref -> part-ref [% part-ref]...
1741 struct DataRef {
1742 UNION_CLASS_BOILERPLATE(DataRef);
1743 explicit DataRef(std::list<PartRef> &&);
1744 std::variant<Name, common::Indirection<StructureComponent>,
1745 common::Indirection<ArrayElement>,
1746 common::Indirection<CoindexedNamedObject>>
1747 u;
1748 };
1749
1750 // R908 substring -> parent-string ( substring-range )
1751 // R909 parent-string ->
1752 // scalar-variable-name | array-element | coindexed-named-object |
1753 // scalar-structure-component | scalar-char-literal-constant |
1754 // scalar-named-constant
1755 // Substrings of character literals have been factored out into their
1756 // own productions so that they can't appear as designators in any context
1757 // other than a primary expression.
1758 struct Substring {
1759 TUPLE_CLASS_BOILERPLATE(Substring);
1760 std::tuple<DataRef, SubstringRange> t;
1761 };
1762
1763 struct CharLiteralConstantSubstring {
1764 TUPLE_CLASS_BOILERPLATE(CharLiteralConstantSubstring);
1765 std::tuple<CharLiteralConstant, SubstringRange> t;
1766 };
1767
1768 // R901 designator -> object-name | array-element | array-section |
1769 // coindexed-named-object | complex-part-designator |
1770 // structure-component | substring
1771 struct Designator {
1772 UNION_CLASS_BOILERPLATE(Designator);
1773 bool EndsInBareName() const;
1774 CharBlock source;
1775 std::variant<DataRef, Substring> u;
1776 };
1777
1778 // R902 variable -> designator | function-reference
1779 struct Variable {
1780 UNION_CLASS_BOILERPLATE(Variable);
1781 mutable Expr::TypedExpr typedExpr;
1782 parser::CharBlock GetSource() const;
1783 std::variant<common::Indirection<Designator>,
1784 common::Indirection<FunctionReference>>
1785 u;
1786 };
1787
1788 // R904 logical-variable -> variable
1789 // Appears only as part of scalar-logical-variable.
1790 using ScalarLogicalVariable = Scalar<Logical<Variable>>;
1791
1792 // R906 default-char-variable -> variable
1793 // Appears only as part of scalar-default-char-variable.
1794 using ScalarDefaultCharVariable = Scalar<DefaultChar<Variable>>;
1795
1796 // R907 int-variable -> variable
1797 // Appears only as part of scalar-int-variable.
1798 using ScalarIntVariable = Scalar<Integer<Variable>>;
1799
1800 // R913 structure-component -> data-ref
1801 struct StructureComponent {
1802 BOILERPLATE(StructureComponent);
StructureComponentStructureComponent1803 StructureComponent(DataRef &&dr, Name &&n)
1804 : base{std::move(dr)}, component(std::move(n)) {}
1805 DataRef base;
1806 Name component;
1807 };
1808
1809 // R1039 proc-component-ref -> scalar-variable % procedure-component-name
1810 // C1027 constrains the scalar-variable to be a data-ref without coindices.
1811 struct ProcComponentRef {
1812 WRAPPER_CLASS_BOILERPLATE(ProcComponentRef, Scalar<StructureComponent>);
1813 };
1814
1815 // R914 coindexed-named-object -> data-ref
1816 struct CoindexedNamedObject {
1817 BOILERPLATE(CoindexedNamedObject);
CoindexedNamedObjectCoindexedNamedObject1818 CoindexedNamedObject(DataRef &&dr, ImageSelector &&is)
1819 : base{std::move(dr)}, imageSelector{std::move(is)} {}
1820 DataRef base;
1821 ImageSelector imageSelector;
1822 };
1823
1824 // R917 array-element -> data-ref
1825 struct ArrayElement {
1826 BOILERPLATE(ArrayElement);
ArrayElementArrayElement1827 ArrayElement(DataRef &&dr, std::list<SectionSubscript> &&ss)
1828 : base{std::move(dr)}, subscripts(std::move(ss)) {}
1829 Substring ConvertToSubstring();
1830 DataRef base;
1831 std::list<SectionSubscript> subscripts;
1832 };
1833
1834 // R933 allocate-object -> variable-name | structure-component
1835 struct AllocateObject {
1836 UNION_CLASS_BOILERPLATE(AllocateObject);
1837 std::variant<Name, StructureComponent> u;
1838 };
1839
1840 // R935 lower-bound-expr -> scalar-int-expr
1841 // R936 upper-bound-expr -> scalar-int-expr
1842 using BoundExpr = ScalarIntExpr;
1843
1844 // R934 allocate-shape-spec -> [lower-bound-expr :] upper-bound-expr
1845 // R938 allocate-coshape-spec -> [lower-bound-expr :] upper-bound-expr
1846 struct AllocateShapeSpec {
1847 TUPLE_CLASS_BOILERPLATE(AllocateShapeSpec);
1848 std::tuple<std::optional<BoundExpr>, BoundExpr> t;
1849 };
1850
1851 using AllocateCoshapeSpec = AllocateShapeSpec;
1852
1853 // R937 allocate-coarray-spec ->
1854 // [allocate-coshape-spec-list ,] [lower-bound-expr :] *
1855 struct AllocateCoarraySpec {
1856 TUPLE_CLASS_BOILERPLATE(AllocateCoarraySpec);
1857 std::tuple<std::list<AllocateCoshapeSpec>, std::optional<BoundExpr>> t;
1858 };
1859
1860 // R932 allocation ->
1861 // allocate-object [( allocate-shape-spec-list )]
1862 // [lbracket allocate-coarray-spec rbracket]
1863 struct Allocation {
1864 TUPLE_CLASS_BOILERPLATE(Allocation);
1865 std::tuple<AllocateObject, std::list<AllocateShapeSpec>,
1866 std::optional<AllocateCoarraySpec>>
1867 t;
1868 };
1869
1870 // R929 stat-variable -> scalar-int-variable
1871 WRAPPER_CLASS(StatVariable, ScalarIntVariable);
1872
1873 // R930 errmsg-variable -> scalar-default-char-variable
1874 // R1207 iomsg-variable -> scalar-default-char-variable
1875 WRAPPER_CLASS(MsgVariable, ScalarDefaultCharVariable);
1876
1877 // R942 dealloc-opt -> STAT = stat-variable | ERRMSG = errmsg-variable
1878 // R1165 sync-stat -> STAT = stat-variable | ERRMSG = errmsg-variable
1879 struct StatOrErrmsg {
1880 UNION_CLASS_BOILERPLATE(StatOrErrmsg);
1881 std::variant<StatVariable, MsgVariable> u;
1882 };
1883
1884 // R928 alloc-opt ->
1885 // ERRMSG = errmsg-variable | MOLD = source-expr |
1886 // SOURCE = source-expr | STAT = stat-variable
1887 // R931 source-expr -> expr
1888 struct AllocOpt {
1889 UNION_CLASS_BOILERPLATE(AllocOpt);
1890 WRAPPER_CLASS(Mold, common::Indirection<Expr>);
1891 WRAPPER_CLASS(Source, common::Indirection<Expr>);
1892 std::variant<Mold, Source, StatOrErrmsg> u;
1893 };
1894
1895 // R927 allocate-stmt ->
1896 // ALLOCATE ( [type-spec ::] allocation-list [, alloc-opt-list] )
1897 struct AllocateStmt {
1898 TUPLE_CLASS_BOILERPLATE(AllocateStmt);
1899 std::tuple<std::optional<TypeSpec>, std::list<Allocation>,
1900 std::list<AllocOpt>>
1901 t;
1902 };
1903
1904 // R940 pointer-object ->
1905 // variable-name | structure-component | proc-pointer-name
1906 struct PointerObject {
1907 UNION_CLASS_BOILERPLATE(PointerObject);
1908 std::variant<Name, StructureComponent> u;
1909 };
1910
1911 // R939 nullify-stmt -> NULLIFY ( pointer-object-list )
1912 WRAPPER_CLASS(NullifyStmt, std::list<PointerObject>);
1913
1914 // R941 deallocate-stmt ->
1915 // DEALLOCATE ( allocate-object-list [, dealloc-opt-list] )
1916 struct DeallocateStmt {
1917 TUPLE_CLASS_BOILERPLATE(DeallocateStmt);
1918 std::tuple<std::list<AllocateObject>, std::list<StatOrErrmsg>> t;
1919 };
1920
1921 // R1032 assignment-stmt -> variable = expr
1922 struct AssignmentStmt {
1923 TUPLE_CLASS_BOILERPLATE(AssignmentStmt);
1924 std::tuple<Variable, Expr> t;
1925 };
1926
1927 // R1035 bounds-spec -> lower-bound-expr :
1928 WRAPPER_CLASS(BoundsSpec, BoundExpr);
1929
1930 // R1036 bounds-remapping -> lower-bound-expr : upper-bound-expr
1931 struct BoundsRemapping {
1932 TUPLE_CLASS_BOILERPLATE(BoundsRemapping);
1933 std::tuple<BoundExpr, BoundExpr> t;
1934 };
1935
1936 // R1033 pointer-assignment-stmt ->
1937 // data-pointer-object [( bounds-spec-list )] => data-target |
1938 // data-pointer-object ( bounds-remapping-list ) => data-target |
1939 // proc-pointer-object => proc-target
1940 // R1034 data-pointer-object ->
1941 // variable-name | scalar-variable % data-pointer-component-name
1942 // R1038 proc-pointer-object -> proc-pointer-name | proc-component-ref
1943 struct PointerAssignmentStmt {
1944 struct Bounds {
1945 UNION_CLASS_BOILERPLATE(Bounds);
1946 std::variant<std::list<BoundsRemapping>, std::list<BoundsSpec>> u;
1947 };
1948 TUPLE_CLASS_BOILERPLATE(PointerAssignmentStmt);
1949 std::tuple<DataRef, Bounds, Expr> t;
1950 };
1951
1952 // R1041 where-stmt -> WHERE ( mask-expr ) where-assignment-stmt
1953 // R1045 where-assignment-stmt -> assignment-stmt
1954 // R1046 mask-expr -> logical-expr
1955 struct WhereStmt {
1956 TUPLE_CLASS_BOILERPLATE(WhereStmt);
1957 std::tuple<LogicalExpr, AssignmentStmt> t;
1958 };
1959
1960 // R1043 where-construct-stmt -> [where-construct-name :] WHERE ( mask-expr )
1961 struct WhereConstructStmt {
1962 TUPLE_CLASS_BOILERPLATE(WhereConstructStmt);
1963 std::tuple<std::optional<Name>, LogicalExpr> t;
1964 };
1965
1966 // R1044 where-body-construct ->
1967 // where-assignment-stmt | where-stmt | where-construct
1968 struct WhereBodyConstruct {
1969 UNION_CLASS_BOILERPLATE(WhereBodyConstruct);
1970 std::variant<Statement<AssignmentStmt>, Statement<WhereStmt>,
1971 common::Indirection<WhereConstruct>>
1972 u;
1973 };
1974
1975 // R1047 masked-elsewhere-stmt ->
1976 // ELSEWHERE ( mask-expr ) [where-construct-name]
1977 struct MaskedElsewhereStmt {
1978 TUPLE_CLASS_BOILERPLATE(MaskedElsewhereStmt);
1979 std::tuple<LogicalExpr, std::optional<Name>> t;
1980 };
1981
1982 // R1048 elsewhere-stmt -> ELSEWHERE [where-construct-name]
1983 WRAPPER_CLASS(ElsewhereStmt, std::optional<Name>);
1984
1985 // R1049 end-where-stmt -> END WHERE [where-construct-name]
1986 WRAPPER_CLASS(EndWhereStmt, std::optional<Name>);
1987
1988 // R1042 where-construct ->
1989 // where-construct-stmt [where-body-construct]...
1990 // [masked-elsewhere-stmt [where-body-construct]...]...
1991 // [elsewhere-stmt [where-body-construct]...] end-where-stmt
1992 struct WhereConstruct {
1993 struct MaskedElsewhere {
1994 TUPLE_CLASS_BOILERPLATE(MaskedElsewhere);
1995 std::tuple<Statement<MaskedElsewhereStmt>, std::list<WhereBodyConstruct>> t;
1996 };
1997 struct Elsewhere {
1998 TUPLE_CLASS_BOILERPLATE(Elsewhere);
1999 std::tuple<Statement<ElsewhereStmt>, std::list<WhereBodyConstruct>> t;
2000 };
2001 TUPLE_CLASS_BOILERPLATE(WhereConstruct);
2002 std::tuple<Statement<WhereConstructStmt>, std::list<WhereBodyConstruct>,
2003 std::list<MaskedElsewhere>, std::optional<Elsewhere>,
2004 Statement<EndWhereStmt>>
2005 t;
2006 };
2007
2008 // R1051 forall-construct-stmt ->
2009 // [forall-construct-name :] FORALL concurrent-header
2010 struct ForallConstructStmt {
2011 TUPLE_CLASS_BOILERPLATE(ForallConstructStmt);
2012 std::tuple<std::optional<Name>, common::Indirection<ConcurrentHeader>> t;
2013 };
2014
2015 // R1053 forall-assignment-stmt -> assignment-stmt | pointer-assignment-stmt
2016 struct ForallAssignmentStmt {
2017 UNION_CLASS_BOILERPLATE(ForallAssignmentStmt);
2018 std::variant<AssignmentStmt, PointerAssignmentStmt> u;
2019 };
2020
2021 // R1055 forall-stmt -> FORALL concurrent-header forall-assignment-stmt
2022 struct ForallStmt {
2023 TUPLE_CLASS_BOILERPLATE(ForallStmt);
2024 std::tuple<common::Indirection<ConcurrentHeader>,
2025 UnlabeledStatement<ForallAssignmentStmt>>
2026 t;
2027 };
2028
2029 // R1052 forall-body-construct ->
2030 // forall-assignment-stmt | where-stmt | where-construct |
2031 // forall-construct | forall-stmt
2032 struct ForallBodyConstruct {
2033 UNION_CLASS_BOILERPLATE(ForallBodyConstruct);
2034 std::variant<Statement<ForallAssignmentStmt>, Statement<WhereStmt>,
2035 WhereConstruct, common::Indirection<ForallConstruct>,
2036 Statement<ForallStmt>>
2037 u;
2038 };
2039
2040 // R1054 end-forall-stmt -> END FORALL [forall-construct-name]
2041 WRAPPER_CLASS(EndForallStmt, std::optional<Name>);
2042
2043 // R1050 forall-construct ->
2044 // forall-construct-stmt [forall-body-construct]... end-forall-stmt
2045 struct ForallConstruct {
2046 TUPLE_CLASS_BOILERPLATE(ForallConstruct);
2047 std::tuple<Statement<ForallConstructStmt>, std::list<ForallBodyConstruct>,
2048 Statement<EndForallStmt>>
2049 t;
2050 };
2051
2052 // R1101 block -> [execution-part-construct]...
2053 using Block = std::list<ExecutionPartConstruct>;
2054
2055 // R1105 selector -> expr | variable
2056 struct Selector {
2057 UNION_CLASS_BOILERPLATE(Selector);
2058 std::variant<Expr, Variable> u;
2059 };
2060
2061 // R1104 association -> associate-name => selector
2062 struct Association {
2063 TUPLE_CLASS_BOILERPLATE(Association);
2064 std::tuple<Name, Selector> t;
2065 };
2066
2067 // R1103 associate-stmt ->
2068 // [associate-construct-name :] ASSOCIATE ( association-list )
2069 struct AssociateStmt {
2070 TUPLE_CLASS_BOILERPLATE(AssociateStmt);
2071 std::tuple<std::optional<Name>, std::list<Association>> t;
2072 };
2073
2074 // R1106 end-associate-stmt -> END ASSOCIATE [associate-construct-name]
2075 WRAPPER_CLASS(EndAssociateStmt, std::optional<Name>);
2076
2077 // R1102 associate-construct -> associate-stmt block end-associate-stmt
2078 struct AssociateConstruct {
2079 TUPLE_CLASS_BOILERPLATE(AssociateConstruct);
2080 std::tuple<Statement<AssociateStmt>, Block, Statement<EndAssociateStmt>> t;
2081 };
2082
2083 // R1108 block-stmt -> [block-construct-name :] BLOCK
2084 WRAPPER_CLASS(BlockStmt, std::optional<Name>);
2085
2086 // R1110 end-block-stmt -> END BLOCK [block-construct-name]
2087 WRAPPER_CLASS(EndBlockStmt, std::optional<Name>);
2088
2089 // R1109 block-specification-part ->
2090 // [use-stmt]... [import-stmt]...
2091 // [[declaration-construct]... specification-construct]
2092 WRAPPER_CLASS(BlockSpecificationPart, SpecificationPart);
2093 // TODO: Because BlockSpecificationPart just wraps the more general
2094 // SpecificationPart, it can misrecognize an ImplicitPart as part of
2095 // the BlockSpecificationPart during parsing, and we have to detect and
2096 // flag such usage in semantics.
2097
2098 // R1107 block-construct ->
2099 // block-stmt [block-specification-part] block end-block-stmt
2100 struct BlockConstruct {
2101 TUPLE_CLASS_BOILERPLATE(BlockConstruct);
2102 std::tuple<Statement<BlockStmt>, BlockSpecificationPart, Block,
2103 Statement<EndBlockStmt>>
2104 t;
2105 };
2106
2107 // R1113 coarray-association -> codimension-decl => selector
2108 struct CoarrayAssociation {
2109 TUPLE_CLASS_BOILERPLATE(CoarrayAssociation);
2110 std::tuple<CodimensionDecl, Selector> t;
2111 };
2112
2113 // R1112 change-team-stmt ->
2114 // [team-construct-name :] CHANGE TEAM
2115 // ( team-value [, coarray-association-list] [, sync-stat-list] )
2116 struct ChangeTeamStmt {
2117 TUPLE_CLASS_BOILERPLATE(ChangeTeamStmt);
2118 std::tuple<std::optional<Name>, TeamValue, std::list<CoarrayAssociation>,
2119 std::list<StatOrErrmsg>>
2120 t;
2121 };
2122
2123 // R1114 end-change-team-stmt ->
2124 // END TEAM [( [sync-stat-list] )] [team-construct-name]
2125 struct EndChangeTeamStmt {
2126 TUPLE_CLASS_BOILERPLATE(EndChangeTeamStmt);
2127 std::tuple<std::list<StatOrErrmsg>, std::optional<Name>> t;
2128 };
2129
2130 // R1111 change-team-construct -> change-team-stmt block end-change-team-stmt
2131 struct ChangeTeamConstruct {
2132 TUPLE_CLASS_BOILERPLATE(ChangeTeamConstruct);
2133 std::tuple<Statement<ChangeTeamStmt>, Block, Statement<EndChangeTeamStmt>> t;
2134 };
2135
2136 // R1117 critical-stmt ->
2137 // [critical-construct-name :] CRITICAL [( [sync-stat-list] )]
2138 struct CriticalStmt {
2139 TUPLE_CLASS_BOILERPLATE(CriticalStmt);
2140 std::tuple<std::optional<Name>, std::list<StatOrErrmsg>> t;
2141 };
2142
2143 // R1118 end-critical-stmt -> END CRITICAL [critical-construct-name]
2144 WRAPPER_CLASS(EndCriticalStmt, std::optional<Name>);
2145
2146 // R1116 critical-construct -> critical-stmt block end-critical-stmt
2147 struct CriticalConstruct {
2148 TUPLE_CLASS_BOILERPLATE(CriticalConstruct);
2149 std::tuple<Statement<CriticalStmt>, Block, Statement<EndCriticalStmt>> t;
2150 };
2151
2152 // R1126 concurrent-control ->
2153 // index-name = concurrent-limit : concurrent-limit [: concurrent-step]
2154 // R1127 concurrent-limit -> scalar-int-expr
2155 // R1128 concurrent-step -> scalar-int-expr
2156 struct ConcurrentControl {
2157 TUPLE_CLASS_BOILERPLATE(ConcurrentControl);
2158 std::tuple<Name, ScalarIntExpr, ScalarIntExpr, std::optional<ScalarIntExpr>>
2159 t;
2160 };
2161
2162 // R1125 concurrent-header ->
2163 // ( [integer-type-spec ::] concurrent-control-list
2164 // [, scalar-mask-expr] )
2165 struct ConcurrentHeader {
2166 TUPLE_CLASS_BOILERPLATE(ConcurrentHeader);
2167 std::tuple<std::optional<IntegerTypeSpec>, std::list<ConcurrentControl>,
2168 std::optional<ScalarLogicalExpr>>
2169 t;
2170 };
2171
2172 // R1130 locality-spec ->
2173 // LOCAL ( variable-name-list ) | LOCAL_INIT ( variable-name-list ) |
2174 // SHARED ( variable-name-list ) | DEFAULT ( NONE )
2175 struct LocalitySpec {
2176 UNION_CLASS_BOILERPLATE(LocalitySpec);
2177 WRAPPER_CLASS(Local, std::list<Name>);
2178 WRAPPER_CLASS(LocalInit, std::list<Name>);
2179 WRAPPER_CLASS(Shared, std::list<Name>);
2180 EMPTY_CLASS(DefaultNone);
2181 std::variant<Local, LocalInit, Shared, DefaultNone> u;
2182 };
2183
2184 // R1123 loop-control ->
2185 // [,] do-variable = scalar-int-expr , scalar-int-expr
2186 // [, scalar-int-expr] |
2187 // [,] WHILE ( scalar-logical-expr ) |
2188 // [,] CONCURRENT concurrent-header concurrent-locality
2189 // R1129 concurrent-locality -> [locality-spec]...
2190 struct LoopControl {
2191 UNION_CLASS_BOILERPLATE(LoopControl);
2192 struct Concurrent {
2193 TUPLE_CLASS_BOILERPLATE(Concurrent);
2194 std::tuple<ConcurrentHeader, std::list<LocalitySpec>> t;
2195 };
2196 using Bounds = LoopBounds<ScalarName, ScalarExpr>;
2197 std::variant<Bounds, ScalarLogicalExpr, Concurrent> u;
2198 };
2199
2200 // R1121 label-do-stmt -> [do-construct-name :] DO label [loop-control]
2201 struct LabelDoStmt {
2202 TUPLE_CLASS_BOILERPLATE(LabelDoStmt);
2203 std::tuple<std::optional<Name>, Label, std::optional<LoopControl>> t;
2204 };
2205
2206 // R1122 nonlabel-do-stmt -> [do-construct-name :] DO [loop-control]
2207 struct NonLabelDoStmt {
2208 TUPLE_CLASS_BOILERPLATE(NonLabelDoStmt);
2209 std::tuple<std::optional<Name>, std::optional<LoopControl>> t;
2210 };
2211
2212 // R1132 end-do-stmt -> END DO [do-construct-name]
2213 WRAPPER_CLASS(EndDoStmt, std::optional<Name>);
2214
2215 // R1131 end-do -> end-do-stmt | continue-stmt
2216
2217 // R1119 do-construct -> do-stmt block end-do
2218 // R1120 do-stmt -> nonlabel-do-stmt | label-do-stmt
2219 // TODO: deprecated: DO loop ending on statement types other than END DO and
2220 // CONTINUE; multiple "label DO" loops ending on the same label
2221 struct DoConstruct {
2222 TUPLE_CLASS_BOILERPLATE(DoConstruct);
2223 const std::optional<LoopControl> &GetLoopControl() const;
2224 bool IsDoNormal() const;
2225 bool IsDoWhile() const;
2226 bool IsDoConcurrent() const;
2227 std::tuple<Statement<NonLabelDoStmt>, Block, Statement<EndDoStmt>> t;
2228 };
2229
2230 // R1133 cycle-stmt -> CYCLE [do-construct-name]
2231 WRAPPER_CLASS(CycleStmt, std::optional<Name>);
2232
2233 // R1135 if-then-stmt -> [if-construct-name :] IF ( scalar-logical-expr ) THEN
2234 struct IfThenStmt {
2235 TUPLE_CLASS_BOILERPLATE(IfThenStmt);
2236 std::tuple<std::optional<Name>, ScalarLogicalExpr> t;
2237 };
2238
2239 // R1136 else-if-stmt ->
2240 // ELSE IF ( scalar-logical-expr ) THEN [if-construct-name]
2241 struct ElseIfStmt {
2242 TUPLE_CLASS_BOILERPLATE(ElseIfStmt);
2243 std::tuple<ScalarLogicalExpr, std::optional<Name>> t;
2244 };
2245
2246 // R1137 else-stmt -> ELSE [if-construct-name]
2247 WRAPPER_CLASS(ElseStmt, std::optional<Name>);
2248
2249 // R1138 end-if-stmt -> END IF [if-construct-name]
2250 WRAPPER_CLASS(EndIfStmt, std::optional<Name>);
2251
2252 // R1134 if-construct ->
2253 // if-then-stmt block [else-if-stmt block]...
2254 // [else-stmt block] end-if-stmt
2255 struct IfConstruct {
2256 struct ElseIfBlock {
2257 TUPLE_CLASS_BOILERPLATE(ElseIfBlock);
2258 std::tuple<Statement<ElseIfStmt>, Block> t;
2259 };
2260 struct ElseBlock {
2261 TUPLE_CLASS_BOILERPLATE(ElseBlock);
2262 std::tuple<Statement<ElseStmt>, Block> t;
2263 };
2264 TUPLE_CLASS_BOILERPLATE(IfConstruct);
2265 std::tuple<Statement<IfThenStmt>, Block, std::list<ElseIfBlock>,
2266 std::optional<ElseBlock>, Statement<EndIfStmt>>
2267 t;
2268 };
2269
2270 // R1139 if-stmt -> IF ( scalar-logical-expr ) action-stmt
2271 struct IfStmt {
2272 TUPLE_CLASS_BOILERPLATE(IfStmt);
2273 std::tuple<ScalarLogicalExpr, UnlabeledStatement<ActionStmt>> t;
2274 };
2275
2276 // R1141 select-case-stmt -> [case-construct-name :] SELECT CASE ( case-expr )
2277 // R1144 case-expr -> scalar-expr
2278 struct SelectCaseStmt {
2279 TUPLE_CLASS_BOILERPLATE(SelectCaseStmt);
2280 std::tuple<std::optional<Name>, Scalar<Expr>> t;
2281 };
2282
2283 // R1147 case-value -> scalar-constant-expr
2284 using CaseValue = Scalar<ConstantExpr>;
2285
2286 // R1146 case-value-range ->
2287 // case-value | case-value : | : case-value | case-value : case-value
2288 struct CaseValueRange {
2289 UNION_CLASS_BOILERPLATE(CaseValueRange);
2290 struct Range {
2291 BOILERPLATE(Range);
RangeCaseValueRange::Range2292 Range(std::optional<CaseValue> &&l, std::optional<CaseValue> &&u)
2293 : lower{std::move(l)}, upper{std::move(u)} {}
2294 std::optional<CaseValue> lower, upper; // not both missing
2295 };
2296 std::variant<CaseValue, Range> u;
2297 };
2298
2299 // R1145 case-selector -> ( case-value-range-list ) | DEFAULT
2300 EMPTY_CLASS(Default);
2301
2302 struct CaseSelector {
2303 UNION_CLASS_BOILERPLATE(CaseSelector);
2304 std::variant<std::list<CaseValueRange>, Default> u;
2305 };
2306
2307 // R1142 case-stmt -> CASE case-selector [case-construct-name]
2308 struct CaseStmt {
2309 TUPLE_CLASS_BOILERPLATE(CaseStmt);
2310 std::tuple<CaseSelector, std::optional<Name>> t;
2311 };
2312
2313 // R1143 end-select-stmt -> END SELECT [case-construct-name]
2314 // R1151 end-select-rank-stmt -> END SELECT [select-construct-name]
2315 // R1155 end-select-type-stmt -> END SELECT [select-construct-name]
2316 WRAPPER_CLASS(EndSelectStmt, std::optional<Name>);
2317
2318 // R1140 case-construct ->
2319 // select-case-stmt [case-stmt block]... end-select-stmt
2320 struct CaseConstruct {
2321 struct Case {
2322 TUPLE_CLASS_BOILERPLATE(Case);
2323 std::tuple<Statement<CaseStmt>, Block> t;
2324 };
2325 TUPLE_CLASS_BOILERPLATE(CaseConstruct);
2326 std::tuple<Statement<SelectCaseStmt>, std::list<Case>,
2327 Statement<EndSelectStmt>>
2328 t;
2329 };
2330
2331 // R1149 select-rank-stmt ->
2332 // [select-construct-name :] SELECT RANK
2333 // ( [associate-name =>] selector )
2334 struct SelectRankStmt {
2335 TUPLE_CLASS_BOILERPLATE(SelectRankStmt);
2336 std::tuple<std::optional<Name>, std::optional<Name>, Selector> t;
2337 };
2338
2339 // R1150 select-rank-case-stmt ->
2340 // RANK ( scalar-int-constant-expr ) [select-construct-name] |
2341 // RANK ( * ) [select-construct-name] |
2342 // RANK DEFAULT [select-construct-name]
2343 struct SelectRankCaseStmt {
2344 struct Rank {
2345 UNION_CLASS_BOILERPLATE(Rank);
2346 std::variant<ScalarIntConstantExpr, Star, Default> u;
2347 };
2348 TUPLE_CLASS_BOILERPLATE(SelectRankCaseStmt);
2349 std::tuple<Rank, std::optional<Name>> t;
2350 };
2351
2352 // R1148 select-rank-construct ->
2353 // select-rank-stmt [select-rank-case-stmt block]...
2354 // end-select-rank-stmt
2355 struct SelectRankConstruct {
2356 TUPLE_CLASS_BOILERPLATE(SelectRankConstruct);
2357 struct RankCase {
2358 TUPLE_CLASS_BOILERPLATE(RankCase);
2359 std::tuple<Statement<SelectRankCaseStmt>, Block> t;
2360 };
2361 std::tuple<Statement<SelectRankStmt>, std::list<RankCase>,
2362 Statement<EndSelectStmt>>
2363 t;
2364 };
2365
2366 // R1153 select-type-stmt ->
2367 // [select-construct-name :] SELECT TYPE
2368 // ( [associate-name =>] selector )
2369 struct SelectTypeStmt {
2370 TUPLE_CLASS_BOILERPLATE(SelectTypeStmt);
2371 std::tuple<std::optional<Name>, std::optional<Name>, Selector> t;
2372 };
2373
2374 // R1154 type-guard-stmt ->
2375 // TYPE IS ( type-spec ) [select-construct-name] |
2376 // CLASS IS ( derived-type-spec ) [select-construct-name] |
2377 // CLASS DEFAULT [select-construct-name]
2378 struct TypeGuardStmt {
2379 struct Guard {
2380 UNION_CLASS_BOILERPLATE(Guard);
2381 std::variant<TypeSpec, DerivedTypeSpec, Default> u;
2382 };
2383 TUPLE_CLASS_BOILERPLATE(TypeGuardStmt);
2384 std::tuple<Guard, std::optional<Name>> t;
2385 };
2386
2387 // R1152 select-type-construct ->
2388 // select-type-stmt [type-guard-stmt block]... end-select-type-stmt
2389 struct SelectTypeConstruct {
2390 TUPLE_CLASS_BOILERPLATE(SelectTypeConstruct);
2391 struct TypeCase {
2392 TUPLE_CLASS_BOILERPLATE(TypeCase);
2393 std::tuple<Statement<TypeGuardStmt>, Block> t;
2394 };
2395 std::tuple<Statement<SelectTypeStmt>, std::list<TypeCase>,
2396 Statement<EndSelectStmt>>
2397 t;
2398 };
2399
2400 // R1156 exit-stmt -> EXIT [construct-name]
2401 WRAPPER_CLASS(ExitStmt, std::optional<Name>);
2402
2403 // R1157 goto-stmt -> GO TO label
2404 WRAPPER_CLASS(GotoStmt, Label);
2405
2406 // R1158 computed-goto-stmt -> GO TO ( label-list ) [,] scalar-int-expr
2407 struct ComputedGotoStmt {
2408 TUPLE_CLASS_BOILERPLATE(ComputedGotoStmt);
2409 std::tuple<std::list<Label>, ScalarIntExpr> t;
2410 };
2411
2412 // R1162 stop-code -> scalar-default-char-expr | scalar-int-expr
2413 // We can't distinguish character expressions from integer
2414 // expressions during parsing, so we just parse an expr and
2415 // check its type later.
2416 WRAPPER_CLASS(StopCode, Scalar<Expr>);
2417
2418 // R1160 stop-stmt -> STOP [stop-code] [, QUIET = scalar-logical-expr]
2419 // R1161 error-stop-stmt ->
2420 // ERROR STOP [stop-code] [, QUIET = scalar-logical-expr]
2421 struct StopStmt {
2422 ENUM_CLASS(Kind, Stop, ErrorStop)
2423 TUPLE_CLASS_BOILERPLATE(StopStmt);
2424 std::tuple<Kind, std::optional<StopCode>, std::optional<ScalarLogicalExpr>> t;
2425 };
2426
2427 // R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )]
2428 WRAPPER_CLASS(SyncAllStmt, std::list<StatOrErrmsg>);
2429
2430 // R1166 sync-images-stmt -> SYNC IMAGES ( image-set [, sync-stat-list] )
2431 // R1167 image-set -> int-expr | *
2432 struct SyncImagesStmt {
2433 struct ImageSet {
2434 UNION_CLASS_BOILERPLATE(ImageSet);
2435 std::variant<IntExpr, Star> u;
2436 };
2437 TUPLE_CLASS_BOILERPLATE(SyncImagesStmt);
2438 std::tuple<ImageSet, std::list<StatOrErrmsg>> t;
2439 };
2440
2441 // R1168 sync-memory-stmt -> SYNC MEMORY [( [sync-stat-list] )]
2442 WRAPPER_CLASS(SyncMemoryStmt, std::list<StatOrErrmsg>);
2443
2444 // R1169 sync-team-stmt -> SYNC TEAM ( team-value [, sync-stat-list] )
2445 struct SyncTeamStmt {
2446 TUPLE_CLASS_BOILERPLATE(SyncTeamStmt);
2447 std::tuple<TeamValue, std::list<StatOrErrmsg>> t;
2448 };
2449
2450 // R1171 event-variable -> scalar-variable
2451 using EventVariable = Scalar<Variable>;
2452
2453 // R1170 event-post-stmt -> EVENT POST ( event-variable [, sync-stat-list] )
2454 struct EventPostStmt {
2455 TUPLE_CLASS_BOILERPLATE(EventPostStmt);
2456 std::tuple<EventVariable, std::list<StatOrErrmsg>> t;
2457 };
2458
2459 // R1172 event-wait-stmt ->
2460 // EVENT WAIT ( event-variable [, event-wait-spec-list] )
2461 // R1173 event-wait-spec -> until-spec | sync-stat
2462 // R1174 until-spec -> UNTIL_COUNT = scalar-int-expr
2463 struct EventWaitStmt {
2464 struct EventWaitSpec {
2465 UNION_CLASS_BOILERPLATE(EventWaitSpec);
2466 std::variant<ScalarIntExpr, StatOrErrmsg> u;
2467 };
2468 TUPLE_CLASS_BOILERPLATE(EventWaitStmt);
2469 std::tuple<EventVariable, std::list<EventWaitSpec>> t;
2470 };
2471
2472 // R1177 team-variable -> scalar-variable
2473 using TeamVariable = Scalar<Variable>;
2474
2475 // R1175 form-team-stmt ->
2476 // FORM TEAM ( team-number , team-variable [, form-team-spec-list] )
2477 // R1176 team-number -> scalar-int-expr
2478 // R1178 form-team-spec -> NEW_INDEX = scalar-int-expr | sync-stat
2479 struct FormTeamStmt {
2480 struct FormTeamSpec {
2481 UNION_CLASS_BOILERPLATE(FormTeamSpec);
2482 std::variant<ScalarIntExpr, StatOrErrmsg> u;
2483 };
2484 TUPLE_CLASS_BOILERPLATE(FormTeamStmt);
2485 std::tuple<ScalarIntExpr, TeamVariable, std::list<FormTeamSpec>> t;
2486 };
2487
2488 // R1182 lock-variable -> scalar-variable
2489 using LockVariable = Scalar<Variable>;
2490
2491 // R1179 lock-stmt -> LOCK ( lock-variable [, lock-stat-list] )
2492 // R1180 lock-stat -> ACQUIRED_LOCK = scalar-logical-variable | sync-stat
2493 struct LockStmt {
2494 struct LockStat {
2495 UNION_CLASS_BOILERPLATE(LockStat);
2496 std::variant<Scalar<Logical<Variable>>, StatOrErrmsg> u;
2497 };
2498 TUPLE_CLASS_BOILERPLATE(LockStmt);
2499 std::tuple<LockVariable, std::list<LockStat>> t;
2500 };
2501
2502 // R1181 unlock-stmt -> UNLOCK ( lock-variable [, sync-stat-list] )
2503 struct UnlockStmt {
2504 TUPLE_CLASS_BOILERPLATE(UnlockStmt);
2505 std::tuple<LockVariable, std::list<StatOrErrmsg>> t;
2506 };
2507
2508 // R1202 file-unit-number -> scalar-int-expr
2509 WRAPPER_CLASS(FileUnitNumber, ScalarIntExpr);
2510
2511 // R1201 io-unit -> file-unit-number | * | internal-file-variable
2512 // R1203 internal-file-variable -> char-variable
2513 // R905 char-variable -> variable
2514 // When Variable appears as an IoUnit, it must be character of a default,
2515 // ASCII, or Unicode kind; this constraint is not automatically checked.
2516 // The parse is ambiguous and is repaired if necessary once the types of
2517 // symbols are known.
2518 struct IoUnit {
2519 UNION_CLASS_BOILERPLATE(IoUnit);
2520 std::variant<Variable, FileUnitNumber, Star> u;
2521 };
2522
2523 // R1206 file-name-expr -> scalar-default-char-expr
2524 using FileNameExpr = ScalarDefaultCharExpr;
2525
2526 // R1205 connect-spec ->
2527 // [UNIT =] file-unit-number | ACCESS = scalar-default-char-expr |
2528 // ACTION = scalar-default-char-expr |
2529 // ASYNCHRONOUS = scalar-default-char-expr |
2530 // BLANK = scalar-default-char-expr |
2531 // DECIMAL = scalar-default-char-expr |
2532 // DELIM = scalar-default-char-expr |
2533 // ENCODING = scalar-default-char-expr | ERR = label |
2534 // FILE = file-name-expr | FORM = scalar-default-char-expr |
2535 // IOMSG = iomsg-variable | IOSTAT = scalar-int-variable |
2536 // NEWUNIT = scalar-int-variable | PAD = scalar-default-char-expr |
2537 // POSITION = scalar-default-char-expr | RECL = scalar-int-expr |
2538 // ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr |
2539 // STATUS = scalar-default-char-expr
2540 // @ | CONVERT = scalar-default-char-variable
2541 // | DISPOSE = scalar-default-char-variable
2542 WRAPPER_CLASS(StatusExpr, ScalarDefaultCharExpr);
2543 WRAPPER_CLASS(ErrLabel, Label);
2544
2545 struct ConnectSpec {
2546 UNION_CLASS_BOILERPLATE(ConnectSpec);
2547 struct CharExpr {
2548 ENUM_CLASS(Kind, Access, Action, Asynchronous, Blank, Decimal, Delim,
2549 Encoding, Form, Pad, Position, Round, Sign,
2550 /* extensions: */ Convert, Dispose)
2551 TUPLE_CLASS_BOILERPLATE(CharExpr);
2552 std::tuple<Kind, ScalarDefaultCharExpr> t;
2553 };
2554 WRAPPER_CLASS(Recl, ScalarIntExpr);
2555 WRAPPER_CLASS(Newunit, ScalarIntVariable);
2556 std::variant<FileUnitNumber, FileNameExpr, CharExpr, MsgVariable,
2557 StatVariable, Recl, Newunit, ErrLabel, StatusExpr>
2558 u;
2559 };
2560
2561 // R1204 open-stmt -> OPEN ( connect-spec-list )
2562 WRAPPER_CLASS(OpenStmt, std::list<ConnectSpec>);
2563
2564 // R1208 close-stmt -> CLOSE ( close-spec-list )
2565 // R1209 close-spec ->
2566 // [UNIT =] file-unit-number | IOSTAT = scalar-int-variable |
2567 // IOMSG = iomsg-variable | ERR = label |
2568 // STATUS = scalar-default-char-expr
2569 struct CloseStmt {
2570 struct CloseSpec {
2571 UNION_CLASS_BOILERPLATE(CloseSpec);
2572 std::variant<FileUnitNumber, StatVariable, MsgVariable, ErrLabel,
2573 StatusExpr>
2574 u;
2575 };
2576 WRAPPER_CLASS_BOILERPLATE(CloseStmt, std::list<CloseSpec>);
2577 };
2578
2579 // R1215 format -> default-char-expr | label | *
2580 struct Format {
2581 UNION_CLASS_BOILERPLATE(Format);
2582 std::variant<DefaultCharExpr, Label, Star> u;
2583 };
2584
2585 // R1214 id-variable -> scalar-int-variable
2586 WRAPPER_CLASS(IdVariable, ScalarIntVariable);
2587
2588 // R1213 io-control-spec ->
2589 // [UNIT =] io-unit | [FMT =] format | [NML =] namelist-group-name |
2590 // ADVANCE = scalar-default-char-expr |
2591 // ASYNCHRONOUS = scalar-default-char-constant-expr |
2592 // BLANK = scalar-default-char-expr |
2593 // DECIMAL = scalar-default-char-expr |
2594 // DELIM = scalar-default-char-expr | END = label | EOR = label |
2595 // ERR = label | ID = id-variable | IOMSG = iomsg-variable |
2596 // IOSTAT = scalar-int-variable | PAD = scalar-default-char-expr |
2597 // POS = scalar-int-expr | REC = scalar-int-expr |
2598 // ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr |
2599 // SIZE = scalar-int-variable
2600 WRAPPER_CLASS(EndLabel, Label);
2601 WRAPPER_CLASS(EorLabel, Label);
2602 struct IoControlSpec {
2603 UNION_CLASS_BOILERPLATE(IoControlSpec);
2604 struct CharExpr {
2605 ENUM_CLASS(Kind, Advance, Blank, Decimal, Delim, Pad, Round, Sign)
2606 TUPLE_CLASS_BOILERPLATE(CharExpr);
2607 std::tuple<Kind, ScalarDefaultCharExpr> t;
2608 };
2609 WRAPPER_CLASS(Asynchronous, ScalarDefaultCharConstantExpr);
2610 WRAPPER_CLASS(Pos, ScalarIntExpr);
2611 WRAPPER_CLASS(Rec, ScalarIntExpr);
2612 WRAPPER_CLASS(Size, ScalarIntVariable);
2613 std::variant<IoUnit, Format, Name, CharExpr, Asynchronous, EndLabel, EorLabel,
2614 ErrLabel, IdVariable, MsgVariable, StatVariable, Pos, Rec, Size>
2615 u;
2616 };
2617
2618 // R1216 input-item -> variable | io-implied-do
2619 struct InputItem {
2620 UNION_CLASS_BOILERPLATE(InputItem);
2621 std::variant<Variable, common::Indirection<InputImpliedDo>> u;
2622 };
2623
2624 // R1210 read-stmt ->
2625 // READ ( io-control-spec-list ) [input-item-list] |
2626 // READ format [, input-item-list]
2627 struct ReadStmt {
2628 BOILERPLATE(ReadStmt);
ReadStmtReadStmt2629 ReadStmt(std::optional<IoUnit> &&i, std::optional<Format> &&f,
2630 std::list<IoControlSpec> &&cs, std::list<InputItem> &&its)
2631 : iounit{std::move(i)}, format{std::move(f)}, controls(std::move(cs)),
2632 items(std::move(its)) {}
2633 std::optional<IoUnit> iounit; // if first in controls without UNIT= &/or
2634 // followed by untagged format/namelist
2635 std::optional<Format> format; // if second in controls without FMT=/NML=, or
2636 // no (io-control-spec-list); might be
2637 // an untagged namelist group name
2638 std::list<IoControlSpec> controls;
2639 std::list<InputItem> items;
2640 };
2641
2642 // R1217 output-item -> expr | io-implied-do
2643 struct OutputItem {
2644 UNION_CLASS_BOILERPLATE(OutputItem);
2645 std::variant<Expr, common::Indirection<OutputImpliedDo>> u;
2646 };
2647
2648 // R1211 write-stmt -> WRITE ( io-control-spec-list ) [output-item-list]
2649 struct WriteStmt {
2650 BOILERPLATE(WriteStmt);
WriteStmtWriteStmt2651 WriteStmt(std::optional<IoUnit> &&i, std::optional<Format> &&f,
2652 std::list<IoControlSpec> &&cs, std::list<OutputItem> &&its)
2653 : iounit{std::move(i)}, format{std::move(f)}, controls(std::move(cs)),
2654 items(std::move(its)) {}
2655 std::optional<IoUnit> iounit; // if first in controls without UNIT= &/or
2656 // followed by untagged format/namelist
2657 std::optional<Format> format; // if second in controls without FMT=/NML=;
2658 // might be an untagged namelist group, too
2659 std::list<IoControlSpec> controls;
2660 std::list<OutputItem> items;
2661 };
2662
2663 // R1212 print-stmt PRINT format [, output-item-list]
2664 struct PrintStmt {
2665 TUPLE_CLASS_BOILERPLATE(PrintStmt);
2666 std::tuple<Format, std::list<OutputItem>> t;
2667 };
2668
2669 // R1220 io-implied-do-control ->
2670 // do-variable = scalar-int-expr , scalar-int-expr [, scalar-int-expr]
2671 using IoImpliedDoControl = LoopBounds<DoVariable, ScalarIntExpr>;
2672
2673 // R1218 io-implied-do -> ( io-implied-do-object-list , io-implied-do-control )
2674 // R1219 io-implied-do-object -> input-item | output-item
2675 struct InputImpliedDo {
2676 TUPLE_CLASS_BOILERPLATE(InputImpliedDo);
2677 std::tuple<std::list<InputItem>, IoImpliedDoControl> t;
2678 };
2679
2680 struct OutputImpliedDo {
2681 TUPLE_CLASS_BOILERPLATE(OutputImpliedDo);
2682 std::tuple<std::list<OutputItem>, IoImpliedDoControl> t;
2683 };
2684
2685 // R1223 wait-spec ->
2686 // [UNIT =] file-unit-number | END = label | EOR = label | ERR = label |
2687 // ID = scalar-int-expr | IOMSG = iomsg-variable |
2688 // IOSTAT = scalar-int-variable
2689 WRAPPER_CLASS(IdExpr, ScalarIntExpr);
2690 struct WaitSpec {
2691 UNION_CLASS_BOILERPLATE(WaitSpec);
2692 std::variant<FileUnitNumber, EndLabel, EorLabel, ErrLabel, IdExpr,
2693 MsgVariable, StatVariable>
2694 u;
2695 };
2696
2697 // R1222 wait-stmt -> WAIT ( wait-spec-list )
2698 WRAPPER_CLASS(WaitStmt, std::list<WaitSpec>);
2699
2700 // R1227 position-spec ->
2701 // [UNIT =] file-unit-number | IOMSG = iomsg-variable |
2702 // IOSTAT = scalar-int-variable | ERR = label
2703 // R1229 flush-spec ->
2704 // [UNIT =] file-unit-number | IOSTAT = scalar-int-variable |
2705 // IOMSG = iomsg-variable | ERR = label
2706 struct PositionOrFlushSpec {
2707 UNION_CLASS_BOILERPLATE(PositionOrFlushSpec);
2708 std::variant<FileUnitNumber, MsgVariable, StatVariable, ErrLabel> u;
2709 };
2710
2711 // R1224 backspace-stmt ->
2712 // BACKSPACE file-unit-number | BACKSPACE ( position-spec-list )
2713 WRAPPER_CLASS(BackspaceStmt, std::list<PositionOrFlushSpec>);
2714
2715 // R1225 endfile-stmt ->
2716 // ENDFILE file-unit-number | ENDFILE ( position-spec-list )
2717 WRAPPER_CLASS(EndfileStmt, std::list<PositionOrFlushSpec>);
2718
2719 // R1226 rewind-stmt -> REWIND file-unit-number | REWIND ( position-spec-list )
2720 WRAPPER_CLASS(RewindStmt, std::list<PositionOrFlushSpec>);
2721
2722 // R1228 flush-stmt -> FLUSH file-unit-number | FLUSH ( flush-spec-list )
2723 WRAPPER_CLASS(FlushStmt, std::list<PositionOrFlushSpec>);
2724
2725 // R1231 inquire-spec ->
2726 // [UNIT =] file-unit-number | FILE = file-name-expr |
2727 // ACCESS = scalar-default-char-variable |
2728 // ACTION = scalar-default-char-variable |
2729 // ASYNCHRONOUS = scalar-default-char-variable |
2730 // BLANK = scalar-default-char-variable |
2731 // DECIMAL = scalar-default-char-variable |
2732 // DELIM = scalar-default-char-variable |
2733 // DIRECT = scalar-default-char-variable |
2734 // ENCODING = scalar-default-char-variable |
2735 // ERR = label | EXIST = scalar-logical-variable |
2736 // FORM = scalar-default-char-variable |
2737 // FORMATTED = scalar-default-char-variable |
2738 // ID = scalar-int-expr | IOMSG = iomsg-variable |
2739 // IOSTAT = scalar-int-variable |
2740 // NAME = scalar-default-char-variable |
2741 // NAMED = scalar-logical-variable |
2742 // NEXTREC = scalar-int-variable | NUMBER = scalar-int-variable |
2743 // OPENED = scalar-logical-variable |
2744 // PAD = scalar-default-char-variable |
2745 // PENDING = scalar-logical-variable | POS = scalar-int-variable |
2746 // POSITION = scalar-default-char-variable |
2747 // READ = scalar-default-char-variable |
2748 // READWRITE = scalar-default-char-variable |
2749 // RECL = scalar-int-variable | ROUND = scalar-default-char-variable |
2750 // SEQUENTIAL = scalar-default-char-variable |
2751 // SIGN = scalar-default-char-variable |
2752 // SIZE = scalar-int-variable |
2753 // STREAM = scalar-default-char-variable |
2754 // STATUS = scalar-default-char-variable |
2755 // UNFORMATTED = scalar-default-char-variable |
2756 // WRITE = scalar-default-char-variable
2757 // @ | CONVERT = scalar-default-char-variable
2758 // | DISPOSE = scalar-default-char-variable
2759 struct InquireSpec {
2760 UNION_CLASS_BOILERPLATE(InquireSpec);
2761 struct CharVar {
2762 ENUM_CLASS(Kind, Access, Action, Asynchronous, Blank, Decimal, Delim,
2763 Direct, Encoding, Form, Formatted, Iomsg, Name, Pad, Position, Read,
2764 Readwrite, Round, Sequential, Sign, Stream, Status, Unformatted, Write,
2765 /* extensions: */ Convert, Dispose)
2766 TUPLE_CLASS_BOILERPLATE(CharVar);
2767 std::tuple<Kind, ScalarDefaultCharVariable> t;
2768 };
2769 struct IntVar {
2770 ENUM_CLASS(Kind, Iostat, Nextrec, Number, Pos, Recl, Size)
2771 TUPLE_CLASS_BOILERPLATE(IntVar);
2772 std::tuple<Kind, ScalarIntVariable> t;
2773 };
2774 struct LogVar {
2775 ENUM_CLASS(Kind, Exist, Named, Opened, Pending)
2776 TUPLE_CLASS_BOILERPLATE(LogVar);
2777 std::tuple<Kind, Scalar<Logical<Variable>>> t;
2778 };
2779 std::variant<FileUnitNumber, FileNameExpr, CharVar, IntVar, LogVar, IdExpr,
2780 ErrLabel>
2781 u;
2782 };
2783
2784 // R1230 inquire-stmt ->
2785 // INQUIRE ( inquire-spec-list ) |
2786 // INQUIRE ( IOLENGTH = scalar-int-variable ) output-item-list
2787 struct InquireStmt {
2788 UNION_CLASS_BOILERPLATE(InquireStmt);
2789 struct Iolength {
2790 TUPLE_CLASS_BOILERPLATE(Iolength);
2791 std::tuple<ScalarIntVariable, std::list<OutputItem>> t;
2792 };
2793 std::variant<std::list<InquireSpec>, Iolength> u;
2794 };
2795
2796 // R1301 format-stmt -> FORMAT format-specification
2797 WRAPPER_CLASS(FormatStmt, format::FormatSpecification);
2798
2799 // R1402 program-stmt -> PROGRAM program-name
2800 WRAPPER_CLASS(ProgramStmt, Name);
2801
2802 // R1403 end-program-stmt -> END [PROGRAM [program-name]]
2803 WRAPPER_CLASS(EndProgramStmt, std::optional<Name>);
2804
2805 // R1401 main-program ->
2806 // [program-stmt] [specification-part] [execution-part]
2807 // [internal-subprogram-part] end-program-stmt
2808 struct MainProgram {
2809 TUPLE_CLASS_BOILERPLATE(MainProgram);
2810 std::tuple<std::optional<Statement<ProgramStmt>>, SpecificationPart,
2811 ExecutionPart, std::optional<InternalSubprogramPart>,
2812 Statement<EndProgramStmt>>
2813 t;
2814 };
2815
2816 // R1405 module-stmt -> MODULE module-name
2817 WRAPPER_CLASS(ModuleStmt, Name);
2818
2819 // R1408 module-subprogram ->
2820 // function-subprogram | subroutine-subprogram |
2821 // separate-module-subprogram
2822 struct ModuleSubprogram {
2823 UNION_CLASS_BOILERPLATE(ModuleSubprogram);
2824 std::variant<common::Indirection<FunctionSubprogram>,
2825 common::Indirection<SubroutineSubprogram>,
2826 common::Indirection<SeparateModuleSubprogram>>
2827 u;
2828 };
2829
2830 // R1407 module-subprogram-part -> contains-stmt [module-subprogram]...
2831 struct ModuleSubprogramPart {
2832 TUPLE_CLASS_BOILERPLATE(ModuleSubprogramPart);
2833 std::tuple<Statement<ContainsStmt>, std::list<ModuleSubprogram>> t;
2834 };
2835
2836 // R1406 end-module-stmt -> END [MODULE [module-name]]
2837 WRAPPER_CLASS(EndModuleStmt, std::optional<Name>);
2838
2839 // R1404 module ->
2840 // module-stmt [specification-part] [module-subprogram-part]
2841 // end-module-stmt
2842 struct Module {
2843 TUPLE_CLASS_BOILERPLATE(Module);
2844 std::tuple<Statement<ModuleStmt>, SpecificationPart,
2845 std::optional<ModuleSubprogramPart>, Statement<EndModuleStmt>>
2846 t;
2847 };
2848
2849 // R1411 rename ->
2850 // local-name => use-name |
2851 // OPERATOR ( local-defined-operator ) =>
2852 // OPERATOR ( use-defined-operator )
2853 struct Rename {
2854 UNION_CLASS_BOILERPLATE(Rename);
2855 struct Names {
2856 TUPLE_CLASS_BOILERPLATE(Names);
2857 std::tuple<Name, Name> t;
2858 };
2859 struct Operators {
2860 TUPLE_CLASS_BOILERPLATE(Operators);
2861 std::tuple<DefinedOpName, DefinedOpName> t;
2862 };
2863 std::variant<Names, Operators> u;
2864 };
2865
2866 // R1418 parent-identifier -> ancestor-module-name [: parent-submodule-name]
2867 struct ParentIdentifier {
2868 TUPLE_CLASS_BOILERPLATE(ParentIdentifier);
2869 std::tuple<Name, std::optional<Name>> t;
2870 };
2871
2872 // R1417 submodule-stmt -> SUBMODULE ( parent-identifier ) submodule-name
2873 struct SubmoduleStmt {
2874 TUPLE_CLASS_BOILERPLATE(SubmoduleStmt);
2875 std::tuple<ParentIdentifier, Name> t;
2876 };
2877
2878 // R1419 end-submodule-stmt -> END [SUBMODULE [submodule-name]]
2879 WRAPPER_CLASS(EndSubmoduleStmt, std::optional<Name>);
2880
2881 // R1416 submodule ->
2882 // submodule-stmt [specification-part] [module-subprogram-part]
2883 // end-submodule-stmt
2884 struct Submodule {
2885 TUPLE_CLASS_BOILERPLATE(Submodule);
2886 std::tuple<Statement<SubmoduleStmt>, SpecificationPart,
2887 std::optional<ModuleSubprogramPart>, Statement<EndSubmoduleStmt>>
2888 t;
2889 };
2890
2891 // R1421 block-data-stmt -> BLOCK DATA [block-data-name]
2892 WRAPPER_CLASS(BlockDataStmt, std::optional<Name>);
2893
2894 // R1422 end-block-data-stmt -> END [BLOCK DATA [block-data-name]]
2895 WRAPPER_CLASS(EndBlockDataStmt, std::optional<Name>);
2896
2897 // R1420 block-data -> block-data-stmt [specification-part] end-block-data-stmt
2898 struct BlockData {
2899 TUPLE_CLASS_BOILERPLATE(BlockData);
2900 std::tuple<Statement<BlockDataStmt>, SpecificationPart,
2901 Statement<EndBlockDataStmt>>
2902 t;
2903 };
2904
2905 // R1508 generic-spec ->
2906 // generic-name | OPERATOR ( defined-operator ) |
2907 // ASSIGNMENT ( = ) | defined-io-generic-spec
2908 // R1509 defined-io-generic-spec ->
2909 // READ ( FORMATTED ) | READ ( UNFORMATTED ) |
2910 // WRITE ( FORMATTED ) | WRITE ( UNFORMATTED )
2911 struct GenericSpec {
2912 UNION_CLASS_BOILERPLATE(GenericSpec);
2913 EMPTY_CLASS(Assignment);
2914 EMPTY_CLASS(ReadFormatted);
2915 EMPTY_CLASS(ReadUnformatted);
2916 EMPTY_CLASS(WriteFormatted);
2917 EMPTY_CLASS(WriteUnformatted);
2918 CharBlock source;
2919 std::variant<Name, DefinedOperator, Assignment, ReadFormatted,
2920 ReadUnformatted, WriteFormatted, WriteUnformatted>
2921 u;
2922 };
2923
2924 // R1510 generic-stmt ->
2925 // GENERIC [, access-spec] :: generic-spec => specific-procedure-list
2926 struct GenericStmt {
2927 TUPLE_CLASS_BOILERPLATE(GenericStmt);
2928 std::tuple<std::optional<AccessSpec>, GenericSpec, std::list<Name>> t;
2929 };
2930
2931 // R1503 interface-stmt -> INTERFACE [generic-spec] | ABSTRACT INTERFACE
2932 struct InterfaceStmt {
2933 UNION_CLASS_BOILERPLATE(InterfaceStmt);
2934 // Workaround for clang with libstc++10 bug
InterfaceStmtInterfaceStmt2935 InterfaceStmt(Abstract x) : u{x} {}
2936
2937 std::variant<std::optional<GenericSpec>, Abstract> u;
2938 };
2939
2940 // R1412 only -> generic-spec | only-use-name | rename
2941 // R1413 only-use-name -> use-name
2942 struct Only {
2943 UNION_CLASS_BOILERPLATE(Only);
2944 std::variant<common::Indirection<GenericSpec>, Name, Rename> u;
2945 };
2946
2947 // R1409 use-stmt ->
2948 // USE [[, module-nature] ::] module-name [, rename-list] |
2949 // USE [[, module-nature] ::] module-name , ONLY : [only-list]
2950 // R1410 module-nature -> INTRINSIC | NON_INTRINSIC
2951 struct UseStmt {
2952 BOILERPLATE(UseStmt);
ENUM_CLASSUseStmt2953 ENUM_CLASS(ModuleNature, Intrinsic, Non_Intrinsic) // R1410
2954 template<typename A>
2955 UseStmt(std::optional<ModuleNature> &&nat, Name &&n, std::list<A> &&x)
2956 : nature(std::move(nat)), moduleName(std::move(n)), u(std::move(x)) {}
2957 std::optional<ModuleNature> nature;
2958 Name moduleName;
2959 std::variant<std::list<Rename>, std::list<Only>> u;
2960 };
2961
2962 // R1514 proc-attr-spec ->
2963 // access-spec | proc-language-binding-spec | INTENT ( intent-spec ) |
2964 // OPTIONAL | POINTER | PROTECTED | SAVE
2965 struct ProcAttrSpec {
2966 UNION_CLASS_BOILERPLATE(ProcAttrSpec);
2967 std::variant<AccessSpec, LanguageBindingSpec, IntentSpec, Optional, Pointer,
2968 Protected, Save>
2969 u;
2970 };
2971
2972 // R1512 procedure-declaration-stmt ->
2973 // PROCEDURE ( [proc-interface] ) [[, proc-attr-spec]... ::]
2974 // proc-decl-list
2975 struct ProcedureDeclarationStmt {
2976 TUPLE_CLASS_BOILERPLATE(ProcedureDeclarationStmt);
2977 std::tuple<std::optional<ProcInterface>, std::list<ProcAttrSpec>,
2978 std::list<ProcDecl>>
2979 t;
2980 };
2981
2982 // R1527 prefix-spec ->
2983 // declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
2984 // NON_RECURSIVE | PURE | RECURSIVE
2985 struct PrefixSpec {
2986 UNION_CLASS_BOILERPLATE(PrefixSpec);
2987 EMPTY_CLASS(Elemental);
2988 EMPTY_CLASS(Impure);
2989 EMPTY_CLASS(Module);
2990 EMPTY_CLASS(Non_Recursive);
2991 EMPTY_CLASS(Pure);
2992 EMPTY_CLASS(Recursive);
2993 std::variant<DeclarationTypeSpec, Elemental, Impure, Module, Non_Recursive,
2994 Pure, Recursive>
2995 u;
2996 };
2997
2998 // R1532 suffix ->
2999 // proc-language-binding-spec [RESULT ( result-name )] |
3000 // RESULT ( result-name ) [proc-language-binding-spec]
3001 struct Suffix {
3002 BOILERPLATE(Suffix);
SuffixSuffix3003 Suffix(LanguageBindingSpec &&lbs, std::optional<Name> &&rn)
3004 : binding(std::move(lbs)), resultName(std::move(rn)) {}
SuffixSuffix3005 Suffix(Name &&rn, std::optional<LanguageBindingSpec> &&lbs)
3006 : binding(std::move(lbs)), resultName(std::move(rn)) {}
3007 std::optional<LanguageBindingSpec> binding;
3008 std::optional<Name> resultName;
3009 };
3010
3011 // R1530 function-stmt ->
3012 // [prefix] FUNCTION function-name ( [dummy-arg-name-list] ) [suffix]
3013 // R1526 prefix -> prefix-spec [prefix-spec]...
3014 // R1531 dummy-arg-name -> name
3015 struct FunctionStmt {
3016 TUPLE_CLASS_BOILERPLATE(FunctionStmt);
3017 std::tuple<std::list<PrefixSpec>, Name, std::list<Name>,
3018 std::optional<Suffix>>
3019 t;
3020 };
3021
3022 // R1533 end-function-stmt -> END [FUNCTION [function-name]]
3023 WRAPPER_CLASS(EndFunctionStmt, std::optional<Name>);
3024
3025 // R1536 dummy-arg -> dummy-arg-name | *
3026 struct DummyArg {
3027 UNION_CLASS_BOILERPLATE(DummyArg);
3028 std::variant<Name, Star> u;
3029 };
3030
3031 // R1535 subroutine-stmt ->
3032 // [prefix] SUBROUTINE subroutine-name [( [dummy-arg-list] )
3033 // [proc-language-binding-spec]]
3034 struct SubroutineStmt {
3035 TUPLE_CLASS_BOILERPLATE(SubroutineStmt);
3036 std::tuple<std::list<PrefixSpec>, Name, std::list<DummyArg>,
3037 std::optional<LanguageBindingSpec>>
3038 t;
3039 };
3040
3041 // R1537 end-subroutine-stmt -> END [SUBROUTINE [subroutine-name]]
3042 WRAPPER_CLASS(EndSubroutineStmt, std::optional<Name>);
3043
3044 // R1505 interface-body ->
3045 // function-stmt [specification-part] end-function-stmt |
3046 // subroutine-stmt [specification-part] end-subroutine-stmt
3047 struct InterfaceBody {
3048 UNION_CLASS_BOILERPLATE(InterfaceBody);
3049 struct Function {
3050 TUPLE_CLASS_BOILERPLATE(Function);
3051 std::tuple<Statement<FunctionStmt>, common::Indirection<SpecificationPart>,
3052 Statement<EndFunctionStmt>>
3053 t;
3054 };
3055 struct Subroutine {
3056 TUPLE_CLASS_BOILERPLATE(Subroutine);
3057 std::tuple<Statement<SubroutineStmt>,
3058 common::Indirection<SpecificationPart>, Statement<EndSubroutineStmt>>
3059 t;
3060 };
3061 std::variant<Function, Subroutine> u;
3062 };
3063
3064 // R1506 procedure-stmt -> [MODULE] PROCEDURE [::] specific-procedure-list
3065 struct ProcedureStmt {
3066 ENUM_CLASS(Kind, ModuleProcedure, Procedure)
3067 TUPLE_CLASS_BOILERPLATE(ProcedureStmt);
3068 std::tuple<Kind, std::list<Name>> t;
3069 };
3070
3071 // R1502 interface-specification -> interface-body | procedure-stmt
3072 struct InterfaceSpecification {
3073 UNION_CLASS_BOILERPLATE(InterfaceSpecification);
3074 std::variant<InterfaceBody, Statement<ProcedureStmt>> u;
3075 };
3076
3077 // R1504 end-interface-stmt -> END INTERFACE [generic-spec]
3078 WRAPPER_CLASS(EndInterfaceStmt, std::optional<GenericSpec>);
3079
3080 // R1501 interface-block ->
3081 // interface-stmt [interface-specification]... end-interface-stmt
3082 struct InterfaceBlock {
3083 TUPLE_CLASS_BOILERPLATE(InterfaceBlock);
3084 std::tuple<Statement<InterfaceStmt>, std::list<InterfaceSpecification>,
3085 Statement<EndInterfaceStmt>>
3086 t;
3087 };
3088
3089 // R1511 external-stmt -> EXTERNAL [::] external-name-list
3090 WRAPPER_CLASS(ExternalStmt, std::list<Name>);
3091
3092 // R1519 intrinsic-stmt -> INTRINSIC [::] intrinsic-procedure-name-list
3093 WRAPPER_CLASS(IntrinsicStmt, std::list<Name>);
3094
3095 // R1522 procedure-designator ->
3096 // procedure-name | proc-component-ref | data-ref % binding-name
3097 struct ProcedureDesignator {
3098 UNION_CLASS_BOILERPLATE(ProcedureDesignator);
3099 std::variant<Name, ProcComponentRef> u;
3100 };
3101
3102 // R1525 alt-return-spec -> * label
3103 WRAPPER_CLASS(AltReturnSpec, Label);
3104
3105 // R1524 actual-arg ->
3106 // expr | variable | procedure-name | proc-component-ref |
3107 // alt-return-spec
3108 struct ActualArg {
3109 WRAPPER_CLASS(PercentRef, Variable); // %REF(v) extension
3110 WRAPPER_CLASS(PercentVal, Expr); // %VAL(x) extension
3111 UNION_CLASS_BOILERPLATE(ActualArg);
ActualArgActualArg3112 ActualArg(Expr &&x) : u{common::Indirection<Expr>(std::move(x))} {}
3113 std::variant<common::Indirection<Expr>, AltReturnSpec, PercentRef, PercentVal>
3114 u;
3115 };
3116
3117 // R1523 actual-arg-spec -> [keyword =] actual-arg
3118 struct ActualArgSpec {
3119 TUPLE_CLASS_BOILERPLATE(ActualArgSpec);
3120 std::tuple<std::optional<Keyword>, ActualArg> t;
3121 };
3122
3123 // R1520 function-reference -> procedure-designator ( [actual-arg-spec-list] )
3124 struct Call {
3125 TUPLE_CLASS_BOILERPLATE(Call);
3126 CharBlock source;
3127 std::tuple<ProcedureDesignator, std::list<ActualArgSpec>> t;
3128 };
3129
3130 struct FunctionReference {
3131 WRAPPER_CLASS_BOILERPLATE(FunctionReference, Call);
3132 Designator ConvertToArrayElementRef();
3133 StructureConstructor ConvertToStructureConstructor(
3134 const semantics::DerivedTypeSpec &);
3135 };
3136
3137 // R1521 call-stmt -> CALL procedure-designator [( [actual-arg-spec-list] )]
3138 WRAPPER_CLASS(CallStmt, Call);
3139
3140 // R1529 function-subprogram ->
3141 // function-stmt [specification-part] [execution-part]
3142 // [internal-subprogram-part] end-function-stmt
3143 struct FunctionSubprogram {
3144 TUPLE_CLASS_BOILERPLATE(FunctionSubprogram);
3145 std::tuple<Statement<FunctionStmt>, SpecificationPart, ExecutionPart,
3146 std::optional<InternalSubprogramPart>, Statement<EndFunctionStmt>>
3147 t;
3148 };
3149
3150 // R1534 subroutine-subprogram ->
3151 // subroutine-stmt [specification-part] [execution-part]
3152 // [internal-subprogram-part] end-subroutine-stmt
3153 struct SubroutineSubprogram {
3154 TUPLE_CLASS_BOILERPLATE(SubroutineSubprogram);
3155 std::tuple<Statement<SubroutineStmt>, SpecificationPart, ExecutionPart,
3156 std::optional<InternalSubprogramPart>, Statement<EndSubroutineStmt>>
3157 t;
3158 };
3159
3160 // R1539 mp-subprogram-stmt -> MODULE PROCEDURE procedure-name
3161 WRAPPER_CLASS(MpSubprogramStmt, Name);
3162
3163 // R1540 end-mp-subprogram-stmt -> END [PROCEDURE [procedure-name]]
3164 WRAPPER_CLASS(EndMpSubprogramStmt, std::optional<Name>);
3165
3166 // R1538 separate-module-subprogram ->
3167 // mp-subprogram-stmt [specification-part] [execution-part]
3168 // [internal-subprogram-part] end-mp-subprogram-stmt
3169 struct SeparateModuleSubprogram {
3170 TUPLE_CLASS_BOILERPLATE(SeparateModuleSubprogram);
3171 std::tuple<Statement<MpSubprogramStmt>, SpecificationPart, ExecutionPart,
3172 std::optional<InternalSubprogramPart>, Statement<EndMpSubprogramStmt>>
3173 t;
3174 };
3175
3176 // R1541 entry-stmt -> ENTRY entry-name [( [dummy-arg-list] ) [suffix]]
3177 struct EntryStmt {
3178 TUPLE_CLASS_BOILERPLATE(EntryStmt);
3179 std::tuple<Name, std::list<DummyArg>, std::optional<Suffix>> t;
3180 };
3181
3182 // R1542 return-stmt -> RETURN [scalar-int-expr]
3183 WRAPPER_CLASS(ReturnStmt, std::optional<ScalarIntExpr>);
3184
3185 // R1544 stmt-function-stmt ->
3186 // function-name ( [dummy-arg-name-list] ) = scalar-expr
3187 struct StmtFunctionStmt {
3188 TUPLE_CLASS_BOILERPLATE(StmtFunctionStmt);
3189 std::tuple<Name, std::list<Name>, Scalar<Expr>> t;
3190 Statement<ActionStmt> ConvertToAssignment();
3191 };
3192
3193 // Compiler directives
3194 // !DIR$ IGNORE_TKR [ [(tkr...)] name ]...
3195 // !DIR$ name...
3196 struct CompilerDirective {
3197 UNION_CLASS_BOILERPLATE(CompilerDirective);
3198 struct IgnoreTKR {
3199 TUPLE_CLASS_BOILERPLATE(IgnoreTKR);
3200 std::tuple<std::list<const char *>, Name> t;
3201 };
3202 CharBlock source;
3203 std::variant<std::list<IgnoreTKR>, std::list<Name>> u;
3204 };
3205
3206 // Legacy extensions
3207 struct BasedPointer {
3208 TUPLE_CLASS_BOILERPLATE(BasedPointer);
3209 std::tuple<ObjectName, ObjectName, std::optional<ArraySpec>> t;
3210 };
3211 WRAPPER_CLASS(BasedPointerStmt, std::list<BasedPointer>);
3212
3213 struct Union;
3214 struct StructureDef;
3215
3216 struct StructureField {
3217 UNION_CLASS_BOILERPLATE(StructureField);
3218 std::variant<Statement<DataComponentDefStmt>,
3219 common::Indirection<StructureDef>, common::Indirection<Union>>
3220 u;
3221 };
3222
3223 struct Map {
3224 EMPTY_CLASS(MapStmt);
3225 EMPTY_CLASS(EndMapStmt);
3226 TUPLE_CLASS_BOILERPLATE(Map);
3227 std::tuple<Statement<MapStmt>, std::list<StructureField>,
3228 Statement<EndMapStmt>>
3229 t;
3230 };
3231
3232 struct Union {
3233 EMPTY_CLASS(UnionStmt);
3234 EMPTY_CLASS(EndUnionStmt);
3235 TUPLE_CLASS_BOILERPLATE(Union);
3236 std::tuple<Statement<UnionStmt>, std::list<Map>, Statement<EndUnionStmt>> t;
3237 };
3238
3239 struct StructureStmt {
3240 TUPLE_CLASS_BOILERPLATE(StructureStmt);
3241 std::tuple<Name, bool /*slashes*/, std::list<EntityDecl>> t;
3242 };
3243
3244 struct StructureDef {
3245 EMPTY_CLASS(EndStructureStmt);
3246 TUPLE_CLASS_BOILERPLATE(StructureDef);
3247 std::tuple<Statement<StructureStmt>, std::list<StructureField>,
3248 Statement<EndStructureStmt>>
3249 t;
3250 };
3251
3252 // Old style PARAMETER statement without parentheses.
3253 // Types are determined entirely from the right-hand sides, not the names.
3254 WRAPPER_CLASS(OldParameterStmt, std::list<NamedConstantDef>);
3255
3256 // Deprecations
3257 struct ArithmeticIfStmt {
3258 TUPLE_CLASS_BOILERPLATE(ArithmeticIfStmt);
3259 std::tuple<Expr, Label, Label, Label> t;
3260 };
3261
3262 struct AssignStmt {
3263 TUPLE_CLASS_BOILERPLATE(AssignStmt);
3264 std::tuple<Label, Name> t;
3265 };
3266
3267 struct AssignedGotoStmt {
3268 TUPLE_CLASS_BOILERPLATE(AssignedGotoStmt);
3269 std::tuple<Name, std::list<Label>> t;
3270 };
3271
3272 WRAPPER_CLASS(PauseStmt, std::optional<StopCode>);
3273
3274 // Parse tree nodes for OpenMP 4.5 directives and clauses
3275
3276 // 2.5 proc-bind-clause -> PROC_BIND (MASTER | CLOSE | SPREAD)
3277 struct OmpProcBindClause {
3278 ENUM_CLASS(Type, Close, Master, Spread)
3279 WRAPPER_CLASS_BOILERPLATE(OmpProcBindClause, Type);
3280 };
3281
3282 // 2.15.3.1 default-clause -> DEFAULT (PRIVATE | FIRSTPRIVATE | SHARED | NONE)
3283 struct OmpDefaultClause {
3284 ENUM_CLASS(Type, Private, Firstprivate, Shared, None)
3285 WRAPPER_CLASS_BOILERPLATE(OmpDefaultClause, Type);
3286 };
3287
3288 // 2.1 Directives or clauses may accept a list or extended-list.
3289 // A list item is a variable, array section or common block name (enclosed
3290 // in slashes). An extended list item is a list item or a procedure Name.
3291 // variable-name | / common-block / | array-sections
3292 struct OmpObject {
3293 UNION_CLASS_BOILERPLATE(OmpObject);
3294 std::variant<Designator, /*common block*/ Name> u;
3295 };
3296
3297 WRAPPER_CLASS(OmpObjectList, std::list<OmpObject>);
3298
3299 // 2.15.5.1 map-type -> TO | FROM | TOFROM | ALLOC | RELEASE | DELETE
3300 struct OmpMapType {
3301 TUPLE_CLASS_BOILERPLATE(OmpMapType);
3302 EMPTY_CLASS(Always);
3303 ENUM_CLASS(Type, To, From, Tofrom, Alloc, Release, Delete)
3304 std::tuple<std::optional<Always>, Type> t;
3305 };
3306
3307 // 2.15.5.1 map -> MAP ([ [ALWAYS[,]] map-type : ] variable-name-list)
3308 struct OmpMapClause {
3309 TUPLE_CLASS_BOILERPLATE(OmpMapClause);
3310 std::tuple<std::optional<OmpMapType>, OmpObjectList> t;
3311 };
3312
3313 // 2.15.5.2 defaultmap -> DEFAULTMAP (implicit-behavior[:variable-category])
3314 struct OmpDefaultmapClause {
3315 TUPLE_CLASS_BOILERPLATE(OmpDefaultmapClause);
3316 ENUM_CLASS(ImplicitBehavior, Tofrom)
3317 ENUM_CLASS(VariableCategory, Scalar)
3318 std::tuple<ImplicitBehavior, std::optional<VariableCategory>> t;
3319 };
3320
3321 // 2.7.1 sched-modifier -> MONOTONIC | NONMONOTONIC | SIMD
3322 struct OmpScheduleModifierType {
3323 ENUM_CLASS(ModType, Monotonic, Nonmonotonic, Simd)
3324 WRAPPER_CLASS_BOILERPLATE(OmpScheduleModifierType, ModType);
3325 };
3326
3327 struct OmpScheduleModifier {
3328 TUPLE_CLASS_BOILERPLATE(OmpScheduleModifier);
3329 WRAPPER_CLASS(Modifier1, OmpScheduleModifierType);
3330 WRAPPER_CLASS(Modifier2, OmpScheduleModifierType);
3331 std::tuple<Modifier1, std::optional<Modifier2>> t;
3332 };
3333
3334 // 2.7.1 schedule-clause -> SCHEDULE ([sched-modifier1] [, sched-modifier2]:]
3335 // kind[, chunk_size])
3336 struct OmpScheduleClause {
3337 TUPLE_CLASS_BOILERPLATE(OmpScheduleClause);
3338 ENUM_CLASS(ScheduleType, Static, Dynamic, Guided, Auto, Runtime)
3339 std::tuple<std::optional<OmpScheduleModifier>, ScheduleType,
3340 std::optional<ScalarIntExpr>>
3341 t;
3342 };
3343
3344 // 2.12 if-clause -> IF ([ directive-name-modifier :] scalar-logical-expr)
3345 struct OmpIfClause {
3346 TUPLE_CLASS_BOILERPLATE(OmpIfClause);
3347 ENUM_CLASS(DirectiveNameModifier, Parallel, Target, TargetEnterData,
3348 TargetExitData, TargetData, TargetUpdate, Taskloop, Task)
3349 std::tuple<std::optional<DirectiveNameModifier>, ScalarLogicalExpr> t;
3350 };
3351
3352 // 2.8.1 aligned-clause -> ALIGNED (variable-name-list[ : scalar-constant])
3353 struct OmpAlignedClause {
3354 TUPLE_CLASS_BOILERPLATE(OmpAlignedClause);
3355 std::tuple<std::list<Name>, std::optional<ScalarIntConstantExpr>> t;
3356 };
3357
3358 // 2.15.3.7 linear-modifier -> REF | VAL | UVAL
3359 struct OmpLinearModifier {
3360 ENUM_CLASS(Type, Ref, Val, Uval)
3361 WRAPPER_CLASS_BOILERPLATE(OmpLinearModifier, Type);
3362 };
3363
3364 // 2.15.3.7 linear-clause -> LINEAR (linear-list[ : linear-step])
3365 // linear-list -> list | linear-modifier(list)
3366 struct OmpLinearClause {
3367 UNION_CLASS_BOILERPLATE(OmpLinearClause);
3368 struct WithModifier {
3369 BOILERPLATE(WithModifier);
WithModifierOmpLinearClause::WithModifier3370 WithModifier(OmpLinearModifier &&m, std::list<Name> &&n,
3371 std::optional<ScalarIntConstantExpr> &&s)
3372 : modifier(std::move(m)), names(std::move(n)), step(std::move(s)) {}
3373 OmpLinearModifier modifier;
3374 std::list<Name> names;
3375 std::optional<ScalarIntConstantExpr> step;
3376 };
3377 struct WithoutModifier {
3378 BOILERPLATE(WithoutModifier);
WithoutModifierOmpLinearClause::WithoutModifier3379 WithoutModifier(
3380 std::list<Name> &&n, std::optional<ScalarIntConstantExpr> &&s)
3381 : names(std::move(n)), step(std::move(s)) {}
3382 std::list<Name> names;
3383 std::optional<ScalarIntConstantExpr> step;
3384 };
3385 std::variant<WithModifier, WithoutModifier> u;
3386 };
3387
3388 // 2.15.3.6 reduction-identifier -> + | - | * | .AND. | .OR. | .EQV. | .NEQV. |
3389 // MAX | MIN | IAND | IOR | IEOR
3390 struct OmpReductionOperator {
3391 UNION_CLASS_BOILERPLATE(OmpReductionOperator);
3392 std::variant<DefinedOperator, ProcedureDesignator> u;
3393 };
3394
3395 // 2.15.3.6 reduction-clause -> REDUCTION (reduction-identifier:
3396 // variable-name-list)
3397 struct OmpReductionClause {
3398 TUPLE_CLASS_BOILERPLATE(OmpReductionClause);
3399 std::tuple<OmpReductionOperator, std::list<Designator>> t;
3400 };
3401
3402 // 2.13.9 depend-vec-length -> +/- non-negative-constant
3403 struct OmpDependSinkVecLength {
3404 TUPLE_CLASS_BOILERPLATE(OmpDependSinkVecLength);
3405 std::tuple<DefinedOperator, ScalarIntConstantExpr> t;
3406 };
3407
3408 // 2.13.9 depend-vec -> iterator [+/- depend-vec-length],...,iterator[...]
3409 struct OmpDependSinkVec {
3410 TUPLE_CLASS_BOILERPLATE(OmpDependSinkVec);
3411 std::tuple<Name, std::optional<OmpDependSinkVecLength>> t;
3412 };
3413
3414 // 2.13.9 depend-type -> IN | OUT | INOUT | SOURCE | SINK
3415 struct OmpDependenceType {
3416 ENUM_CLASS(Type, In, Out, Inout, Source, Sink)
3417 WRAPPER_CLASS_BOILERPLATE(OmpDependenceType, Type);
3418 };
3419
3420 // 2.13.9 depend-clause -> DEPEND (((IN | OUT | INOUT) : variable-name-list) |
3421 // SOURCE | SINK : depend-vec)
3422 struct OmpDependClause {
3423 UNION_CLASS_BOILERPLATE(OmpDependClause);
3424 EMPTY_CLASS(Source);
3425 WRAPPER_CLASS(Sink, std::list<OmpDependSinkVec>);
3426 struct InOut {
3427 TUPLE_CLASS_BOILERPLATE(InOut);
3428 std::tuple<OmpDependenceType, std::list<Designator>> t;
3429 };
3430 std::variant<Source, Sink, InOut> u;
3431 };
3432
3433 // 2.7.1 nowait-clause -> NOWAIT
3434 EMPTY_CLASS(OmpNowait);
3435
3436 // OpenMP Clauses
3437 struct OmpClause {
3438 UNION_CLASS_BOILERPLATE(OmpClause);
3439 EMPTY_CLASS(Inbranch);
3440 EMPTY_CLASS(Mergeable);
3441 EMPTY_CLASS(Nogroup);
3442 EMPTY_CLASS(Notinbranch);
3443 EMPTY_CLASS(Simd);
3444 EMPTY_CLASS(Threads);
3445 EMPTY_CLASS(Untied);
3446 WRAPPER_CLASS(Collapse, ScalarIntConstantExpr);
3447 WRAPPER_CLASS(Copyin, OmpObjectList);
3448 WRAPPER_CLASS(Copyprivate, OmpObjectList);
3449 WRAPPER_CLASS(Device, ScalarIntExpr);
3450 WRAPPER_CLASS(DistSchedule, std::optional<ScalarIntExpr>);
3451 WRAPPER_CLASS(Final, ScalarLogicalExpr);
3452 WRAPPER_CLASS(Firstprivate, OmpObjectList);
3453 WRAPPER_CLASS(From, OmpObjectList);
3454 WRAPPER_CLASS(Grainsize, ScalarIntExpr);
3455 WRAPPER_CLASS(IsDevicePtr, std::list<Name>);
3456 WRAPPER_CLASS(Lastprivate, OmpObjectList);
3457 WRAPPER_CLASS(Link, OmpObjectList);
3458 WRAPPER_CLASS(NumTasks, ScalarIntExpr);
3459 WRAPPER_CLASS(NumTeams, ScalarIntExpr);
3460 WRAPPER_CLASS(NumThreads, ScalarIntExpr);
3461 WRAPPER_CLASS(Ordered, std::optional<ScalarIntConstantExpr>);
3462 WRAPPER_CLASS(Priority, ScalarIntExpr);
3463 WRAPPER_CLASS(Private, OmpObjectList);
3464 WRAPPER_CLASS(Safelen, ScalarIntConstantExpr);
3465 WRAPPER_CLASS(Shared, OmpObjectList);
3466 WRAPPER_CLASS(Simdlen, ScalarIntConstantExpr);
3467 WRAPPER_CLASS(ThreadLimit, ScalarIntExpr);
3468 WRAPPER_CLASS(To, OmpObjectList);
3469 WRAPPER_CLASS(Uniform, std::list<Name>);
3470 WRAPPER_CLASS(UseDevicePtr, std::list<Name>);
3471 CharBlock source;
3472 std::variant<Inbranch, Mergeable, Nogroup, Notinbranch, OmpNowait, Untied,
3473 Threads, Simd, Collapse, Copyin, Copyprivate, Device, DistSchedule, Final,
3474 Firstprivate, From, Grainsize, Lastprivate, NumTasks, NumTeams,
3475 NumThreads, Ordered, Priority, Private, Safelen, Shared, Simdlen,
3476 ThreadLimit, To, Link, Uniform, UseDevicePtr, IsDevicePtr,
3477 OmpAlignedClause, OmpDefaultClause, OmpDefaultmapClause, OmpDependClause,
3478 OmpIfClause, OmpLinearClause, OmpMapClause, OmpProcBindClause,
3479 OmpReductionClause, OmpScheduleClause>
3480 u;
3481 };
3482
3483 struct OmpClauseList {
3484 WRAPPER_CLASS_BOILERPLATE(OmpClauseList, std::list<OmpClause>);
3485 CharBlock source;
3486 };
3487
3488 // 2.7.2 SECTIONS
3489 // 2.11.2 PARALLEL SECTIONS
3490 struct OmpSectionsDirective {
3491 ENUM_CLASS(Directive, Sections, ParallelSections);
3492 WRAPPER_CLASS_BOILERPLATE(OmpSectionsDirective, Directive);
3493 CharBlock source;
3494 };
3495
3496 struct OmpBeginSectionsDirective {
3497 TUPLE_CLASS_BOILERPLATE(OmpBeginSectionsDirective);
3498 std::tuple<OmpSectionsDirective, OmpClauseList> t;
3499 };
3500 struct OmpEndSectionsDirective {
3501 TUPLE_CLASS_BOILERPLATE(OmpEndSectionsDirective);
3502 std::tuple<OmpSectionsDirective, OmpClauseList> t;
3503 };
3504
3505 // [!$omp section]
3506 // structured-block
3507 // [!$omp section
3508 // structured-block]
3509 // ...
3510 WRAPPER_CLASS(OmpSectionBlocks, std::list<Block>);
3511
3512 struct OpenMPSectionsConstruct {
3513 TUPLE_CLASS_BOILERPLATE(OpenMPSectionsConstruct);
3514 std::tuple<OmpBeginSectionsDirective, OmpSectionBlocks,
3515 OmpEndSectionsDirective>
3516 t;
3517 };
3518
3519 // OpenMP directive beginning or ending a block
3520 struct OmpBlockDirective {
3521 ENUM_CLASS(Directive, Master, Ordered, Parallel, ParallelWorkshare, Single,
3522 Target, TargetData, TargetParallel, TargetTeams, Task, Taskgroup, Teams,
3523 Workshare);
3524 WRAPPER_CLASS_BOILERPLATE(OmpBlockDirective, Directive);
3525 CharBlock source;
3526 };
3527
3528 // 2.10.6 declare-target -> DECLARE TARGET (extended-list) |
3529 // DECLARE TARGET [declare-target-clause[ [,]
3530 // declare-target-clause]...]
3531 struct OmpDeclareTargetWithList {
3532 WRAPPER_CLASS_BOILERPLATE(OmpDeclareTargetWithList, OmpObjectList);
3533 CharBlock source;
3534 };
3535
3536 struct OmpDeclareTargetWithClause {
3537 WRAPPER_CLASS_BOILERPLATE(OmpDeclareTargetWithClause, OmpClauseList);
3538 CharBlock source;
3539 };
3540
3541 struct OmpDeclareTargetSpecifier {
3542 UNION_CLASS_BOILERPLATE(OmpDeclareTargetSpecifier);
3543 std::variant<OmpDeclareTargetWithList, OmpDeclareTargetWithClause> u;
3544 };
3545
3546 struct OpenMPDeclareTargetConstruct {
3547 TUPLE_CLASS_BOILERPLATE(OpenMPDeclareTargetConstruct);
3548 CharBlock source;
3549 std::tuple<Verbatim, OmpDeclareTargetSpecifier> t;
3550 };
3551
3552 // 2.16 declare-reduction -> DECLARE REDUCTION (reduction-identifier : type-list
3553 // : combiner) [initializer-clause]
3554 struct OmpReductionCombiner {
3555 UNION_CLASS_BOILERPLATE(OmpReductionCombiner);
3556 WRAPPER_CLASS(FunctionCombiner, Call);
3557 std::variant<AssignmentStmt, FunctionCombiner> u;
3558 };
3559
3560 WRAPPER_CLASS(OmpReductionInitializerClause, Expr);
3561
3562 struct OpenMPDeclareReductionConstruct {
3563 TUPLE_CLASS_BOILERPLATE(OpenMPDeclareReductionConstruct);
3564 CharBlock source;
3565 std::tuple<Verbatim, OmpReductionOperator, std::list<DeclarationTypeSpec>,
3566 OmpReductionCombiner, std::optional<OmpReductionInitializerClause>>
3567 t;
3568 };
3569
3570 // 2.8.2 declare-simd -> DECLARE SIMD [(proc-name)] [declare-simd-clause[ [,]
3571 // declare-simd-clause]...]
3572 struct OpenMPDeclareSimdConstruct {
3573 TUPLE_CLASS_BOILERPLATE(OpenMPDeclareSimdConstruct);
3574 CharBlock source;
3575 std::tuple<Verbatim, std::optional<Name>, OmpClauseList> t;
3576 };
3577
3578 // 2.15.2 threadprivate -> THREADPRIVATE (variable-name-list)
3579 struct OpenMPThreadprivate {
3580 TUPLE_CLASS_BOILERPLATE(OpenMPThreadprivate);
3581 CharBlock source;
3582 std::tuple<Verbatim, OmpObjectList> t;
3583 };
3584
3585 struct OpenMPDeclarativeConstruct {
3586 UNION_CLASS_BOILERPLATE(OpenMPDeclarativeConstruct);
3587 CharBlock source;
3588 std::variant<OpenMPDeclareReductionConstruct, OpenMPDeclareSimdConstruct,
3589 OpenMPDeclareTargetConstruct, OpenMPThreadprivate>
3590 u;
3591 };
3592
3593 // 2.13.2 CRITICAL [Name] <block> END CRITICAL [Name]
3594 struct OmpCriticalDirective {
3595 TUPLE_CLASS_BOILERPLATE(OmpCriticalDirective);
3596 WRAPPER_CLASS(Hint, ConstantExpr);
3597 CharBlock source;
3598 std::tuple<Verbatim, std::optional<Name>, std::optional<Hint>> t;
3599 };
3600 struct OmpEndCriticalDirective {
3601 TUPLE_CLASS_BOILERPLATE(OmpEndCriticalDirective);
3602 CharBlock source;
3603 std::tuple<Verbatim, std::optional<Name>> t;
3604 };
3605 struct OpenMPCriticalConstruct {
3606 TUPLE_CLASS_BOILERPLATE(OpenMPCriticalConstruct);
3607 std::tuple<OmpCriticalDirective, Block, OmpEndCriticalDirective> t;
3608 };
3609
3610 // 2.13.6 atomic -> ATOMIC [seq_cst[,]] atomic-clause [[,]seq_cst] |
3611 // ATOMIC [seq_cst]
3612 // atomic-clause -> READ | WRITE | UPDATE | CAPTURE
3613
3614 // END ATOMIC
3615 EMPTY_CLASS(OmpEndAtomic);
3616
3617 // ATOMIC Memory related clause
3618 struct OmpMemoryClause {
3619 ENUM_CLASS(MemoryOrder, SeqCst)
3620 WRAPPER_CLASS_BOILERPLATE(OmpMemoryClause, MemoryOrder);
3621 CharBlock source;
3622 };
3623
3624 WRAPPER_CLASS(OmpMemoryClauseList, std::list<OmpMemoryClause>);
3625 WRAPPER_CLASS(OmpMemoryClausePostList, std::list<OmpMemoryClause>);
3626
3627 // ATOMIC READ
3628 struct OmpAtomicRead {
3629 TUPLE_CLASS_BOILERPLATE(OmpAtomicRead);
3630 std::tuple<OmpMemoryClauseList, Verbatim, OmpMemoryClausePostList,
3631 Statement<AssignmentStmt>, std::optional<OmpEndAtomic>>
3632 t;
3633 };
3634
3635 // ATOMIC WRITE
3636 struct OmpAtomicWrite {
3637 TUPLE_CLASS_BOILERPLATE(OmpAtomicWrite);
3638 std::tuple<OmpMemoryClauseList, Verbatim, OmpMemoryClausePostList,
3639 Statement<AssignmentStmt>, std::optional<OmpEndAtomic>>
3640 t;
3641 };
3642
3643 // ATOMIC UPDATE
3644 struct OmpAtomicUpdate {
3645 TUPLE_CLASS_BOILERPLATE(OmpAtomicUpdate);
3646 std::tuple<OmpMemoryClauseList, Verbatim, OmpMemoryClausePostList,
3647 Statement<AssignmentStmt>, std::optional<OmpEndAtomic>>
3648 t;
3649 };
3650
3651 // ATOMIC CAPTURE
3652 struct OmpAtomicCapture {
3653 TUPLE_CLASS_BOILERPLATE(OmpAtomicCapture);
3654 WRAPPER_CLASS(Stmt1, Statement<AssignmentStmt>);
3655 WRAPPER_CLASS(Stmt2, Statement<AssignmentStmt>);
3656 std::tuple<OmpMemoryClauseList, Verbatim, OmpMemoryClausePostList, Stmt1,
3657 Stmt2, OmpEndAtomic>
3658 t;
3659 };
3660
3661 // ATOMIC
3662 struct OmpAtomic {
3663 TUPLE_CLASS_BOILERPLATE(OmpAtomic);
3664 std::tuple<Verbatim, OmpMemoryClauseList, Statement<AssignmentStmt>,
3665 std::optional<OmpEndAtomic>>
3666 t;
3667 };
3668
3669 struct OpenMPAtomicConstruct {
3670 UNION_CLASS_BOILERPLATE(OpenMPAtomicConstruct);
3671 std::variant<OmpAtomicRead, OmpAtomicWrite, OmpAtomicCapture, OmpAtomicUpdate,
3672 OmpAtomic>
3673 u;
3674 };
3675
3676 // OpenMP directives that associate with loop(s)
3677 struct OmpLoopDirective {
3678 ENUM_CLASS(Directive, Distribute, DistributeParallelDo,
3679 DistributeParallelDoSimd, DistributeSimd, ParallelDo, ParallelDoSimd, Do,
3680 DoSimd, Simd, TargetParallelDo, TargetParallelDoSimd,
3681 TargetTeamsDistribute, TargetTeamsDistributeParallelDo,
3682 TargetTeamsDistributeParallelDoSimd, TargetTeamsDistributeSimd,
3683 TargetSimd, Taskloop, TaskloopSimd, TeamsDistribute,
3684 TeamsDistributeParallelDo, TeamsDistributeParallelDoSimd,
3685 TeamsDistributeSimd)
3686 WRAPPER_CLASS_BOILERPLATE(OmpLoopDirective, Directive);
3687 CharBlock source;
3688 };
3689
3690 // 2.14.1 construct-type-clause -> PARALLEL | SECTIONS | DO | TASKGROUP
3691 struct OmpCancelType {
3692 ENUM_CLASS(Type, Parallel, Sections, Do, Taskgroup)
3693 WRAPPER_CLASS_BOILERPLATE(OmpCancelType, Type);
3694 CharBlock source;
3695 };
3696
3697 // 2.14.2 cancellation-point -> CANCELLATION POINT construct-type-clause
3698 struct OpenMPCancellationPointConstruct {
3699 TUPLE_CLASS_BOILERPLATE(OpenMPCancellationPointConstruct);
3700 CharBlock source;
3701 std::tuple<Verbatim, OmpCancelType> t;
3702 };
3703
3704 // 2.14.1 cancel -> CANCEL construct-type-clause [ [,] if-clause]
3705 struct OpenMPCancelConstruct {
3706 TUPLE_CLASS_BOILERPLATE(OpenMPCancelConstruct);
3707 WRAPPER_CLASS(If, ScalarLogicalExpr);
3708 CharBlock source;
3709 std::tuple<Verbatim, OmpCancelType, std::optional<If>> t;
3710 };
3711
3712 // 2.13.7 flush -> FLUSH [(variable-name-list)]
3713 struct OpenMPFlushConstruct {
3714 TUPLE_CLASS_BOILERPLATE(OpenMPFlushConstruct);
3715 CharBlock source;
3716 std::tuple<Verbatim, std::optional<OmpObjectList>> t;
3717 };
3718
3719 struct OmpSimpleStandaloneDirective {
3720 ENUM_CLASS(Directive, Barrier, Taskwait, Taskyield, TargetEnterData,
3721 TargetExitData, TargetUpdate, Ordered)
3722 WRAPPER_CLASS_BOILERPLATE(OmpSimpleStandaloneDirective, Directive);
3723 CharBlock source;
3724 };
3725
3726 struct OpenMPSimpleStandaloneConstruct {
3727 TUPLE_CLASS_BOILERPLATE(OpenMPSimpleStandaloneConstruct);
3728 CharBlock source;
3729 std::tuple<OmpSimpleStandaloneDirective, OmpClauseList> t;
3730 };
3731
3732 struct OpenMPStandaloneConstruct {
3733 UNION_CLASS_BOILERPLATE(OpenMPStandaloneConstruct);
3734 CharBlock source;
3735 std::variant<OpenMPSimpleStandaloneConstruct, OpenMPFlushConstruct,
3736 OpenMPCancelConstruct, OpenMPCancellationPointConstruct>
3737 u;
3738 };
3739
3740 struct OmpBeginLoopDirective {
3741 TUPLE_CLASS_BOILERPLATE(OmpBeginLoopDirective);
3742 std::tuple<OmpLoopDirective, OmpClauseList> t;
3743 };
3744
3745 struct OmpEndLoopDirective {
3746 TUPLE_CLASS_BOILERPLATE(OmpEndLoopDirective);
3747 std::tuple<OmpLoopDirective, OmpClauseList> t;
3748 };
3749
3750 struct OmpBeginBlockDirective {
3751 TUPLE_CLASS_BOILERPLATE(OmpBeginBlockDirective);
3752 std::tuple<OmpBlockDirective, OmpClauseList> t;
3753 };
3754
3755 struct OmpEndBlockDirective {
3756 TUPLE_CLASS_BOILERPLATE(OmpEndBlockDirective);
3757 std::tuple<OmpBlockDirective, OmpClauseList> t;
3758 };
3759
3760 struct OpenMPBlockConstruct {
3761 TUPLE_CLASS_BOILERPLATE(OpenMPBlockConstruct);
3762 std::tuple<OmpBeginBlockDirective, Block, OmpEndBlockDirective> t;
3763 };
3764
3765 // OpenMP directives enclosing do loop
3766 struct OpenMPLoopConstruct {
3767 TUPLE_CLASS_BOILERPLATE(OpenMPLoopConstruct);
OpenMPLoopConstructOpenMPLoopConstruct3768 OpenMPLoopConstruct(OmpBeginLoopDirective &&a)
3769 : t({std::move(a), std::nullopt, std::nullopt}) {}
3770 std::tuple<OmpBeginLoopDirective, std::optional<DoConstruct>,
3771 std::optional<OmpEndLoopDirective>>
3772 t;
3773 };
3774
3775 struct OpenMPConstruct {
3776 UNION_CLASS_BOILERPLATE(OpenMPConstruct);
3777 std::variant<OpenMPStandaloneConstruct, OpenMPSectionsConstruct,
3778 OpenMPLoopConstruct, OpenMPBlockConstruct, OpenMPAtomicConstruct,
3779 OpenMPCriticalConstruct>
3780 u;
3781 };
3782 }
3783 #endif // FORTRAN_PARSER_PARSE_TREE_H_
3784