1 //===-- lib/Parser/unparse.cpp --------------------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 // Generates Fortran from the content of a parse tree, using the
10 // traversal templates in parse-tree-visitor.h.
11 
12 #include "flang/Parser/unparse.h"
13 #include "flang/Common/Fortran.h"
14 #include "flang/Common/idioms.h"
15 #include "flang/Common/indirection.h"
16 #include "flang/Parser/characters.h"
17 #include "flang/Parser/parse-tree-visitor.h"
18 #include "flang/Parser/parse-tree.h"
19 #include "flang/Parser/tools.h"
20 #include "llvm/Support/raw_ostream.h"
21 #include <algorithm>
22 #include <cinttypes>
23 #include <cstddef>
24 #include <set>
25 
26 namespace Fortran::parser {
27 
28 class UnparseVisitor {
29 public:
30   UnparseVisitor(llvm::raw_ostream &out, int indentationAmount,
31       Encoding encoding, bool capitalize, bool backslashEscapes,
32       preStatementType *preStatement, AnalyzedObjectsAsFortran *asFortran)
33       : out_{out}, indentationAmount_{indentationAmount}, encoding_{encoding},
34         capitalizeKeywords_{capitalize}, backslashEscapes_{backslashEscapes},
35         preStatement_{preStatement}, asFortran_{asFortran} {}
36 
37   // In nearly all cases, this code avoids defining Boolean-valued Pre()
38   // callbacks for the parse tree walking framework in favor of two void
39   // functions, Before() and Unparse(), which imply true and false return
40   // values for Pre() respectively.
41   template <typename T> void Before(const T &) {}
42   template <typename T> double Unparse(const T &); // not void, never used
43 
44   template <typename T> bool Pre(const T &x) {
45     if constexpr (std::is_void_v<decltype(Unparse(x))>) {
46       // There is a local definition of Unparse() for this type.  It
47       // overrides the parse tree walker's default Walk() over the descendents.
48       Before(x);
49       Unparse(x);
50       Post(x);
51       return false; // Walk() does not visit descendents
52     } else if constexpr (HasTypedExpr<T>::value) {
53       // Format the expression representation from semantics
54       if (asFortran_ && x.typedExpr) {
55         asFortran_->expr(out_, *x.typedExpr);
56         return false;
57       } else {
58         return true;
59       }
60     } else {
61       Before(x);
62       return true; // there's no Unparse() defined here, Walk() the descendents
63     }
64   }
65   template <typename T> void Post(const T &) {}
66 
67   // Emit simple types as-is.
68   void Unparse(const std::string &x) { Put(x); }
69   void Unparse(int x) { Put(std::to_string(x)); }
70   void Unparse(unsigned int x) { Put(std::to_string(x)); }
71   void Unparse(long x) { Put(std::to_string(x)); }
72   void Unparse(unsigned long x) { Put(std::to_string(x)); }
73   void Unparse(long long x) { Put(std::to_string(x)); }
74   void Unparse(unsigned long long x) { Put(std::to_string(x)); }
75   void Unparse(char x) { Put(x); }
76 
77   // Statement labels and ends of lines
78   template <typename T> void Before(const Statement<T> &x) {
79     if (preStatement_) {
80       (*preStatement_)(x.source, out_, indent_);
81     }
82     Walk(x.label, " ");
83   }
84   template <typename T> void Post(const Statement<T> &) { Put('\n'); }
85 
86   // The special-case formatting functions for these productions are
87   // ordered to correspond roughly to their order of appearance in
88   // the Fortran 2018 standard (and parse-tree.h).
89 
90   void Unparse(const Program &x) { // R501
91     Walk("", x.v, "\n"); // put blank lines between ProgramUnits
92   }
93 
94   void Unparse(const Name &x) { // R603
95     Put(x.ToString());
96   }
97   void Unparse(const DefinedOperator::IntrinsicOperator &x) { // R608
98     switch (x) {
99     case DefinedOperator::IntrinsicOperator::Power:
100       Put("**");
101       break;
102     case DefinedOperator::IntrinsicOperator::Multiply:
103       Put('*');
104       break;
105     case DefinedOperator::IntrinsicOperator::Divide:
106       Put('/');
107       break;
108     case DefinedOperator::IntrinsicOperator::Add:
109       Put('+');
110       break;
111     case DefinedOperator::IntrinsicOperator::Subtract:
112       Put('-');
113       break;
114     case DefinedOperator::IntrinsicOperator::Concat:
115       Put("//");
116       break;
117     case DefinedOperator::IntrinsicOperator::LT:
118       Put('<');
119       break;
120     case DefinedOperator::IntrinsicOperator::LE:
121       Put("<=");
122       break;
123     case DefinedOperator::IntrinsicOperator::EQ:
124       Put("==");
125       break;
126     case DefinedOperator::IntrinsicOperator::NE:
127       Put("/=");
128       break;
129     case DefinedOperator::IntrinsicOperator::GE:
130       Put(">=");
131       break;
132     case DefinedOperator::IntrinsicOperator::GT:
133       Put('>');
134       break;
135     default:
136       Put('.'), Word(DefinedOperator::EnumToString(x)), Put('.');
137     }
138   }
139   void Post(const Star &) { Put('*'); } // R701 &c.
140   void Post(const TypeParamValue::Deferred &) { Put(':'); } // R701
141   void Unparse(const DeclarationTypeSpec::Type &x) { // R703
142     Word("TYPE("), Walk(x.derived), Put(')');
143   }
144   void Unparse(const DeclarationTypeSpec::Class &x) {
145     Word("CLASS("), Walk(x.derived), Put(')');
146   }
147   void Post(const DeclarationTypeSpec::ClassStar &) { Word("CLASS(*)"); }
148   void Post(const DeclarationTypeSpec::TypeStar &) { Word("TYPE(*)"); }
149   void Unparse(const DeclarationTypeSpec::Record &x) {
150     Word("RECORD/"), Walk(x.v), Put('/');
151   }
152   void Before(const IntrinsicTypeSpec::Real &) { // R704
153     Word("REAL");
154   }
155   void Before(const IntrinsicTypeSpec::Complex &) { Word("COMPLEX"); }
156   void Post(const IntrinsicTypeSpec::DoublePrecision &) {
157     Word("DOUBLE PRECISION");
158   }
159   void Before(const IntrinsicTypeSpec::Character &) { Word("CHARACTER"); }
160   void Before(const IntrinsicTypeSpec::Logical &) { Word("LOGICAL"); }
161   void Post(const IntrinsicTypeSpec::DoubleComplex &) {
162     Word("DOUBLE COMPLEX");
163   }
164   void Before(const IntegerTypeSpec &) { // R705
165     Word("INTEGER");
166   }
167   void Unparse(const KindSelector &x) { // R706
168     std::visit(
169         common::visitors{
170             [&](const ScalarIntConstantExpr &y) {
171               Put('('), Word("KIND="), Walk(y), Put(')');
172             },
173             [&](const KindSelector::StarSize &y) { Put('*'), Walk(y.v); },
174         },
175         x.u);
176   }
177   void Unparse(const SignedIntLiteralConstant &x) { // R707
178     Put(std::get<CharBlock>(x.t).ToString());
179     Walk("_", std::get<std::optional<KindParam>>(x.t));
180   }
181   void Unparse(const IntLiteralConstant &x) { // R708
182     Put(std::get<CharBlock>(x.t).ToString());
183     Walk("_", std::get<std::optional<KindParam>>(x.t));
184   }
185   void Unparse(const Sign &x) { // R712
186     Put(x == Sign::Negative ? '-' : '+');
187   }
188   void Unparse(const RealLiteralConstant &x) { // R714, R715
189     Put(x.real.source.ToString()), Walk("_", x.kind);
190   }
191   void Unparse(const ComplexLiteralConstant &x) { // R718 - R720
192     Put('('), Walk(x.t, ","), Put(')');
193   }
194   void Unparse(const CharSelector::LengthAndKind &x) { // R721
195     Put('('), Word("KIND="), Walk(x.kind);
196     Walk(", LEN=", x.length), Put(')');
197   }
198   void Unparse(const LengthSelector &x) { // R722
199     std::visit(common::visitors{
200                    [&](const TypeParamValue &y) {
201                      Put('('), Word("LEN="), Walk(y), Put(')');
202                    },
203                    [&](const CharLength &y) { Put('*'), Walk(y); },
204                },
205         x.u);
206   }
207   void Unparse(const CharLength &x) { // R723
208     std::visit(
209         common::visitors{
210             [&](const TypeParamValue &y) { Put('('), Walk(y), Put(')'); },
211             [&](const std::int64_t &y) { Walk(y); },
212         },
213         x.u);
214   }
215   void Unparse(const CharLiteralConstant &x) { // R724
216     const auto &str{std::get<std::string>(x.t)};
217     if (const auto &k{std::get<std::optional<KindParam>>(x.t)}) {
218       Walk(*k), Put('_');
219     }
220     PutNormalized(str);
221   }
222   void Unparse(const HollerithLiteralConstant &x) {
223     auto ucs{DecodeString<std::u32string, Encoding::UTF_8>(x.v, false)};
224     Unparse(ucs.size());
225     Put('H');
226     for (char32_t ch : ucs) {
227       EncodedCharacter encoded{EncodeCharacter(encoding_, ch)};
228       for (int j{0}; j < encoded.bytes; ++j) {
229         Put(encoded.buffer[j]);
230       }
231     }
232   }
233   void Unparse(const LogicalLiteralConstant &x) { // R725
234     Put(std::get<bool>(x.t) ? ".TRUE." : ".FALSE.");
235     Walk("_", std::get<std::optional<KindParam>>(x.t));
236   }
237   void Unparse(const DerivedTypeStmt &x) { // R727
238     Word("TYPE"), Walk(", ", std::get<std::list<TypeAttrSpec>>(x.t), ", ");
239     Put(" :: "), Walk(std::get<Name>(x.t));
240     Walk("(", std::get<std::list<Name>>(x.t), ", ", ")");
241     Indent();
242   }
243   void Unparse(const Abstract &) { // R728, &c.
244     Word("ABSTRACT");
245   }
246   void Post(const TypeAttrSpec::BindC &) { Word("BIND(C)"); }
247   void Unparse(const TypeAttrSpec::Extends &x) {
248     Word("EXTENDS("), Walk(x.v), Put(')');
249   }
250   void Unparse(const EndTypeStmt &x) { // R730
251     Outdent(), Word("END TYPE"), Walk(" ", x.v);
252   }
253   void Unparse(const SequenceStmt &) { // R731
254     Word("SEQUENCE");
255   }
256   void Unparse(const TypeParamDefStmt &x) { // R732
257     Walk(std::get<IntegerTypeSpec>(x.t));
258     Put(", "), Walk(std::get<common::TypeParamAttr>(x.t));
259     Put(" :: "), Walk(std::get<std::list<TypeParamDecl>>(x.t), ", ");
260   }
261   void Unparse(const TypeParamDecl &x) { // R733
262     Walk(std::get<Name>(x.t));
263     Walk("=", std::get<std::optional<ScalarIntConstantExpr>>(x.t));
264   }
265   void Unparse(const DataComponentDefStmt &x) { // R737
266     const auto &dts{std::get<DeclarationTypeSpec>(x.t)};
267     const auto &attrs{std::get<std::list<ComponentAttrSpec>>(x.t)};
268     const auto &decls{std::get<std::list<ComponentOrFill>>(x.t)};
269     Walk(dts), Walk(", ", attrs, ", ");
270     if (!attrs.empty() ||
271         (!std::holds_alternative<DeclarationTypeSpec::Record>(dts.u) &&
272             std::none_of(
273                 decls.begin(), decls.end(), [](const ComponentOrFill &c) {
274                   return std::visit(
275                       common::visitors{
276                           [](const ComponentDecl &d) {
277                             const auto &init{
278                                 std::get<std::optional<Initialization>>(d.t)};
279                             return init &&
280                                 std::holds_alternative<std::list<
281                                     common::Indirection<DataStmtValue>>>(
282                                     init->u);
283                           },
284                           [](const FillDecl &) { return false; },
285                       },
286                       c.u);
287                 }))) {
288       Put(" ::");
289     }
290     Put(' '), Walk(decls, ", ");
291   }
292   void Unparse(const Allocatable &) { // R738
293     Word("ALLOCATABLE");
294   }
295   void Unparse(const Pointer &) { Word("POINTER"); }
296   void Unparse(const Contiguous &) { Word("CONTIGUOUS"); }
297   void Before(const ComponentAttrSpec &x) {
298     std::visit(common::visitors{
299                    [&](const CoarraySpec &) { Word("CODIMENSION["); },
300                    [&](const ComponentArraySpec &) { Word("DIMENSION("); },
301                    [](const auto &) {},
302                },
303         x.u);
304   }
305   void Post(const ComponentAttrSpec &x) {
306     std::visit(common::visitors{
307                    [&](const CoarraySpec &) { Put(']'); },
308                    [&](const ComponentArraySpec &) { Put(')'); },
309                    [](const auto &) {},
310                },
311         x.u);
312   }
313   void Unparse(const ComponentDecl &x) { // R739
314     Walk(std::get<ObjectName>(x.t));
315     Walk("(", std::get<std::optional<ComponentArraySpec>>(x.t), ")");
316     Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]");
317     Walk("*", std::get<std::optional<CharLength>>(x.t));
318     Walk(std::get<std::optional<Initialization>>(x.t));
319   }
320   void Unparse(const FillDecl &x) { // DEC extension
321     Put("%FILL");
322     Walk("(", std::get<std::optional<ComponentArraySpec>>(x.t), ")");
323     Walk("*", std::get<std::optional<CharLength>>(x.t));
324   }
325   void Unparse(const ComponentArraySpec &x) { // R740
326     std::visit(common::visitors{
327                    [&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
328                    [&](const DeferredShapeSpecList &y) { Walk(y); },
329                },
330         x.u);
331   }
332   void Unparse(const ProcComponentDefStmt &x) { // R741
333     Word("PROCEDURE(");
334     Walk(std::get<std::optional<ProcInterface>>(x.t)), Put(')');
335     Walk(", ", std::get<std::list<ProcComponentAttrSpec>>(x.t), ", ");
336     Put(" :: "), Walk(std::get<std::list<ProcDecl>>(x.t), ", ");
337   }
338   void Unparse(const NoPass &) { // R742
339     Word("NOPASS");
340   }
341   void Unparse(const Pass &x) { Word("PASS"), Walk("(", x.v, ")"); }
342   void Unparse(const Initialization &x) { // R743 & R805
343     std::visit(common::visitors{
344                    [&](const ConstantExpr &y) { Put(" = "), Walk(y); },
345                    [&](const NullInit &y) { Put(" => "), Walk(y); },
346                    [&](const InitialDataTarget &y) { Put(" => "), Walk(y); },
347                    [&](const std::list<common::Indirection<DataStmtValue>> &y) {
348                      Walk("/", y, ", ", "/");
349                    },
350                },
351         x.u);
352   }
353   void Unparse(const PrivateStmt &) { // R745
354     Word("PRIVATE");
355   }
356   void Unparse(const TypeBoundProcedureStmt::WithoutInterface &x) { // R749
357     Word("PROCEDURE"), Walk(", ", x.attributes, ", ");
358     Put(" :: "), Walk(x.declarations, ", ");
359   }
360   void Unparse(const TypeBoundProcedureStmt::WithInterface &x) {
361     Word("PROCEDURE("), Walk(x.interfaceName), Put("), ");
362     Walk(x.attributes);
363     Put(" :: "), Walk(x.bindingNames, ", ");
364   }
365   void Unparse(const TypeBoundProcDecl &x) { // R750
366     Walk(std::get<Name>(x.t));
367     Walk(" => ", std::get<std::optional<Name>>(x.t));
368   }
369   void Unparse(const TypeBoundGenericStmt &x) { // R751
370     Word("GENERIC"), Walk(", ", std::get<std::optional<AccessSpec>>(x.t));
371     Put(" :: "), Walk(std::get<common::Indirection<GenericSpec>>(x.t));
372     Put(" => "), Walk(std::get<std::list<Name>>(x.t), ", ");
373   }
374   void Post(const BindAttr::Deferred &) { Word("DEFERRED"); } // R752
375   void Post(const BindAttr::Non_Overridable &) { Word("NON_OVERRIDABLE"); }
376   void Unparse(const FinalProcedureStmt &x) { // R753
377     Word("FINAL :: "), Walk(x.v, ", ");
378   }
379   void Unparse(const DerivedTypeSpec &x) { // R754
380     Walk(std::get<Name>(x.t));
381     Walk("(", std::get<std::list<TypeParamSpec>>(x.t), ",", ")");
382   }
383   void Unparse(const TypeParamSpec &x) { // R755
384     Walk(std::get<std::optional<Keyword>>(x.t), "=");
385     Walk(std::get<TypeParamValue>(x.t));
386   }
387   void Unparse(const StructureConstructor &x) { // R756
388     Walk(std::get<DerivedTypeSpec>(x.t));
389     Put('('), Walk(std::get<std::list<ComponentSpec>>(x.t), ", "), Put(')');
390   }
391   void Unparse(const ComponentSpec &x) { // R757
392     Walk(std::get<std::optional<Keyword>>(x.t), "=");
393     Walk(std::get<ComponentDataSource>(x.t));
394   }
395   void Unparse(const EnumDefStmt &) { // R760
396     Word("ENUM, BIND(C)"), Indent();
397   }
398   void Unparse(const EnumeratorDefStmt &x) { // R761
399     Word("ENUMERATOR :: "), Walk(x.v, ", ");
400   }
401   void Unparse(const Enumerator &x) { // R762
402     Walk(std::get<NamedConstant>(x.t));
403     Walk(" = ", std::get<std::optional<ScalarIntConstantExpr>>(x.t));
404   }
405   void Post(const EndEnumStmt &) { // R763
406     Outdent(), Word("END ENUM");
407   }
408   void Unparse(const BOZLiteralConstant &x) { // R764 - R767
409     Put(x.v);
410   }
411   void Unparse(const AcValue::Triplet &x) { // R773
412     Walk(std::get<0>(x.t)), Put(':'), Walk(std::get<1>(x.t));
413     Walk(":", std::get<std::optional<ScalarIntExpr>>(x.t));
414   }
415   void Unparse(const ArrayConstructor &x) { // R769
416     Put('['), Walk(x.v), Put(']');
417   }
418   void Unparse(const AcSpec &x) { // R770
419     Walk(x.type, "::"), Walk(x.values, ", ");
420   }
421   template <typename A, typename B> void Unparse(const LoopBounds<A, B> &x) {
422     Walk(x.name), Put('='), Walk(x.lower), Put(','), Walk(x.upper);
423     Walk(",", x.step);
424   }
425   void Unparse(const AcImpliedDo &x) { // R774
426     Put('('), Walk(std::get<std::list<AcValue>>(x.t), ", ");
427     Put(", "), Walk(std::get<AcImpliedDoControl>(x.t)), Put(')');
428   }
429   void Unparse(const AcImpliedDoControl &x) { // R775
430     Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::");
431     Walk(std::get<AcImpliedDoControl::Bounds>(x.t));
432   }
433 
434   void Unparse(const TypeDeclarationStmt &x) { // R801
435     const auto &dts{std::get<DeclarationTypeSpec>(x.t)};
436     const auto &attrs{std::get<std::list<AttrSpec>>(x.t)};
437     const auto &decls{std::get<std::list<EntityDecl>>(x.t)};
438     Walk(dts), Walk(", ", attrs, ", ");
439 
440     static const auto isInitializerOldStyle{[](const Initialization &i) {
441       return std::holds_alternative<
442           std::list<common::Indirection<DataStmtValue>>>(i.u);
443     }};
444     static const auto hasAssignmentInitializer{[](const EntityDecl &d) {
445       // Does a declaration have a new-style =x initializer?
446       const auto &init{std::get<std::optional<Initialization>>(d.t)};
447       return init && !isInitializerOldStyle(*init);
448     }};
449     static const auto hasSlashDelimitedInitializer{[](const EntityDecl &d) {
450       // Does a declaration have an old-style /x/ initializer?
451       const auto &init{std::get<std::optional<Initialization>>(d.t)};
452       return init && isInitializerOldStyle(*init);
453     }};
454     const auto useDoubledColons{[&]() {
455       bool isRecord{std::holds_alternative<DeclarationTypeSpec::Record>(dts.u)};
456       if (!attrs.empty()) {
457         // Attributes after the type require :: before the entities.
458         CHECK(!isRecord);
459         return true;
460       }
461       if (std::any_of(decls.begin(), decls.end(), hasAssignmentInitializer)) {
462         // Always use :: with new style standard initializers (=x),
463         // since the standard requires them to appear (even in free form,
464         // where mandatory spaces already disambiguate INTEGER J=666).
465         CHECK(!isRecord);
466         return true;
467       }
468       if (isRecord) {
469         // Never put :: in a legacy extension RECORD// statement.
470         return false;
471       }
472       // The :: is optional for this declaration.  Avoid usage that can
473       // crash the pgf90 compiler.
474       if (std::any_of(
475               decls.begin(), decls.end(), hasSlashDelimitedInitializer)) {
476         // Don't use :: when a declaration uses legacy DATA-statement-like
477         // /x/ initialization.
478         return false;
479       }
480       // Don't use :: with intrinsic types.  Otherwise, use it.
481       return !std::holds_alternative<IntrinsicTypeSpec>(dts.u);
482     }};
483 
484     if (useDoubledColons()) {
485       Put(" ::");
486     }
487     Put(' '), Walk(std::get<std::list<EntityDecl>>(x.t), ", ");
488   }
489   void Before(const AttrSpec &x) { // R802
490     std::visit(common::visitors{
491                    [&](const CoarraySpec &) { Word("CODIMENSION["); },
492                    [&](const ArraySpec &) { Word("DIMENSION("); },
493                    [](const auto &) {},
494                },
495         x.u);
496   }
497   void Post(const AttrSpec &x) {
498     std::visit(common::visitors{
499                    [&](const CoarraySpec &) { Put(']'); },
500                    [&](const ArraySpec &) { Put(')'); },
501                    [](const auto &) {},
502                },
503         x.u);
504   }
505   void Unparse(const EntityDecl &x) { // R803
506     Walk(std::get<ObjectName>(x.t));
507     Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")");
508     Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]");
509     Walk("*", std::get<std::optional<CharLength>>(x.t));
510     Walk(std::get<std::optional<Initialization>>(x.t));
511   }
512   void Unparse(const NullInit &) { // R806
513     Word("NULL()");
514   }
515   void Unparse(const LanguageBindingSpec &x) { // R808 & R1528
516     Word("BIND(C"), Walk(", NAME=", x.v), Put(')');
517   }
518   void Unparse(const CoarraySpec &x) { // R809
519     std::visit(common::visitors{
520                    [&](const DeferredCoshapeSpecList &y) { Walk(y); },
521                    [&](const ExplicitCoshapeSpec &y) { Walk(y); },
522                },
523         x.u);
524   }
525   void Unparse(const DeferredCoshapeSpecList &x) { // R810
526     for (auto j{x.v}; j > 0; --j) {
527       Put(':');
528       if (j > 1) {
529         Put(',');
530       }
531     }
532   }
533   void Unparse(const ExplicitCoshapeSpec &x) { // R811
534     Walk(std::get<std::list<ExplicitShapeSpec>>(x.t), ",", ",");
535     Walk(std::get<std::optional<SpecificationExpr>>(x.t), ":"), Put('*');
536   }
537   void Unparse(const ExplicitShapeSpec &x) { // R812 - R813 & R816 - R818
538     Walk(std::get<std::optional<SpecificationExpr>>(x.t), ":");
539     Walk(std::get<SpecificationExpr>(x.t));
540   }
541   void Unparse(const ArraySpec &x) { // R815
542     std::visit(common::visitors{
543                    [&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
544                    [&](const std::list<AssumedShapeSpec> &y) { Walk(y, ","); },
545                    [&](const DeferredShapeSpecList &y) { Walk(y); },
546                    [&](const AssumedSizeSpec &y) { Walk(y); },
547                    [&](const ImpliedShapeSpec &y) { Walk(y); },
548                    [&](const AssumedRankSpec &y) { Walk(y); },
549                },
550         x.u);
551   }
552   void Post(const AssumedShapeSpec &) { Put(':'); } // R819
553   void Unparse(const DeferredShapeSpecList &x) { // R820
554     for (auto j{x.v}; j > 0; --j) {
555       Put(':');
556       if (j > 1) {
557         Put(',');
558       }
559     }
560   }
561   void Unparse(const AssumedImpliedSpec &x) { // R821
562     Walk(x.v, ":");
563     Put('*');
564   }
565   void Unparse(const AssumedSizeSpec &x) { // R822
566     Walk(std::get<std::list<ExplicitShapeSpec>>(x.t), ",", ",");
567     Walk(std::get<AssumedImpliedSpec>(x.t));
568   }
569   void Unparse(const ImpliedShapeSpec &x) { // R823
570     Walk(x.v, ",");
571   }
572   void Post(const AssumedRankSpec &) { Put(".."); } // R825
573   void Post(const Asynchronous &) { Word("ASYNCHRONOUS"); }
574   void Post(const External &) { Word("EXTERNAL"); }
575   void Post(const Intrinsic &) { Word("INTRINSIC"); }
576   void Post(const Optional &) { Word("OPTIONAL"); }
577   void Post(const Parameter &) { Word("PARAMETER"); }
578   void Post(const Protected &) { Word("PROTECTED"); }
579   void Post(const Save &) { Word("SAVE"); }
580   void Post(const Target &) { Word("TARGET"); }
581   void Post(const Value &) { Word("VALUE"); }
582   void Post(const Volatile &) { Word("VOLATILE"); }
583   void Unparse(const IntentSpec &x) { // R826
584     Word("INTENT("), Walk(x.v), Put(")");
585   }
586   void Unparse(const AccessStmt &x) { // R827
587     Walk(std::get<AccessSpec>(x.t));
588     Walk(" :: ", std::get<std::list<AccessId>>(x.t), ", ");
589   }
590   void Unparse(const AllocatableStmt &x) { // R829
591     Word("ALLOCATABLE :: "), Walk(x.v, ", ");
592   }
593   void Unparse(const ObjectDecl &x) { // R830 & R860
594     Walk(std::get<ObjectName>(x.t));
595     Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")");
596     Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]");
597   }
598   void Unparse(const AsynchronousStmt &x) { // R831
599     Word("ASYNCHRONOUS :: "), Walk(x.v, ", ");
600   }
601   void Unparse(const BindStmt &x) { // R832
602     Walk(x.t, " :: ");
603   }
604   void Unparse(const BindEntity &x) { // R833
605     bool isCommon{std::get<BindEntity::Kind>(x.t) == BindEntity::Kind::Common};
606     const char *slash{isCommon ? "/" : ""};
607     Put(slash), Walk(std::get<Name>(x.t)), Put(slash);
608   }
609   void Unparse(const CodimensionStmt &x) { // R834
610     Word("CODIMENSION :: "), Walk(x.v, ", ");
611   }
612   void Unparse(const CodimensionDecl &x) { // R835
613     Walk(std::get<Name>(x.t));
614     Put('['), Walk(std::get<CoarraySpec>(x.t)), Put(']');
615   }
616   void Unparse(const ContiguousStmt &x) { // R836
617     Word("CONTIGUOUS :: "), Walk(x.v, ", ");
618   }
619   void Unparse(const DataStmt &x) { // R837
620     Word("DATA "), Walk(x.v, ", ");
621   }
622   void Unparse(const DataStmtSet &x) { // R838
623     Walk(std::get<std::list<DataStmtObject>>(x.t), ", ");
624     Put('/'), Walk(std::get<std::list<DataStmtValue>>(x.t), ", "), Put('/');
625   }
626   void Unparse(const DataImpliedDo &x) { // R840, R842
627     Put('('), Walk(std::get<std::list<DataIDoObject>>(x.t), ", "), Put(',');
628     Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::");
629     Walk(std::get<DataImpliedDo::Bounds>(x.t)), Put(')');
630   }
631   void Unparse(const DataStmtValue &x) { // R843
632     Walk(std::get<std::optional<DataStmtRepeat>>(x.t), "*");
633     Walk(std::get<DataStmtConstant>(x.t));
634   }
635   void Unparse(const DimensionStmt &x) { // R848
636     Word("DIMENSION :: "), Walk(x.v, ", ");
637   }
638   void Unparse(const DimensionStmt::Declaration &x) {
639     Walk(std::get<Name>(x.t));
640     Put('('), Walk(std::get<ArraySpec>(x.t)), Put(')');
641   }
642   void Unparse(const IntentStmt &x) { // R849
643     Walk(x.t, " :: ");
644   }
645   void Unparse(const OptionalStmt &x) { // R850
646     Word("OPTIONAL :: "), Walk(x.v, ", ");
647   }
648   void Unparse(const ParameterStmt &x) { // R851
649     Word("PARAMETER("), Walk(x.v, ", "), Put(')');
650   }
651   void Unparse(const NamedConstantDef &x) { // R852
652     Walk(x.t, "=");
653   }
654   void Unparse(const PointerStmt &x) { // R853
655     Word("POINTER :: "), Walk(x.v, ", ");
656   }
657   void Unparse(const PointerDecl &x) { // R854
658     Walk(std::get<Name>(x.t));
659     Walk("(", std::get<std::optional<DeferredShapeSpecList>>(x.t), ")");
660   }
661   void Unparse(const ProtectedStmt &x) { // R855
662     Word("PROTECTED :: "), Walk(x.v, ", ");
663   }
664   void Unparse(const SaveStmt &x) { // R856
665     Word("SAVE"), Walk(" :: ", x.v, ", ");
666   }
667   void Unparse(const SavedEntity &x) { // R857, R858
668     bool isCommon{
669         std::get<SavedEntity::Kind>(x.t) == SavedEntity::Kind::Common};
670     const char *slash{isCommon ? "/" : ""};
671     Put(slash), Walk(std::get<Name>(x.t)), Put(slash);
672   }
673   void Unparse(const TargetStmt &x) { // R859
674     Word("TARGET :: "), Walk(x.v, ", ");
675   }
676   void Unparse(const ValueStmt &x) { // R861
677     Word("VALUE :: "), Walk(x.v, ", ");
678   }
679   void Unparse(const VolatileStmt &x) { // R862
680     Word("VOLATILE :: "), Walk(x.v, ", ");
681   }
682   void Unparse(const ImplicitStmt &x) { // R863
683     Word("IMPLICIT ");
684     std::visit(common::visitors{
685                    [&](const std::list<ImplicitSpec> &y) { Walk(y, ", "); },
686                    [&](const std::list<ImplicitStmt::ImplicitNoneNameSpec> &y) {
687                      Word("NONE"), Walk(" (", y, ", ", ")");
688                    },
689                },
690         x.u);
691   }
692   void Unparse(const ImplicitSpec &x) { // R864
693     Walk(std::get<DeclarationTypeSpec>(x.t));
694     Put('('), Walk(std::get<std::list<LetterSpec>>(x.t), ", "), Put(')');
695   }
696   void Unparse(const LetterSpec &x) { // R865
697     Put(*std::get<const char *>(x.t));
698     auto second{std::get<std::optional<const char *>>(x.t)};
699     if (second) {
700       Put('-'), Put(**second);
701     }
702   }
703   void Unparse(const ImportStmt &x) { // R867
704     Word("IMPORT");
705     switch (x.kind) {
706     case common::ImportKind::Default:
707       Walk(" :: ", x.names, ", ");
708       break;
709     case common::ImportKind::Only:
710       Put(", "), Word("ONLY: ");
711       Walk(x.names, ", ");
712       break;
713     case common::ImportKind::None:
714       Word(", NONE");
715       break;
716     case common::ImportKind::All:
717       Word(", ALL");
718       break;
719     }
720   }
721   void Unparse(const NamelistStmt &x) { // R868
722     Word("NAMELIST"), Walk(x.v, ", ");
723   }
724   void Unparse(const NamelistStmt::Group &x) {
725     Put('/'), Walk(std::get<Name>(x.t)), Put('/');
726     Walk(std::get<std::list<Name>>(x.t), ", ");
727   }
728   void Unparse(const EquivalenceStmt &x) { // R870, R871
729     Word("EQUIVALENCE");
730     const char *separator{" "};
731     for (const std::list<EquivalenceObject> &y : x.v) {
732       Put(separator), Put('('), Walk(y), Put(')');
733       separator = ", ";
734     }
735   }
736   void Unparse(const CommonStmt &x) { // R873
737     Word("COMMON ");
738     Walk(x.blocks);
739   }
740   void Unparse(const CommonBlockObject &x) { // R874
741     Walk(std::get<Name>(x.t));
742     Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")");
743   }
744   void Unparse(const CommonStmt::Block &x) {
745     Word("/"), Walk(std::get<std::optional<Name>>(x.t)), Word("/");
746     Walk(std::get<std::list<CommonBlockObject>>(x.t));
747   }
748 
749   void Unparse(const Substring &x) { // R908, R909
750     Walk(std::get<DataRef>(x.t));
751     Put('('), Walk(std::get<SubstringRange>(x.t)), Put(')');
752   }
753   void Unparse(const CharLiteralConstantSubstring &x) {
754     Walk(std::get<CharLiteralConstant>(x.t));
755     Put('('), Walk(std::get<SubstringRange>(x.t)), Put(')');
756   }
757   void Unparse(const SubstringRange &x) { // R910
758     Walk(x.t, ":");
759   }
760   void Unparse(const PartRef &x) { // R912
761     Walk(x.name);
762     Walk("(", x.subscripts, ",", ")");
763     Walk(x.imageSelector);
764   }
765   void Unparse(const StructureComponent &x) { // R913
766     Walk(x.base);
767     if (structureComponents_.find(x.component.source) !=
768         structureComponents_.end()) {
769       Put('.');
770     } else {
771       Put('%');
772     }
773     Walk(x.component);
774   }
775   void Unparse(const ArrayElement &x) { // R917
776     Walk(x.base);
777     Put('('), Walk(x.subscripts, ","), Put(')');
778   }
779   void Unparse(const SubscriptTriplet &x) { // R921
780     Walk(std::get<0>(x.t)), Put(':'), Walk(std::get<1>(x.t));
781     Walk(":", std::get<2>(x.t));
782   }
783   void Unparse(const ImageSelector &x) { // R924
784     Put('['), Walk(std::get<std::list<Cosubscript>>(x.t), ",");
785     Walk(",", std::get<std::list<ImageSelectorSpec>>(x.t), ","), Put(']');
786   }
787   void Before(const ImageSelectorSpec::Stat &) { // R926
788     Word("STAT=");
789   }
790   void Before(const ImageSelectorSpec::Team_Number &) { Word("TEAM_NUMBER="); }
791   void Before(const ImageSelectorSpec &x) {
792     if (std::holds_alternative<TeamValue>(x.u)) {
793       Word("TEAM=");
794     }
795   }
796   void Unparse(const AllocateStmt &x) { // R927
797     Word("ALLOCATE(");
798     Walk(std::get<std::optional<TypeSpec>>(x.t), "::");
799     Walk(std::get<std::list<Allocation>>(x.t), ", ");
800     Walk(", ", std::get<std::list<AllocOpt>>(x.t), ", "), Put(')');
801   }
802   void Before(const AllocOpt &x) { // R928, R931
803     std::visit(common::visitors{
804                    [&](const AllocOpt::Mold &) { Word("MOLD="); },
805                    [&](const AllocOpt::Source &) { Word("SOURCE="); },
806                    [](const StatOrErrmsg &) {},
807                },
808         x.u);
809   }
810   void Unparse(const Allocation &x) { // R932
811     Walk(std::get<AllocateObject>(x.t));
812     Walk("(", std::get<std::list<AllocateShapeSpec>>(x.t), ",", ")");
813     Walk("[", std::get<std::optional<AllocateCoarraySpec>>(x.t), "]");
814   }
815   void Unparse(const AllocateShapeSpec &x) { // R934 & R938
816     Walk(std::get<std::optional<BoundExpr>>(x.t), ":");
817     Walk(std::get<BoundExpr>(x.t));
818   }
819   void Unparse(const AllocateCoarraySpec &x) { // R937
820     Walk(std::get<std::list<AllocateCoshapeSpec>>(x.t), ",", ",");
821     Walk(std::get<std::optional<BoundExpr>>(x.t), ":"), Put('*');
822   }
823   void Unparse(const NullifyStmt &x) { // R939
824     Word("NULLIFY("), Walk(x.v, ", "), Put(')');
825   }
826   void Unparse(const DeallocateStmt &x) { // R941
827     Word("DEALLOCATE(");
828     Walk(std::get<std::list<AllocateObject>>(x.t), ", ");
829     Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
830   }
831   void Before(const StatOrErrmsg &x) { // R942 & R1165
832     std::visit(common::visitors{
833                    [&](const StatVariable &) { Word("STAT="); },
834                    [&](const MsgVariable &) { Word("ERRMSG="); },
835                },
836         x.u);
837   }
838 
839   // R1001 - R1022
840   void Unparse(const Expr::Parentheses &x) { Put('('), Walk(x.v), Put(')'); }
841   void Before(const Expr::UnaryPlus &) { Put("+"); }
842   void Before(const Expr::Negate &) { Put("-"); }
843   void Before(const Expr::NOT &) { Word(".NOT."); }
844   void Unparse(const Expr::PercentLoc &x) {
845     Word("%LOC("), Walk(x.v), Put(')');
846   }
847   void Unparse(const Expr::Power &x) { Walk(x.t, "**"); }
848   void Unparse(const Expr::Multiply &x) { Walk(x.t, "*"); }
849   void Unparse(const Expr::Divide &x) { Walk(x.t, "/"); }
850   void Unparse(const Expr::Add &x) { Walk(x.t, "+"); }
851   void Unparse(const Expr::Subtract &x) { Walk(x.t, "-"); }
852   void Unparse(const Expr::Concat &x) { Walk(x.t, "//"); }
853   void Unparse(const Expr::LT &x) { Walk(x.t, "<"); }
854   void Unparse(const Expr::LE &x) { Walk(x.t, "<="); }
855   void Unparse(const Expr::EQ &x) { Walk(x.t, "=="); }
856   void Unparse(const Expr::NE &x) { Walk(x.t, "/="); }
857   void Unparse(const Expr::GE &x) { Walk(x.t, ">="); }
858   void Unparse(const Expr::GT &x) { Walk(x.t, ">"); }
859   void Unparse(const Expr::AND &x) { Walk(x.t, ".AND."); }
860   void Unparse(const Expr::OR &x) { Walk(x.t, ".OR."); }
861   void Unparse(const Expr::EQV &x) { Walk(x.t, ".EQV."); }
862   void Unparse(const Expr::NEQV &x) { Walk(x.t, ".NEQV."); }
863   void Unparse(const Expr::ComplexConstructor &x) {
864     Put('('), Walk(x.t, ","), Put(')');
865   }
866   void Unparse(const Expr::DefinedBinary &x) {
867     Walk(std::get<1>(x.t)); // left
868     Walk(std::get<DefinedOpName>(x.t));
869     Walk(std::get<2>(x.t)); // right
870   }
871   void Unparse(const DefinedOpName &x) { // R1003, R1023, R1414, & R1415
872     Walk(x.v);
873   }
874   void Unparse(const AssignmentStmt &x) { // R1032
875     if (asFortran_ && x.typedAssignment.get()) {
876       Put(' ');
877       asFortran_->assignment(out_, *x.typedAssignment);
878       Put('\n');
879     } else {
880       Walk(x.t, " = ");
881     }
882   }
883   void Unparse(const PointerAssignmentStmt &x) { // R1033, R1034, R1038
884     if (asFortran_ && x.typedAssignment.get()) {
885       Put(' ');
886       asFortran_->assignment(out_, *x.typedAssignment);
887       Put('\n');
888     } else {
889       Walk(std::get<DataRef>(x.t));
890       std::visit(
891           common::visitors{
892               [&](const std::list<BoundsRemapping> &y) {
893                 Put('('), Walk(y), Put(')');
894               },
895               [&](const std::list<BoundsSpec> &y) { Walk("(", y, ", ", ")"); },
896           },
897           std::get<PointerAssignmentStmt::Bounds>(x.t).u);
898       Put(" => "), Walk(std::get<Expr>(x.t));
899     }
900   }
901   void Post(const BoundsSpec &) { // R1035
902     Put(':');
903   }
904   void Unparse(const BoundsRemapping &x) { // R1036
905     Walk(x.t, ":");
906   }
907   void Unparse(const WhereStmt &x) { // R1041, R1045, R1046
908     Word("WHERE ("), Walk(x.t, ") ");
909   }
910   void Unparse(const WhereConstructStmt &x) { // R1043
911     Walk(std::get<std::optional<Name>>(x.t), ": ");
912     Word("WHERE ("), Walk(std::get<LogicalExpr>(x.t)), Put(')');
913     Indent();
914   }
915   void Unparse(const MaskedElsewhereStmt &x) { // R1047
916     Outdent();
917     Word("ELSEWHERE ("), Walk(std::get<LogicalExpr>(x.t)), Put(')');
918     Walk(" ", std::get<std::optional<Name>>(x.t));
919     Indent();
920   }
921   void Unparse(const ElsewhereStmt &x) { // R1048
922     Outdent(), Word("ELSEWHERE"), Walk(" ", x.v), Indent();
923   }
924   void Unparse(const EndWhereStmt &x) { // R1049
925     Outdent(), Word("END WHERE"), Walk(" ", x.v);
926   }
927   void Unparse(const ForallConstructStmt &x) { // R1051
928     Walk(std::get<std::optional<Name>>(x.t), ": ");
929     Word("FORALL"), Walk(std::get<common::Indirection<ConcurrentHeader>>(x.t));
930     Indent();
931   }
932   void Unparse(const EndForallStmt &x) { // R1054
933     Outdent(), Word("END FORALL"), Walk(" ", x.v);
934   }
935   void Before(const ForallStmt &) { // R1055
936     Word("FORALL");
937   }
938 
939   void Unparse(const AssociateStmt &x) { // R1103
940     Walk(std::get<std::optional<Name>>(x.t), ": ");
941     Word("ASSOCIATE (");
942     Walk(std::get<std::list<Association>>(x.t), ", "), Put(')'), Indent();
943   }
944   void Unparse(const Association &x) { // R1104
945     Walk(x.t, " => ");
946   }
947   void Unparse(const EndAssociateStmt &x) { // R1106
948     Outdent(), Word("END ASSOCIATE"), Walk(" ", x.v);
949   }
950   void Unparse(const BlockStmt &x) { // R1108
951     Walk(x.v, ": "), Word("BLOCK"), Indent();
952   }
953   void Unparse(const EndBlockStmt &x) { // R1110
954     Outdent(), Word("END BLOCK"), Walk(" ", x.v);
955   }
956   void Unparse(const ChangeTeamStmt &x) { // R1112
957     Walk(std::get<std::optional<Name>>(x.t), ": ");
958     Word("CHANGE TEAM ("), Walk(std::get<TeamValue>(x.t));
959     Walk(", ", std::get<std::list<CoarrayAssociation>>(x.t), ", ");
960     Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
961     Indent();
962   }
963   void Unparse(const CoarrayAssociation &x) { // R1113
964     Walk(x.t, " => ");
965   }
966   void Unparse(const EndChangeTeamStmt &x) { // R1114
967     Outdent(), Word("END TEAM (");
968     Walk(std::get<std::list<StatOrErrmsg>>(x.t), ", ");
969     Put(')'), Walk(" ", std::get<std::optional<Name>>(x.t));
970   }
971   void Unparse(const CriticalStmt &x) { // R1117
972     Walk(std::get<std::optional<Name>>(x.t), ": ");
973     Word("CRITICAL ("), Walk(std::get<std::list<StatOrErrmsg>>(x.t), ", ");
974     Put(')'), Indent();
975   }
976   void Unparse(const EndCriticalStmt &x) { // R1118
977     Outdent(), Word("END CRITICAL"), Walk(" ", x.v);
978   }
979   void Unparse(const DoConstruct &x) { // R1119, R1120
980     Walk(std::get<Statement<NonLabelDoStmt>>(x.t));
981     Indent(), Walk(std::get<Block>(x.t), ""), Outdent();
982     Walk(std::get<Statement<EndDoStmt>>(x.t));
983   }
984   void Unparse(const LabelDoStmt &x) { // R1121
985     Walk(std::get<std::optional<Name>>(x.t), ": ");
986     Word("DO "), Walk(std::get<Label>(x.t));
987     Walk(" ", std::get<std::optional<LoopControl>>(x.t));
988   }
989   void Unparse(const NonLabelDoStmt &x) { // R1122
990     Walk(std::get<std::optional<Name>>(x.t), ": ");
991     Word("DO "), Walk(std::get<std::optional<LoopControl>>(x.t));
992   }
993   void Unparse(const LoopControl &x) { // R1123
994     std::visit(common::visitors{
995                    [&](const ScalarLogicalExpr &y) {
996                      Word("WHILE ("), Walk(y), Put(')');
997                    },
998                    [&](const auto &y) { Walk(y); },
999                },
1000         x.u);
1001   }
1002   void Unparse(const ConcurrentHeader &x) { // R1125
1003     Put('('), Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::");
1004     Walk(std::get<std::list<ConcurrentControl>>(x.t), ", ");
1005     Walk(", ", std::get<std::optional<ScalarLogicalExpr>>(x.t)), Put(')');
1006   }
1007   void Unparse(const ConcurrentControl &x) { // R1126 - R1128
1008     Walk(std::get<Name>(x.t)), Put('='), Walk(std::get<1>(x.t));
1009     Put(':'), Walk(std::get<2>(x.t));
1010     Walk(":", std::get<std::optional<ScalarIntExpr>>(x.t));
1011   }
1012   void Before(const LoopControl::Concurrent &) { // R1129
1013     Word("CONCURRENT");
1014   }
1015   void Unparse(const LocalitySpec::Local &x) {
1016     Word("LOCAL("), Walk(x.v, ", "), Put(')');
1017   }
1018   void Unparse(const LocalitySpec::LocalInit &x) {
1019     Word("LOCAL_INIT("), Walk(x.v, ", "), Put(')');
1020   }
1021   void Unparse(const LocalitySpec::Shared &x) {
1022     Word("SHARED("), Walk(x.v, ", "), Put(')');
1023   }
1024   void Post(const LocalitySpec::DefaultNone &) { Word("DEFAULT(NONE)"); }
1025   void Unparse(const EndDoStmt &x) { // R1132
1026     Word("END DO"), Walk(" ", x.v);
1027   }
1028   void Unparse(const CycleStmt &x) { // R1133
1029     Word("CYCLE"), Walk(" ", x.v);
1030   }
1031   void Unparse(const IfThenStmt &x) { // R1135
1032     Walk(std::get<std::optional<Name>>(x.t), ": ");
1033     Word("IF ("), Walk(std::get<ScalarLogicalExpr>(x.t));
1034     Put(") "), Word("THEN"), Indent();
1035   }
1036   void Unparse(const ElseIfStmt &x) { // R1136
1037     Outdent(), Word("ELSE IF (");
1038     Walk(std::get<ScalarLogicalExpr>(x.t)), Put(") "), Word("THEN");
1039     Walk(" ", std::get<std::optional<Name>>(x.t)), Indent();
1040   }
1041   void Unparse(const ElseStmt &x) { // R1137
1042     Outdent(), Word("ELSE"), Walk(" ", x.v), Indent();
1043   }
1044   void Unparse(const EndIfStmt &x) { // R1138
1045     Outdent(), Word("END IF"), Walk(" ", x.v);
1046   }
1047   void Unparse(const IfStmt &x) { // R1139
1048     Word("IF ("), Walk(x.t, ") ");
1049   }
1050   void Unparse(const SelectCaseStmt &x) { // R1141, R1144
1051     Walk(std::get<std::optional<Name>>(x.t), ": ");
1052     Word("SELECT CASE (");
1053     Walk(std::get<Scalar<Expr>>(x.t)), Put(')'), Indent();
1054   }
1055   void Unparse(const CaseStmt &x) { // R1142
1056     Outdent(), Word("CASE "), Walk(std::get<CaseSelector>(x.t));
1057     Walk(" ", std::get<std::optional<Name>>(x.t)), Indent();
1058   }
1059   void Unparse(const EndSelectStmt &x) { // R1143 & R1151 & R1155
1060     Outdent(), Word("END SELECT"), Walk(" ", x.v);
1061   }
1062   void Unparse(const CaseSelector &x) { // R1145
1063     std::visit(common::visitors{
1064                    [&](const std::list<CaseValueRange> &y) {
1065                      Put('('), Walk(y), Put(')');
1066                    },
1067                    [&](const Default &) { Word("DEFAULT"); },
1068                },
1069         x.u);
1070   }
1071   void Unparse(const CaseValueRange::Range &x) { // R1146
1072     Walk(x.lower), Put(':'), Walk(x.upper);
1073   }
1074   void Unparse(const SelectRankStmt &x) { // R1149
1075     Walk(std::get<0>(x.t), ": ");
1076     Word("SELECT RANK ("), Walk(std::get<1>(x.t), " => ");
1077     Walk(std::get<Selector>(x.t)), Put(')'), Indent();
1078   }
1079   void Unparse(const SelectRankCaseStmt &x) { // R1150
1080     Outdent(), Word("RANK ");
1081     std::visit(common::visitors{
1082                    [&](const ScalarIntConstantExpr &y) {
1083                      Put('('), Walk(y), Put(')');
1084                    },
1085                    [&](const Star &) { Put("(*)"); },
1086                    [&](const Default &) { Word("DEFAULT"); },
1087                },
1088         std::get<SelectRankCaseStmt::Rank>(x.t).u);
1089     Walk(" ", std::get<std::optional<Name>>(x.t)), Indent();
1090   }
1091   void Unparse(const SelectTypeStmt &x) { // R1153
1092     Walk(std::get<0>(x.t), ": ");
1093     Word("SELECT TYPE ("), Walk(std::get<1>(x.t), " => ");
1094     Walk(std::get<Selector>(x.t)), Put(')'), Indent();
1095   }
1096   void Unparse(const TypeGuardStmt &x) { // R1154
1097     Outdent(), Walk(std::get<TypeGuardStmt::Guard>(x.t));
1098     Walk(" ", std::get<std::optional<Name>>(x.t)), Indent();
1099   }
1100   void Unparse(const TypeGuardStmt::Guard &x) {
1101     std::visit(
1102         common::visitors{
1103             [&](const TypeSpec &y) { Word("TYPE IS ("), Walk(y), Put(')'); },
1104             [&](const DerivedTypeSpec &y) {
1105               Word("CLASS IS ("), Walk(y), Put(')');
1106             },
1107             [&](const Default &) { Word("CLASS DEFAULT"); },
1108         },
1109         x.u);
1110   }
1111   void Unparse(const ExitStmt &x) { // R1156
1112     Word("EXIT"), Walk(" ", x.v);
1113   }
1114   void Before(const GotoStmt &) { // R1157
1115     Word("GO TO ");
1116   }
1117   void Unparse(const ComputedGotoStmt &x) { // R1158
1118     Word("GO TO ("), Walk(x.t, "), ");
1119   }
1120   void Unparse(const ContinueStmt &) { // R1159
1121     Word("CONTINUE");
1122   }
1123   void Unparse(const StopStmt &x) { // R1160, R1161
1124     if (std::get<StopStmt::Kind>(x.t) == StopStmt::Kind::ErrorStop) {
1125       Word("ERROR ");
1126     }
1127     Word("STOP"), Walk(" ", std::get<std::optional<StopCode>>(x.t));
1128     Walk(", QUIET=", std::get<std::optional<ScalarLogicalExpr>>(x.t));
1129   }
1130   void Unparse(const FailImageStmt &) { // R1163
1131     Word("FAIL IMAGE");
1132   }
1133   void Unparse(const SyncAllStmt &x) { // R1164
1134     Word("SYNC ALL ("), Walk(x.v, ", "), Put(')');
1135   }
1136   void Unparse(const SyncImagesStmt &x) { // R1166
1137     Word("SYNC IMAGES (");
1138     Walk(std::get<SyncImagesStmt::ImageSet>(x.t));
1139     Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
1140   }
1141   void Unparse(const SyncMemoryStmt &x) { // R1168
1142     Word("SYNC MEMORY ("), Walk(x.v, ", "), Put(')');
1143   }
1144   void Unparse(const SyncTeamStmt &x) { // R1169
1145     Word("SYNC TEAM ("), Walk(std::get<TeamValue>(x.t));
1146     Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
1147   }
1148   void Unparse(const EventPostStmt &x) { // R1170
1149     Word("EVENT POST ("), Walk(std::get<EventVariable>(x.t));
1150     Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
1151   }
1152   void Before(const EventWaitStmt::EventWaitSpec &x) { // R1173, R1174
1153     std::visit(common::visitors{
1154                    [&](const ScalarIntExpr &) { Word("UNTIL_COUNT="); },
1155                    [](const StatOrErrmsg &) {},
1156                },
1157         x.u);
1158   }
1159   void Unparse(const EventWaitStmt &x) { // R1170
1160     Word("EVENT WAIT ("), Walk(std::get<EventVariable>(x.t));
1161     Walk(", ", std::get<std::list<EventWaitStmt::EventWaitSpec>>(x.t), ", ");
1162     Put(')');
1163   }
1164   void Unparse(const FormTeamStmt &x) { // R1175, R1177
1165     Word("FORM TEAM ("), Walk(std::get<ScalarIntExpr>(x.t));
1166     Put(','), Walk(std::get<TeamVariable>(x.t));
1167     Walk(", ", std::get<std::list<FormTeamStmt::FormTeamSpec>>(x.t), ", ");
1168     Put(')');
1169   }
1170   void Before(const FormTeamStmt::FormTeamSpec &x) { // R1176, R1178
1171     std::visit(common::visitors{
1172                    [&](const ScalarIntExpr &) { Word("NEW_INDEX="); },
1173                    [](const StatOrErrmsg &) {},
1174                },
1175         x.u);
1176   }
1177   void Unparse(const LockStmt &x) { // R1179
1178     Word("LOCK ("), Walk(std::get<LockVariable>(x.t));
1179     Walk(", ", std::get<std::list<LockStmt::LockStat>>(x.t), ", ");
1180     Put(')');
1181   }
1182   void Before(const LockStmt::LockStat &x) { // R1180
1183     std::visit(
1184         common::visitors{
1185             [&](const ScalarLogicalVariable &) { Word("ACQUIRED_LOCK="); },
1186             [](const StatOrErrmsg &) {},
1187         },
1188         x.u);
1189   }
1190   void Unparse(const UnlockStmt &x) { // R1181
1191     Word("UNLOCK ("), Walk(std::get<LockVariable>(x.t));
1192     Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", ");
1193     Put(')');
1194   }
1195 
1196   void Unparse(const OpenStmt &x) { // R1204
1197     Word("OPEN ("), Walk(x.v, ", "), Put(')');
1198   }
1199   bool Pre(const ConnectSpec &x) { // R1205
1200     return std::visit(common::visitors{
1201                           [&](const FileUnitNumber &) {
1202                             Word("UNIT=");
1203                             return true;
1204                           },
1205                           [&](const FileNameExpr &) {
1206                             Word("FILE=");
1207                             return true;
1208                           },
1209                           [&](const ConnectSpec::CharExpr &y) {
1210                             Walk(y.t, "=");
1211                             return false;
1212                           },
1213                           [&](const MsgVariable &) {
1214                             Word("IOMSG=");
1215                             return true;
1216                           },
1217                           [&](const StatVariable &) {
1218                             Word("IOSTAT=");
1219                             return true;
1220                           },
1221                           [&](const ConnectSpec::Recl &) {
1222                             Word("RECL=");
1223                             return true;
1224                           },
1225                           [&](const ConnectSpec::Newunit &) {
1226                             Word("NEWUNIT=");
1227                             return true;
1228                           },
1229                           [&](const ErrLabel &) {
1230                             Word("ERR=");
1231                             return true;
1232                           },
1233                           [&](const StatusExpr &) {
1234                             Word("STATUS=");
1235                             return true;
1236                           },
1237                       },
1238         x.u);
1239   }
1240   void Unparse(const CloseStmt &x) { // R1208
1241     Word("CLOSE ("), Walk(x.v, ", "), Put(')');
1242   }
1243   void Before(const CloseStmt::CloseSpec &x) { // R1209
1244     std::visit(common::visitors{
1245                    [&](const FileUnitNumber &) { Word("UNIT="); },
1246                    [&](const StatVariable &) { Word("IOSTAT="); },
1247                    [&](const MsgVariable &) { Word("IOMSG="); },
1248                    [&](const ErrLabel &) { Word("ERR="); },
1249                    [&](const StatusExpr &) { Word("STATUS="); },
1250                },
1251         x.u);
1252   }
1253   void Unparse(const ReadStmt &x) { // R1210
1254     Word("READ ");
1255     if (x.iounit) {
1256       Put('('), Walk(x.iounit);
1257       if (x.format) {
1258         Put(", "), Walk(x.format);
1259       }
1260       Walk(", ", x.controls, ", ");
1261       Put(')');
1262     } else if (x.format) {
1263       Walk(x.format);
1264       if (!x.items.empty()) {
1265         Put(", ");
1266       }
1267     } else {
1268       Put('('), Walk(x.controls, ", "), Put(')');
1269     }
1270     Walk(" ", x.items, ", ");
1271   }
1272   void Unparse(const WriteStmt &x) { // R1211
1273     Word("WRITE (");
1274     if (x.iounit) {
1275       Walk(x.iounit);
1276       if (x.format) {
1277         Put(", "), Walk(x.format);
1278       }
1279       Walk(", ", x.controls, ", ");
1280     } else {
1281       Walk(x.controls, ", ");
1282     }
1283     Put(')'), Walk(" ", x.items, ", ");
1284   }
1285   void Unparse(const PrintStmt &x) { // R1212
1286     Word("PRINT "), Walk(std::get<Format>(x.t));
1287     Walk(", ", std::get<std::list<OutputItem>>(x.t), ", ");
1288   }
1289   bool Pre(const IoControlSpec &x) { // R1213
1290     return std::visit(common::visitors{
1291                           [&](const IoUnit &) {
1292                             Word("UNIT=");
1293                             return true;
1294                           },
1295                           [&](const Format &) {
1296                             Word("FMT=");
1297                             return true;
1298                           },
1299                           [&](const Name &) {
1300                             Word("NML=");
1301                             return true;
1302                           },
1303                           [&](const IoControlSpec::CharExpr &y) {
1304                             Walk(y.t, "=");
1305                             return false;
1306                           },
1307                           [&](const IoControlSpec::Asynchronous &) {
1308                             Word("ASYNCHRONOUS=");
1309                             return true;
1310                           },
1311                           [&](const EndLabel &) {
1312                             Word("END=");
1313                             return true;
1314                           },
1315                           [&](const EorLabel &) {
1316                             Word("EOR=");
1317                             return true;
1318                           },
1319                           [&](const ErrLabel &) {
1320                             Word("ERR=");
1321                             return true;
1322                           },
1323                           [&](const IdVariable &) {
1324                             Word("ID=");
1325                             return true;
1326                           },
1327                           [&](const MsgVariable &) {
1328                             Word("IOMSG=");
1329                             return true;
1330                           },
1331                           [&](const StatVariable &) {
1332                             Word("IOSTAT=");
1333                             return true;
1334                           },
1335                           [&](const IoControlSpec::Pos &) {
1336                             Word("POS=");
1337                             return true;
1338                           },
1339                           [&](const IoControlSpec::Rec &) {
1340                             Word("REC=");
1341                             return true;
1342                           },
1343                           [&](const IoControlSpec::Size &) {
1344                             Word("SIZE=");
1345                             return true;
1346                           },
1347                       },
1348         x.u);
1349   }
1350   void Unparse(const InputImpliedDo &x) { // R1218
1351     Put('('), Walk(std::get<std::list<InputItem>>(x.t), ", "), Put(", ");
1352     Walk(std::get<IoImpliedDoControl>(x.t)), Put(')');
1353   }
1354   void Unparse(const OutputImpliedDo &x) { // R1219
1355     Put('('), Walk(std::get<std::list<OutputItem>>(x.t), ", "), Put(", ");
1356     Walk(std::get<IoImpliedDoControl>(x.t)), Put(')');
1357   }
1358   void Unparse(const WaitStmt &x) { // R1222
1359     Word("WAIT ("), Walk(x.v, ", "), Put(')');
1360   }
1361   void Before(const WaitSpec &x) { // R1223
1362     std::visit(common::visitors{
1363                    [&](const FileUnitNumber &) { Word("UNIT="); },
1364                    [&](const EndLabel &) { Word("END="); },
1365                    [&](const EorLabel &) { Word("EOR="); },
1366                    [&](const ErrLabel &) { Word("ERR="); },
1367                    [&](const IdExpr &) { Word("ID="); },
1368                    [&](const MsgVariable &) { Word("IOMSG="); },
1369                    [&](const StatVariable &) { Word("IOSTAT="); },
1370                },
1371         x.u);
1372   }
1373   void Unparse(const BackspaceStmt &x) { // R1224
1374     Word("BACKSPACE ("), Walk(x.v, ", "), Put(')');
1375   }
1376   void Unparse(const EndfileStmt &x) { // R1225
1377     Word("ENDFILE ("), Walk(x.v, ", "), Put(')');
1378   }
1379   void Unparse(const RewindStmt &x) { // R1226
1380     Word("REWIND ("), Walk(x.v, ", "), Put(')');
1381   }
1382   void Before(const PositionOrFlushSpec &x) { // R1227 & R1229
1383     std::visit(common::visitors{
1384                    [&](const FileUnitNumber &) { Word("UNIT="); },
1385                    [&](const MsgVariable &) { Word("IOMSG="); },
1386                    [&](const StatVariable &) { Word("IOSTAT="); },
1387                    [&](const ErrLabel &) { Word("ERR="); },
1388                },
1389         x.u);
1390   }
1391   void Unparse(const FlushStmt &x) { // R1228
1392     Word("FLUSH ("), Walk(x.v, ", "), Put(')');
1393   }
1394   void Unparse(const InquireStmt &x) { // R1230
1395     Word("INQUIRE (");
1396     std::visit(
1397         common::visitors{
1398             [&](const InquireStmt::Iolength &y) {
1399               Word("IOLENGTH="), Walk(y.t, ") ");
1400             },
1401             [&](const std::list<InquireSpec> &y) { Walk(y, ", "), Put(')'); },
1402         },
1403         x.u);
1404   }
1405   bool Pre(const InquireSpec &x) { // R1231
1406     return std::visit(common::visitors{
1407                           [&](const FileUnitNumber &) {
1408                             Word("UNIT=");
1409                             return true;
1410                           },
1411                           [&](const FileNameExpr &) {
1412                             Word("FILE=");
1413                             return true;
1414                           },
1415                           [&](const InquireSpec::CharVar &y) {
1416                             Walk(y.t, "=");
1417                             return false;
1418                           },
1419                           [&](const InquireSpec::IntVar &y) {
1420                             Walk(y.t, "=");
1421                             return false;
1422                           },
1423                           [&](const InquireSpec::LogVar &y) {
1424                             Walk(y.t, "=");
1425                             return false;
1426                           },
1427                           [&](const IdExpr &) {
1428                             Word("ID=");
1429                             return true;
1430                           },
1431                           [&](const ErrLabel &) {
1432                             Word("ERR=");
1433                             return true;
1434                           },
1435                       },
1436         x.u);
1437   }
1438 
1439   void Before(const FormatStmt &) { // R1301
1440     Word("FORMAT");
1441   }
1442   void Unparse(const format::FormatSpecification &x) { // R1302, R1303, R1305
1443     Put('('), Walk("", x.items, ",", x.unlimitedItems.empty() ? "" : ",");
1444     Walk("*(", x.unlimitedItems, ",", ")"), Put(')');
1445   }
1446   void Unparse(const format::FormatItem &x) { // R1304, R1306, R1321
1447     if (x.repeatCount) {
1448       Walk(*x.repeatCount);
1449     }
1450     std::visit(common::visitors{
1451                    [&](const std::string &y) { PutNormalized(y); },
1452                    [&](const std::list<format::FormatItem> &y) {
1453                      Walk("(", y, ",", ")");
1454                    },
1455                    [&](const auto &y) { Walk(y); },
1456                },
1457         x.u);
1458   }
1459   void Unparse(
1460       const format::IntrinsicTypeDataEditDesc &x) { // R1307(1/2) - R1311
1461     switch (x.kind) {
1462 #define FMT(x) \
1463   case format::IntrinsicTypeDataEditDesc::Kind::x: \
1464     Put(#x); \
1465     break
1466       FMT(I);
1467       FMT(B);
1468       FMT(O);
1469       FMT(Z);
1470       FMT(F);
1471       FMT(E);
1472       FMT(EN);
1473       FMT(ES);
1474       FMT(EX);
1475       FMT(G);
1476       FMT(L);
1477       FMT(A);
1478       FMT(D);
1479 #undef FMT
1480     }
1481     Walk(x.width), Walk(".", x.digits), Walk("E", x.exponentWidth);
1482   }
1483   void Unparse(const format::DerivedTypeDataEditDesc &x) { // R1307(2/2), R1312
1484     Word("DT");
1485     if (!x.type.empty()) {
1486       Put('"'), Put(x.type), Put('"');
1487     }
1488     Walk("(", x.parameters, ",", ")");
1489   }
1490   void Unparse(const format::ControlEditDesc &x) { // R1313, R1315-R1320
1491     switch (x.kind) {
1492     case format::ControlEditDesc::Kind::T:
1493       Word("T");
1494       Walk(x.count);
1495       break;
1496     case format::ControlEditDesc::Kind::TL:
1497       Word("TL");
1498       Walk(x.count);
1499       break;
1500     case format::ControlEditDesc::Kind::TR:
1501       Word("TR");
1502       Walk(x.count);
1503       break;
1504     case format::ControlEditDesc::Kind::X:
1505       if (x.count != 1) {
1506         Walk(x.count);
1507       }
1508       Word("X");
1509       break;
1510     case format::ControlEditDesc::Kind::Slash:
1511       if (x.count != 1) {
1512         Walk(x.count);
1513       }
1514       Put('/');
1515       break;
1516     case format::ControlEditDesc::Kind::Colon:
1517       Put(':');
1518       break;
1519     case format::ControlEditDesc::Kind::P:
1520       Walk(x.count);
1521       Word("P");
1522       break;
1523 #define FMT(x) \
1524   case format::ControlEditDesc::Kind::x: \
1525     Put(#x); \
1526     break
1527       FMT(SS);
1528       FMT(SP);
1529       FMT(S);
1530       FMT(BN);
1531       FMT(BZ);
1532       FMT(RU);
1533       FMT(RD);
1534       FMT(RZ);
1535       FMT(RN);
1536       FMT(RC);
1537       FMT(RP);
1538       FMT(DC);
1539       FMT(DP);
1540 #undef FMT
1541     case format::ControlEditDesc::Kind::Dollar:
1542       Put('$');
1543       break;
1544     case format::ControlEditDesc::Kind::Backslash:
1545       Put('\\');
1546       break;
1547     }
1548   }
1549 
1550   void Before(const MainProgram &x) { // R1401
1551     if (!std::get<std::optional<Statement<ProgramStmt>>>(x.t)) {
1552       Indent();
1553     }
1554   }
1555   void Before(const ProgramStmt &) { // R1402
1556     Word("PROGRAM "), Indent();
1557   }
1558   void Unparse(const EndProgramStmt &x) { // R1403
1559     EndSubprogram("PROGRAM", x.v);
1560   }
1561   void Before(const ModuleStmt &) { // R1405
1562     Word("MODULE "), Indent();
1563   }
1564   void Unparse(const EndModuleStmt &x) { // R1406
1565     EndSubprogram("MODULE", x.v);
1566   }
1567   void Unparse(const UseStmt &x) { // R1409
1568     Word("USE"), Walk(", ", x.nature), Put(" :: "), Walk(x.moduleName);
1569     std::visit(common::visitors{
1570                    [&](const std::list<Rename> &y) { Walk(", ", y, ", "); },
1571                    [&](const std::list<Only> &y) { Walk(", ONLY: ", y, ", "); },
1572                },
1573         x.u);
1574   }
1575   void Unparse(const Rename &x) { // R1411
1576     std::visit(common::visitors{
1577                    [&](const Rename::Names &y) { Walk(y.t, " => "); },
1578                    [&](const Rename::Operators &y) {
1579                      Word("OPERATOR("), Walk(y.t, ") => OPERATOR("), Put(")");
1580                    },
1581                },
1582         x.u);
1583   }
1584   void Unparse(const SubmoduleStmt &x) { // R1417
1585     Word("SUBMODULE ("), WalkTupleElements(x.t, ")"), Indent();
1586   }
1587   void Unparse(const ParentIdentifier &x) { // R1418
1588     Walk(std::get<Name>(x.t)), Walk(":", std::get<std::optional<Name>>(x.t));
1589   }
1590   void Unparse(const EndSubmoduleStmt &x) { // R1419
1591     EndSubprogram("SUBMODULE", x.v);
1592   }
1593   void Unparse(const BlockDataStmt &x) { // R1421
1594     Word("BLOCK DATA"), Walk(" ", x.v), Indent();
1595   }
1596   void Unparse(const EndBlockDataStmt &x) { // R1422
1597     EndSubprogram("BLOCK DATA", x.v);
1598   }
1599 
1600   void Unparse(const InterfaceStmt &x) { // R1503
1601     std::visit(common::visitors{
1602                    [&](const std::optional<GenericSpec> &y) {
1603                      Word("INTERFACE"), Walk(" ", y);
1604                    },
1605                    [&](const Abstract &) { Word("ABSTRACT INTERFACE"); },
1606                },
1607         x.u);
1608     Indent();
1609   }
1610   void Unparse(const EndInterfaceStmt &x) { // R1504
1611     Outdent(), Word("END INTERFACE"), Walk(" ", x.v);
1612   }
1613   void Unparse(const ProcedureStmt &x) { // R1506
1614     if (std::get<ProcedureStmt::Kind>(x.t) ==
1615         ProcedureStmt::Kind::ModuleProcedure) {
1616       Word("MODULE ");
1617     }
1618     Word("PROCEDURE :: ");
1619     Walk(std::get<std::list<Name>>(x.t), ", ");
1620   }
1621   void Before(const GenericSpec &x) { // R1508, R1509
1622     std::visit(
1623         common::visitors{
1624             [&](const DefinedOperator &) { Word("OPERATOR("); },
1625             [&](const GenericSpec::Assignment &) { Word("ASSIGNMENT(=)"); },
1626             [&](const GenericSpec::ReadFormatted &) {
1627               Word("READ(FORMATTED)");
1628             },
1629             [&](const GenericSpec::ReadUnformatted &) {
1630               Word("READ(UNFORMATTED)");
1631             },
1632             [&](const GenericSpec::WriteFormatted &) {
1633               Word("WRITE(FORMATTED)");
1634             },
1635             [&](const GenericSpec::WriteUnformatted &) {
1636               Word("WRITE(UNFORMATTED)");
1637             },
1638             [](const auto &) {},
1639         },
1640         x.u);
1641   }
1642   void Post(const GenericSpec &x) {
1643     std::visit(common::visitors{
1644                    [&](const DefinedOperator &) { Put(')'); },
1645                    [](const auto &) {},
1646                },
1647         x.u);
1648   }
1649   void Unparse(const GenericStmt &x) { // R1510
1650     Word("GENERIC"), Walk(", ", std::get<std::optional<AccessSpec>>(x.t));
1651     Put(" :: "), Walk(std::get<GenericSpec>(x.t)), Put(" => ");
1652     Walk(std::get<std::list<Name>>(x.t), ", ");
1653   }
1654   void Unparse(const ExternalStmt &x) { // R1511
1655     Word("EXTERNAL :: "), Walk(x.v, ", ");
1656   }
1657   void Unparse(const ProcedureDeclarationStmt &x) { // R1512
1658     Word("PROCEDURE("), Walk(std::get<std::optional<ProcInterface>>(x.t));
1659     Put(')'), Walk(", ", std::get<std::list<ProcAttrSpec>>(x.t), ", ");
1660     Put(" :: "), Walk(std::get<std::list<ProcDecl>>(x.t), ", ");
1661   }
1662   void Unparse(const ProcDecl &x) { // R1515
1663     Walk(std::get<Name>(x.t));
1664     Walk(" => ", std::get<std::optional<ProcPointerInit>>(x.t));
1665   }
1666   void Unparse(const IntrinsicStmt &x) { // R1519
1667     Word("INTRINSIC :: "), Walk(x.v, ", ");
1668   }
1669   void Unparse(const FunctionReference &x) { // R1520
1670     Walk(std::get<ProcedureDesignator>(x.v.t));
1671     Put('('), Walk(std::get<std::list<ActualArgSpec>>(x.v.t), ", "), Put(')');
1672   }
1673   void Unparse(const CallStmt &x) { // R1521
1674     if (asFortran_ && x.typedCall.get()) {
1675       Put(' ');
1676       asFortran_->call(out_, *x.typedCall);
1677       Put('\n');
1678     } else {
1679       const auto &pd{std::get<ProcedureDesignator>(x.v.t)};
1680       const auto &args{std::get<std::list<ActualArgSpec>>(x.v.t)};
1681       Word("CALL "), Walk(pd);
1682       if (args.empty()) {
1683         if (std::holds_alternative<ProcComponentRef>(pd.u)) {
1684           Put("()"); // pgf90 crashes on CALL to tbp without parentheses
1685         }
1686       } else {
1687         Walk("(", args, ", ", ")");
1688       }
1689     }
1690   }
1691   void Unparse(const ActualArgSpec &x) { // R1523
1692     Walk(std::get<std::optional<Keyword>>(x.t), "=");
1693     Walk(std::get<ActualArg>(x.t));
1694   }
1695   void Unparse(const ActualArg::PercentRef &x) { // R1524
1696     Word("%REF("), Walk(x.v), Put(')');
1697   }
1698   void Unparse(const ActualArg::PercentVal &x) {
1699     Word("%VAL("), Walk(x.v), Put(')');
1700   }
1701   void Before(const AltReturnSpec &) { // R1525
1702     Put('*');
1703   }
1704   void Post(const PrefixSpec::Elemental) { Word("ELEMENTAL"); } // R1527
1705   void Post(const PrefixSpec::Impure) { Word("IMPURE"); }
1706   void Post(const PrefixSpec::Module) { Word("MODULE"); }
1707   void Post(const PrefixSpec::Non_Recursive) { Word("NON_RECURSIVE"); }
1708   void Post(const PrefixSpec::Pure) { Word("PURE"); }
1709   void Post(const PrefixSpec::Recursive) { Word("RECURSIVE"); }
1710   void Unparse(const FunctionStmt &x) { // R1530
1711     Walk("", std::get<std::list<PrefixSpec>>(x.t), " ", " ");
1712     Word("FUNCTION "), Walk(std::get<Name>(x.t)), Put("(");
1713     Walk(std::get<std::list<Name>>(x.t), ", "), Put(')');
1714     Walk(" ", std::get<std::optional<Suffix>>(x.t)), Indent();
1715   }
1716   void Unparse(const Suffix &x) { // R1532
1717     if (x.resultName) {
1718       Word("RESULT("), Walk(x.resultName), Put(')');
1719       Walk(" ", x.binding);
1720     } else {
1721       Walk(x.binding);
1722     }
1723   }
1724   void Unparse(const EndFunctionStmt &x) { // R1533
1725     EndSubprogram("FUNCTION", x.v);
1726   }
1727   void Unparse(const SubroutineStmt &x) { // R1535
1728     Walk("", std::get<std::list<PrefixSpec>>(x.t), " ", " ");
1729     Word("SUBROUTINE "), Walk(std::get<Name>(x.t));
1730     const auto &args{std::get<std::list<DummyArg>>(x.t)};
1731     const auto &bind{std::get<std::optional<LanguageBindingSpec>>(x.t)};
1732     if (args.empty()) {
1733       Walk(" () ", bind);
1734     } else {
1735       Walk(" (", args, ", ", ")");
1736       Walk(" ", bind);
1737     }
1738     Indent();
1739   }
1740   void Unparse(const EndSubroutineStmt &x) { // R1537
1741     EndSubprogram("SUBROUTINE", x.v);
1742   }
1743   void Before(const MpSubprogramStmt &) { // R1539
1744     Word("MODULE PROCEDURE "), Indent();
1745   }
1746   void Unparse(const EndMpSubprogramStmt &x) { // R1540
1747     EndSubprogram("PROCEDURE", x.v);
1748   }
1749   void Unparse(const EntryStmt &x) { // R1541
1750     Word("ENTRY "), Walk(std::get<Name>(x.t)), Put("(");
1751     Walk(std::get<std::list<DummyArg>>(x.t), ", "), Put(")");
1752     Walk(" ", std::get<std::optional<Suffix>>(x.t));
1753   }
1754   void Unparse(const ReturnStmt &x) { // R1542
1755     Word("RETURN"), Walk(" ", x.v);
1756   }
1757   void Unparse(const ContainsStmt &) { // R1543
1758     Outdent();
1759     Word("CONTAINS");
1760     Indent();
1761   }
1762   void Unparse(const StmtFunctionStmt &x) { // R1544
1763     Walk(std::get<Name>(x.t)), Put('(');
1764     Walk(std::get<std::list<Name>>(x.t), ", "), Put(") = ");
1765     Walk(std::get<Scalar<Expr>>(x.t));
1766   }
1767 
1768   // Directives, extensions, and deprecated constructs
1769   void Unparse(const CompilerDirective &x) {
1770     std::visit(
1771         common::visitors{
1772             [&](const std::list<CompilerDirective::IgnoreTKR> &tkr) {
1773               Word("!DIR$ IGNORE_TKR"); // emitted even if tkr list is empty
1774               Walk(" ", tkr, ", ");
1775             },
1776             [&](const std::list<CompilerDirective::NameValue> &names) {
1777               Walk("!DIR$ ", names, " ");
1778             },
1779         },
1780         x.u);
1781     Put('\n');
1782   }
1783   void Unparse(const CompilerDirective::IgnoreTKR &x) {
1784     const auto &list{std::get<std::list<const char *>>(x.t)};
1785     if (!list.empty()) {
1786       Put("(");
1787       for (const char *tkr : list) {
1788         Put(*tkr);
1789       }
1790       Put(") ");
1791     }
1792     Walk(std::get<Name>(x.t));
1793   }
1794   void Unparse(const CompilerDirective::NameValue &x) {
1795     Walk(std::get<Name>(x.t));
1796     Walk("=", std::get<std::optional<std::uint64_t>>(x.t));
1797   }
1798 
1799   // OpenACC Directives & Clauses
1800   void Unparse(const AccAtomicCapture &x) {
1801     BeginOpenACC();
1802     Word("!$ACC CAPTURE");
1803     Put("\n");
1804     EndOpenACC();
1805     Walk(std::get<AccAtomicCapture::Stmt1>(x.t));
1806     Put("\n");
1807     Walk(std::get<AccAtomicCapture::Stmt2>(x.t));
1808     BeginOpenACC();
1809     Word("!$ACC END ATOMIC\n");
1810     EndOpenACC();
1811   }
1812   void Unparse(const AccAtomicRead &x) {
1813     BeginOpenACC();
1814     Word("!$ACC ATOMIC READ");
1815     Put("\n");
1816     EndOpenACC();
1817     Walk(std::get<Statement<AssignmentStmt>>(x.t));
1818     BeginOpenACC();
1819     Walk(std::get<std::optional<AccEndAtomic>>(x.t), "!$ACC END ATOMIC\n");
1820     EndOpenACC();
1821   }
1822   void Unparse(const AccAtomicWrite &x) {
1823     BeginOpenACC();
1824     Word("!$ACC ATOMIC WRITE");
1825     Put("\n");
1826     EndOpenACC();
1827     Walk(std::get<Statement<AssignmentStmt>>(x.t));
1828     BeginOpenACC();
1829     Walk(std::get<std::optional<AccEndAtomic>>(x.t), "!$ACC END ATOMIC\n");
1830     EndOpenACC();
1831   }
1832   void Unparse(const AccAtomicUpdate &x) {
1833     BeginOpenACC();
1834     Word("!$ACC ATOMIC UPDATE");
1835     Put("\n");
1836     EndOpenACC();
1837     Walk(std::get<Statement<AssignmentStmt>>(x.t));
1838     BeginOpenACC();
1839     Walk(std::get<std::optional<AccEndAtomic>>(x.t), "!$ACC END ATOMIC\n");
1840     EndOpenACC();
1841   }
1842   void Unparse(const llvm::acc::Directive &x) {
1843     Word(llvm::acc::getOpenACCDirectiveName(x).str());
1844   }
1845 #define GEN_FLANG_CLAUSE_UNPARSE
1846 #include "llvm/Frontend/OpenACC/ACC.inc"
1847   void Unparse(const AccObjectListWithModifier &x) {
1848     Walk(std::get<std::optional<AccDataModifier>>(x.t), ":");
1849     Walk(std::get<AccObjectList>(x.t));
1850   }
1851   void Unparse(const AccDataModifier::Modifier &x) {
1852     Word(AccDataModifier::EnumToString(x));
1853   }
1854   void Unparse(const AccBindClause &x) {
1855     std::visit(common::visitors{
1856                    [&](const Name &y) { Put('('), Walk(y), Put(')'); },
1857                    [&](const ScalarDefaultCharExpr &y) {
1858                      Put('('), Walk(y), Put(')');
1859                    },
1860                },
1861         x.u);
1862   }
1863   void Unparse(const AccDefaultClause &x) {
1864     switch (x.v) {
1865     case llvm::acc::DefaultValue::ACC_Default_none:
1866       Put("NONE");
1867       break;
1868     case llvm::acc::DefaultValue::ACC_Default_present:
1869       Put("PRESENT");
1870       break;
1871     }
1872   }
1873   void Unparse(const AccClauseList &x) { Walk(" ", x.v, " "); }
1874   void Unparse(const AccGangArgument &x) {
1875     Walk("NUM:", std::get<std::optional<ScalarIntExpr>>(x.t));
1876     Walk(", STATIC:", std::get<std::optional<AccSizeExpr>>(x.t));
1877   }
1878   void Unparse(const OpenACCBlockConstruct &x) {
1879     BeginOpenACC();
1880     Word("!$ACC ");
1881     Walk(std::get<AccBeginBlockDirective>(x.t));
1882     Put("\n");
1883     EndOpenACC();
1884     Walk(std::get<Block>(x.t), "");
1885     BeginOpenACC();
1886     Word("!$ACC END ");
1887     Walk(std::get<AccEndBlockDirective>(x.t));
1888     Put("\n");
1889     EndOpenACC();
1890   }
1891   void Unparse(const OpenACCLoopConstruct &x) {
1892     BeginOpenACC();
1893     Word("!$ACC ");
1894     Walk(std::get<AccBeginLoopDirective>(x.t));
1895     Put("\n");
1896     EndOpenACC();
1897     Walk(std::get<std::optional<DoConstruct>>(x.t));
1898   }
1899   void Unparse(const AccBeginLoopDirective &x) {
1900     Walk(std::get<AccLoopDirective>(x.t));
1901     Walk(std::get<AccClauseList>(x.t));
1902   }
1903   void Unparse(const OpenACCStandaloneConstruct &x) {
1904     BeginOpenACC();
1905     Word("!$ACC ");
1906     Walk(std::get<AccStandaloneDirective>(x.t));
1907     Walk(std::get<AccClauseList>(x.t));
1908     Put("\n");
1909     EndOpenACC();
1910   }
1911   void Unparse(const OpenACCStandaloneDeclarativeConstruct &x) {
1912     BeginOpenACC();
1913     Word("!$ACC ");
1914     Walk(std::get<AccDeclarativeDirective>(x.t));
1915     Walk(std::get<AccClauseList>(x.t));
1916     Put("\n");
1917     EndOpenACC();
1918   }
1919   void Unparse(const OpenACCCombinedConstruct &x) {
1920     BeginOpenACC();
1921     Word("!$ACC ");
1922     Walk(std::get<AccBeginCombinedDirective>(x.t));
1923     Put("\n");
1924     EndOpenACC();
1925     Walk(std::get<std::optional<DoConstruct>>(x.t));
1926     BeginOpenACC();
1927     Walk("!$ACC END ", std::get<std::optional<AccEndCombinedDirective>>(x.t),
1928         "\n");
1929     EndOpenACC();
1930   }
1931   void Unparse(const OpenACCRoutineConstruct &x) {
1932     BeginOpenACC();
1933     Word("!$ACC ROUTINE");
1934     Walk("(", std::get<std::optional<Name>>(x.t), ")");
1935     Walk(std::get<AccClauseList>(x.t));
1936     Put("\n");
1937     EndOpenACC();
1938   }
1939   void Unparse(const AccObject &x) {
1940     std::visit(common::visitors{
1941                    [&](const Designator &y) { Walk(y); },
1942                    [&](const Name &y) { Put("/"), Walk(y), Put("/"); },
1943                },
1944         x.u);
1945   }
1946   void Unparse(const AccObjectList &x) { Walk(x.v, ","); }
1947   void Unparse(const AccReductionOperator::Operator &x) {
1948     Word(AccReductionOperator::EnumToString(x));
1949   }
1950   void Unparse(const AccObjectListWithReduction &x) {
1951     Walk(std::get<AccReductionOperator>(x.t));
1952     Put(":");
1953     Walk(std::get<AccObjectList>(x.t));
1954   }
1955   void Unparse(const OpenACCCacheConstruct &x) {
1956     BeginOpenACC();
1957     Word("!$ACC ");
1958     Word("CACHE(");
1959     Walk(std::get<AccObjectListWithModifier>(x.t));
1960     Put(")");
1961     Put("\n");
1962     EndOpenACC();
1963   }
1964   void Unparse(const AccWaitArgument &x) {
1965     Walk("DEVNUM:", std::get<std::optional<ScalarIntExpr>>(x.t), ":");
1966     Walk(std::get<std::list<ScalarIntExpr>>(x.t), ",");
1967   }
1968   void Unparse(const OpenACCWaitConstruct &x) {
1969     BeginOpenACC();
1970     Word("!$ACC ");
1971     Word("WAIT(");
1972     Walk(std::get<std::optional<AccWaitArgument>>(x.t));
1973     Walk(std::get<AccClauseList>(x.t));
1974     Put(")");
1975     Put("\n");
1976     EndOpenACC();
1977   }
1978 
1979   // OpenMP Clauses & Directives
1980   void Unparse(const OmpObject &x) {
1981     std::visit(common::visitors{
1982                    [&](const Designator &y) { Walk(y); },
1983                    [&](const Name &y) { Put("/"), Walk(y), Put("/"); },
1984                },
1985         x.u);
1986   }
1987   void Unparse(const OmpMapType::Always &) { Word("ALWAYS,"); }
1988   void Unparse(const OmpMapClause &x) {
1989     Walk(std::get<std::optional<OmpMapType>>(x.t), ":");
1990     Walk(std::get<OmpObjectList>(x.t));
1991   }
1992   void Unparse(const OmpScheduleModifier &x) {
1993     Walk(std::get<OmpScheduleModifier::Modifier1>(x.t));
1994     Walk(",", std::get<std::optional<OmpScheduleModifier::Modifier2>>(x.t));
1995   }
1996   void Unparse(const OmpScheduleClause &x) {
1997     Walk(std::get<std::optional<OmpScheduleModifier>>(x.t), ":");
1998     Walk(std::get<OmpScheduleClause::ScheduleType>(x.t));
1999     Walk(",", std::get<std::optional<ScalarIntExpr>>(x.t));
2000   }
2001   void Unparse(const OmpAlignedClause &x) {
2002     Walk(std::get<std::list<Name>>(x.t), ",");
2003     Walk(std::get<std::optional<ScalarIntConstantExpr>>(x.t));
2004   }
2005   void Unparse(const OmpIfClause &x) {
2006     Walk(std::get<std::optional<OmpIfClause::DirectiveNameModifier>>(x.t), ":");
2007     Walk(std::get<ScalarLogicalExpr>(x.t));
2008   }
2009   void Unparse(const OmpLinearClause::WithoutModifier &x) {
2010     Walk(x.names, ", ");
2011     Walk(":", x.step);
2012   }
2013   void Unparse(const OmpLinearClause::WithModifier &x) {
2014     Walk(x.modifier), Put("("), Walk(x.names, ","), Put(")");
2015     Walk(":", x.step);
2016   }
2017   void Unparse(const OmpReductionClause &x) {
2018     Walk(std::get<OmpReductionOperator>(x.t));
2019     Put(":");
2020     Walk(std::get<OmpObjectList>(x.t));
2021   }
2022   void Unparse(const OmpAllocateClause &x) {
2023     Walk(std::get<std::optional<OmpAllocateClause::Allocator>>(x.t));
2024     Put(":");
2025     Walk(std::get<OmpObjectList>(x.t));
2026   }
2027   void Unparse(const OmpDependSinkVecLength &x) {
2028     Walk(std::get<DefinedOperator>(x.t));
2029     Walk(std::get<ScalarIntConstantExpr>(x.t));
2030   }
2031   void Unparse(const OmpDependSinkVec &x) {
2032     Walk(std::get<Name>(x.t));
2033     Walk(std::get<std::optional<OmpDependSinkVecLength>>(x.t));
2034   }
2035   void Unparse(const OmpDependClause::InOut &x) {
2036     Put("(");
2037     Walk(std::get<OmpDependenceType>(x.t));
2038     Put(":");
2039     Walk(std::get<std::list<Designator>>(x.t), ",");
2040     Put(")");
2041   }
2042   bool Pre(const OmpDependClause &x) {
2043     return std::visit(common::visitors{
2044                           [&](const OmpDependClause::Source &) {
2045                             Word("SOURCE");
2046                             return false;
2047                           },
2048                           [&](const OmpDependClause::Sink &y) {
2049                             Word("SINK:");
2050                             Walk(y.v);
2051                             Put(")");
2052                             return false;
2053                           },
2054                           [&](const OmpDependClause::InOut &) { return true; },
2055                       },
2056         x.u);
2057   }
2058   void Unparse(const OmpDefaultmapClause &x) {
2059     Walk(std::get<OmpDefaultmapClause::ImplicitBehavior>(x.t));
2060     Walk(":",
2061         std::get<std::optional<OmpDefaultmapClause::VariableCategory>>(x.t));
2062   }
2063 #define GEN_FLANG_CLAUSE_UNPARSE
2064 #include "llvm/Frontend/OpenMP/OMP.inc"
2065   void Unparse(const OmpLoopDirective &x) {
2066     switch (x.v) {
2067     case llvm::omp::Directive::OMPD_distribute:
2068       Word("DISTRIBUTE ");
2069       break;
2070     case llvm::omp::Directive::OMPD_distribute_parallel_do:
2071       Word("DISTRIBUTE PARALLEL DO ");
2072       break;
2073     case llvm::omp::Directive::OMPD_distribute_parallel_do_simd:
2074       Word("DISTRIBUTE PARALLEL DO SIMD ");
2075       break;
2076     case llvm::omp::Directive::OMPD_distribute_simd:
2077       Word("DISTRIBUTE SIMD ");
2078       break;
2079     case llvm::omp::Directive::OMPD_do:
2080       Word("DO ");
2081       break;
2082     case llvm::omp::Directive::OMPD_do_simd:
2083       Word("DO SIMD ");
2084       break;
2085     case llvm::omp::Directive::OMPD_parallel_do:
2086       Word("PARALLEL DO ");
2087       break;
2088     case llvm::omp::Directive::OMPD_parallel_do_simd:
2089       Word("PARALLEL DO SIMD ");
2090       break;
2091     case llvm::omp::Directive::OMPD_simd:
2092       Word("SIMD ");
2093       break;
2094     case llvm::omp::Directive::OMPD_target_parallel_do:
2095       Word("TARGET PARALLEL DO ");
2096       break;
2097     case llvm::omp::Directive::OMPD_target_parallel_do_simd:
2098       Word("TARGET PARALLEL DO SIMD ");
2099       break;
2100     case llvm::omp::Directive::OMPD_target_teams_distribute:
2101       Word("TARGET TEAMS DISTRIBUTE ");
2102       break;
2103     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
2104       Word("TARGET TEAMS DISTRIBUTE PARALLEL DO ");
2105       break;
2106     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
2107       Word("TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD ");
2108       break;
2109     case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
2110       Word("TARGET TEAMS DISTRIBUTE SIMD ");
2111       break;
2112     case llvm::omp::Directive::OMPD_target_simd:
2113       Word("TARGET SIMD ");
2114       break;
2115     case llvm::omp::Directive::OMPD_taskloop:
2116       Word("TASKLOOP ");
2117       break;
2118     case llvm::omp::Directive::OMPD_taskloop_simd:
2119       Word("TASKLOOP SIMD ");
2120       break;
2121     case llvm::omp::Directive::OMPD_teams_distribute:
2122       Word("TEAMS DISTRIBUTE ");
2123       break;
2124     case llvm::omp::Directive::OMPD_teams_distribute_parallel_do:
2125       Word("TEAMS DISTRIBUTE PARALLEL DO ");
2126       break;
2127     case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd:
2128       Word("TEAMS DISTRIBUTE PARALLEL DO SIMD ");
2129       break;
2130     case llvm::omp::Directive::OMPD_teams_distribute_simd:
2131       Word("TEAMS DISTRIBUTE SIMD ");
2132       break;
2133     default:
2134       break;
2135     }
2136   }
2137   void Unparse(const OmpObjectList &x) { Walk(x.v, ","); }
2138   void Unparse(const OmpSimpleStandaloneDirective &x) {
2139     switch (x.v) {
2140     case llvm::omp::Directive::OMPD_barrier:
2141       Word("BARRIER ");
2142       break;
2143     case llvm::omp::Directive::OMPD_taskwait:
2144       Word("TASKWAIT ");
2145       break;
2146     case llvm::omp::Directive::OMPD_taskyield:
2147       Word("TASKYIELD ");
2148       break;
2149     case llvm::omp::Directive::OMPD_target_enter_data:
2150       Word("TARGET ENTER DATA ");
2151       break;
2152     case llvm::omp::Directive::OMPD_target_exit_data:
2153       Word("TARGET EXIT DATA ");
2154       break;
2155     case llvm::omp::Directive::OMPD_target_update:
2156       Word("TARGET UPDATE ");
2157       break;
2158     case llvm::omp::Directive::OMPD_ordered:
2159       Word("ORDERED ");
2160       break;
2161     default:
2162       // Nothing to be done
2163       break;
2164     }
2165   }
2166   void Unparse(const OmpBlockDirective &x) {
2167     switch (x.v) {
2168     case llvm::omp::Directive::OMPD_master:
2169       Word("MASTER");
2170       break;
2171     case llvm::omp::Directive::OMPD_ordered:
2172       Word("ORDERED ");
2173       break;
2174     case llvm::omp::Directive::OMPD_parallel_workshare:
2175       Word("PARALLEL WORKSHARE ");
2176       break;
2177     case llvm::omp::Directive::OMPD_parallel:
2178       Word("PARALLEL ");
2179       break;
2180     case llvm::omp::Directive::OMPD_single:
2181       Word("SINGLE ");
2182       break;
2183     case llvm::omp::Directive::OMPD_target_data:
2184       Word("TARGET DATA ");
2185       break;
2186     case llvm::omp::Directive::OMPD_target_parallel:
2187       Word("TARGET PARALLEL ");
2188       break;
2189     case llvm::omp::Directive::OMPD_target_teams:
2190       Word("TARGET TEAMS ");
2191       break;
2192     case llvm::omp::Directive::OMPD_target:
2193       Word("TARGET ");
2194       break;
2195     case llvm::omp::Directive::OMPD_taskgroup:
2196       Word("TASKGROUP ");
2197       break;
2198     case llvm::omp::Directive::OMPD_task:
2199       Word("TASK ");
2200       break;
2201     case llvm::omp::Directive::OMPD_teams:
2202       Word("TEAMS ");
2203       break;
2204     case llvm::omp::Directive::OMPD_workshare:
2205       Word("WORKSHARE ");
2206       break;
2207     default:
2208       // Nothing to be done
2209       break;
2210     }
2211   }
2212   void Unparse(const OmpAtomicClauseList &x) { Walk(" ", x.v, " "); }
2213 
2214   void Unparse(const OmpAtomic &x) {
2215     BeginOpenMP();
2216     Word("!$OMP ATOMIC");
2217     Walk(std::get<OmpAtomicClauseList>(x.t));
2218     Put("\n");
2219     EndOpenMP();
2220     Walk(std::get<Statement<AssignmentStmt>>(x.t));
2221     BeginOpenMP();
2222     Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n");
2223     EndOpenMP();
2224   }
2225   void Unparse(const OmpAtomicCapture &x) {
2226     BeginOpenMP();
2227     Word("!$OMP ATOMIC");
2228     Walk(std::get<0>(x.t));
2229     Word(" CAPTURE");
2230     Walk(std::get<2>(x.t));
2231     Put("\n");
2232     EndOpenMP();
2233     Walk(std::get<OmpAtomicCapture::Stmt1>(x.t));
2234     Put("\n");
2235     Walk(std::get<OmpAtomicCapture::Stmt2>(x.t));
2236     BeginOpenMP();
2237     Word("!$OMP END ATOMIC\n");
2238     EndOpenMP();
2239   }
2240   void Unparse(const OmpAtomicRead &x) {
2241     BeginOpenMP();
2242     Word("!$OMP ATOMIC");
2243     Walk(std::get<0>(x.t));
2244     Word(" READ");
2245     Walk(std::get<2>(x.t));
2246     Put("\n");
2247     EndOpenMP();
2248     Walk(std::get<Statement<AssignmentStmt>>(x.t));
2249     BeginOpenMP();
2250     Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n");
2251     EndOpenMP();
2252   }
2253   void Unparse(const OmpAtomicUpdate &x) {
2254     BeginOpenMP();
2255     Word("!$OMP ATOMIC");
2256     Walk(std::get<0>(x.t));
2257     Word(" UPDATE");
2258     Walk(std::get<2>(x.t));
2259     Put("\n");
2260     EndOpenMP();
2261     Walk(std::get<Statement<AssignmentStmt>>(x.t));
2262     BeginOpenMP();
2263     Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n");
2264     EndOpenMP();
2265   }
2266   void Unparse(const OmpAtomicWrite &x) {
2267     BeginOpenMP();
2268     Word("!$OMP ATOMIC");
2269     Walk(std::get<0>(x.t));
2270     Word(" WRITE");
2271     Walk(std::get<2>(x.t));
2272     Put("\n");
2273     EndOpenMP();
2274     Walk(std::get<Statement<AssignmentStmt>>(x.t));
2275     BeginOpenMP();
2276     Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n");
2277     EndOpenMP();
2278   }
2279   void Unparse(const OpenMPExecutableAllocate &x) {
2280     BeginOpenMP();
2281     Word("!$OMP ALLOCATE");
2282     Walk(" (", std::get<std::optional<OmpObjectList>>(x.t), ")");
2283     Walk(std::get<OmpClauseList>(x.t));
2284     Put("\n");
2285     EndOpenMP();
2286     Walk(std::get<Statement<AllocateStmt>>(x.t));
2287   }
2288   void Unparse(const OpenMPDeclarativeAllocate &x) {
2289     BeginOpenMP();
2290     Word("!$OMP ALLOCATE");
2291     Put(" (");
2292     Walk(std::get<OmpObjectList>(x.t));
2293     Put(")");
2294     Walk(std::get<OmpClauseList>(x.t));
2295     Put("\n");
2296     EndOpenMP();
2297   }
2298   void Unparse(const OmpCriticalDirective &x) {
2299     BeginOpenMP();
2300     Word("!$OMP CRITICAL");
2301     Walk(" (", std::get<std::optional<Name>>(x.t), ")");
2302     Walk(std::get<OmpClauseList>(x.t));
2303     Put("\n");
2304     EndOpenMP();
2305   }
2306   void Unparse(const OmpEndCriticalDirective &x) {
2307     BeginOpenMP();
2308     Word("!$OMP END CRITICAL");
2309     Walk(" (", std::get<std::optional<Name>>(x.t), ")");
2310     Put("\n");
2311     EndOpenMP();
2312   }
2313   void Unparse(const OpenMPCriticalConstruct &x) {
2314     Walk(std::get<OmpCriticalDirective>(x.t));
2315     Walk(std::get<Block>(x.t), "");
2316     Walk(std::get<OmpEndCriticalDirective>(x.t));
2317   }
2318   void Unparse(const OmpDeclareTargetWithList &x) {
2319     Put("("), Walk(x.v), Put(")");
2320   }
2321   void Unparse(const OmpReductionInitializerClause &x) {
2322     Word(" INITIALIZER(OMP_PRIV = ");
2323     Walk(x.v);
2324     Put(")");
2325   }
2326   void Unparse(const OmpReductionCombiner::FunctionCombiner &x) {
2327     const auto &pd = std::get<ProcedureDesignator>(x.v.t);
2328     const auto &args = std::get<std::list<ActualArgSpec>>(x.v.t);
2329     Walk(pd);
2330     if (args.empty()) {
2331       if (std::holds_alternative<ProcComponentRef>(pd.u)) {
2332         Put("()");
2333       }
2334     } else {
2335       Walk("(", args, ", ", ")");
2336     }
2337   }
2338   void Unparse(const OpenMPDeclareReductionConstruct &x) {
2339     Put("(");
2340     Walk(std::get<OmpReductionOperator>(x.t)), Put(" : ");
2341     Walk(std::get<std::list<DeclarationTypeSpec>>(x.t), ","), Put(" : ");
2342     Walk(std::get<OmpReductionCombiner>(x.t));
2343     Put(")");
2344     Walk(std::get<std::optional<OmpReductionInitializerClause>>(x.t));
2345   }
2346   bool Pre(const OpenMPDeclarativeConstruct &x) {
2347     BeginOpenMP();
2348     Word("!$OMP ");
2349     return std::visit(common::visitors{
2350                           [&](const OpenMPDeclarativeAllocate &z) {
2351                             Word("ALLOCATE (");
2352                             Walk(std::get<OmpObjectList>(z.t));
2353                             Put(")");
2354                             Walk(std::get<OmpClauseList>(z.t));
2355                             Put("\n");
2356                             EndOpenMP();
2357                             return false;
2358                           },
2359                           [&](const OpenMPDeclareReductionConstruct &) {
2360                             Word("DECLARE REDUCTION ");
2361                             return true;
2362                           },
2363                           [&](const OpenMPDeclareSimdConstruct &y) {
2364                             Word("DECLARE SIMD ");
2365                             Walk("(", std::get<std::optional<Name>>(y.t), ")");
2366                             Walk(std::get<OmpClauseList>(y.t));
2367                             Put("\n");
2368                             EndOpenMP();
2369                             return false;
2370                           },
2371                           [&](const OpenMPDeclareTargetConstruct &) {
2372                             Word("DECLARE TARGET ");
2373                             return true;
2374                           },
2375                           [&](const OpenMPThreadprivate &) {
2376                             Word("THREADPRIVATE (");
2377                             return true;
2378                           },
2379                       },
2380         x.u);
2381   }
2382   void Post(const OpenMPDeclarativeConstruct &) {
2383     Put("\n");
2384     EndOpenMP();
2385   }
2386   void Post(const OpenMPThreadprivate &) {
2387     Put(")\n");
2388     EndOpenMP();
2389   }
2390   void Unparse(const OmpSectionsDirective &x) {
2391     switch (x.v) {
2392     case llvm::omp::Directive::OMPD_sections:
2393       Word("SECTIONS ");
2394       break;
2395     case llvm::omp::Directive::OMPD_parallel_sections:
2396       Word("PARALLEL SECTIONS ");
2397       break;
2398     default:
2399       break;
2400     }
2401   }
2402   void Unparse(const OmpSectionBlocks &x) {
2403     for (const auto &y : x.v) {
2404       BeginOpenMP();
2405       Word("!$OMP SECTION");
2406       Put("\n");
2407       EndOpenMP();
2408       // y.u is an OpenMPSectionConstruct
2409       // (y.u).v is Block
2410       Walk(std::get<OpenMPSectionConstruct>(y.u).v, "");
2411     }
2412   }
2413   void Unparse(const OpenMPSectionsConstruct &x) {
2414     BeginOpenMP();
2415     Word("!$OMP ");
2416     Walk(std::get<OmpBeginSectionsDirective>(x.t));
2417     Put("\n");
2418     EndOpenMP();
2419     Walk(std::get<OmpSectionBlocks>(x.t));
2420     BeginOpenMP();
2421     Word("!$OMP END ");
2422     Walk(std::get<OmpEndSectionsDirective>(x.t));
2423     Put("\n");
2424     EndOpenMP();
2425   }
2426   void Unparse(const OpenMPCancellationPointConstruct &x) {
2427     BeginOpenMP();
2428     Word("!$OMP CANCELLATION POINT ");
2429     Walk(std::get<OmpCancelType>(x.t));
2430     Put("\n");
2431     EndOpenMP();
2432   }
2433   void Unparse(const OpenMPCancelConstruct &x) {
2434     BeginOpenMP();
2435     Word("!$OMP CANCEL ");
2436     Walk(std::get<OmpCancelType>(x.t));
2437     Walk(std::get<std::optional<OpenMPCancelConstruct::If>>(x.t));
2438     Put("\n");
2439     EndOpenMP();
2440   }
2441   void Unparse(const OmpMemoryOrderClause &x) { Walk(x.v); }
2442   void Unparse(const OmpAtomicClause &x) {
2443     std::visit(common::visitors{
2444                    [&](const OmpMemoryOrderClause &y) { Walk(y); },
2445                    [&](const OmpClause &z) { Walk(z); },
2446                },
2447         x.u);
2448   }
2449   void Unparse(const OpenMPFlushConstruct &x) {
2450     BeginOpenMP();
2451     Word("!$OMP FLUSH ");
2452     Walk(std::get<std::optional<std::list<OmpMemoryOrderClause>>>(x.t));
2453     Walk(" (", std::get<std::optional<OmpObjectList>>(x.t), ")");
2454     Put("\n");
2455     EndOpenMP();
2456   }
2457   void Unparse(const OmpEndLoopDirective &x) {
2458     BeginOpenMP();
2459     Word("!$OMP END ");
2460     Walk(std::get<OmpLoopDirective>(x.t));
2461     Walk(std::get<OmpClauseList>(x.t));
2462     Put("\n");
2463     EndOpenMP();
2464   }
2465   void Unparse(const OmpClauseList &x) { Walk(" ", x.v, " "); }
2466   void Unparse(const OpenMPSimpleStandaloneConstruct &x) {
2467     BeginOpenMP();
2468     Word("!$OMP ");
2469     Walk(std::get<OmpSimpleStandaloneDirective>(x.t));
2470     Walk(std::get<OmpClauseList>(x.t));
2471     Put("\n");
2472     EndOpenMP();
2473   }
2474   void Unparse(const OpenMPBlockConstruct &x) {
2475     BeginOpenMP();
2476     Word("!$OMP ");
2477     Walk(std::get<OmpBeginBlockDirective>(x.t));
2478     Put("\n");
2479     EndOpenMP();
2480     Walk(std::get<Block>(x.t), "");
2481     BeginOpenMP();
2482     Word("!$OMP END ");
2483     Walk(std::get<OmpEndBlockDirective>(x.t));
2484     Put("\n");
2485     EndOpenMP();
2486   }
2487   void Unparse(const OpenMPLoopConstruct &x) {
2488     BeginOpenMP();
2489     Word("!$OMP ");
2490     Walk(std::get<OmpBeginLoopDirective>(x.t));
2491     Put("\n");
2492     EndOpenMP();
2493     Walk(std::get<std::optional<DoConstruct>>(x.t));
2494     Walk(std::get<std::optional<OmpEndLoopDirective>>(x.t));
2495   }
2496   void Unparse(const BasedPointer &x) {
2497     Put('('), Walk(std::get<0>(x.t)), Put(","), Walk(std::get<1>(x.t));
2498     Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"), Put(')');
2499   }
2500   void Unparse(const BasedPointerStmt &x) { Walk("POINTER ", x.v, ","); }
2501   void Post(const StructureField &x) {
2502     if (const auto *def{std::get_if<Statement<DataComponentDefStmt>>(&x.u)}) {
2503       for (const auto &item :
2504           std::get<std::list<ComponentOrFill>>(def->statement.t)) {
2505         if (const auto *comp{std::get_if<ComponentDecl>(&item.u)}) {
2506           structureComponents_.insert(std::get<Name>(comp->t).source);
2507         }
2508       }
2509     }
2510   }
2511   void Unparse(const StructureStmt &x) {
2512     Word("STRUCTURE ");
2513     // The name, if present, includes the /slashes/
2514     Walk(std::get<std::optional<Name>>(x.t));
2515     Walk(" ", std::get<std::list<EntityDecl>>(x.t), ", ");
2516     Indent();
2517   }
2518   void Post(const Union::UnionStmt &) { Word("UNION"), Indent(); }
2519   void Post(const Union::EndUnionStmt &) { Outdent(), Word("END UNION"); }
2520   void Post(const Map::MapStmt &) { Word("MAP"), Indent(); }
2521   void Post(const Map::EndMapStmt &) { Outdent(), Word("END MAP"); }
2522   void Post(const StructureDef::EndStructureStmt &) {
2523     Outdent(), Word("END STRUCTURE");
2524   }
2525   void Unparse(const OldParameterStmt &x) {
2526     Word("PARAMETER "), Walk(x.v, ", ");
2527   }
2528   void Unparse(const ArithmeticIfStmt &x) {
2529     Word("IF ("), Walk(std::get<Expr>(x.t)), Put(") ");
2530     Walk(std::get<1>(x.t)), Put(", ");
2531     Walk(std::get<2>(x.t)), Put(", ");
2532     Walk(std::get<3>(x.t));
2533   }
2534   void Unparse(const AssignStmt &x) {
2535     Word("ASSIGN "), Walk(std::get<Label>(x.t));
2536     Word(" TO "), Walk(std::get<Name>(x.t));
2537   }
2538   void Unparse(const AssignedGotoStmt &x) {
2539     Word("GO TO "), Walk(std::get<Name>(x.t));
2540     Walk(", (", std::get<std::list<Label>>(x.t), ", ", ")");
2541   }
2542   void Unparse(const PauseStmt &x) { Word("PAUSE"), Walk(" ", x.v); }
2543 
2544 #define WALK_NESTED_ENUM(CLASS, ENUM) \
2545   void Unparse(const CLASS::ENUM &x) { Word(CLASS::EnumToString(x)); }
2546   WALK_NESTED_ENUM(AccessSpec, Kind) // R807
2547   WALK_NESTED_ENUM(common, TypeParamAttr) // R734
2548   WALK_NESTED_ENUM(IntentSpec, Intent) // R826
2549   WALK_NESTED_ENUM(ImplicitStmt, ImplicitNoneNameSpec) // R866
2550   WALK_NESTED_ENUM(ConnectSpec::CharExpr, Kind) // R1205
2551   WALK_NESTED_ENUM(IoControlSpec::CharExpr, Kind)
2552   WALK_NESTED_ENUM(InquireSpec::CharVar, Kind)
2553   WALK_NESTED_ENUM(InquireSpec::IntVar, Kind)
2554   WALK_NESTED_ENUM(InquireSpec::LogVar, Kind)
2555   WALK_NESTED_ENUM(ProcedureStmt, Kind) // R1506
2556   WALK_NESTED_ENUM(UseStmt, ModuleNature) // R1410
2557   WALK_NESTED_ENUM(OmpProcBindClause, Type) // OMP PROC_BIND
2558   WALK_NESTED_ENUM(OmpDefaultClause, Type) // OMP DEFAULT
2559   WALK_NESTED_ENUM(OmpDefaultmapClause, ImplicitBehavior) // OMP DEFAULTMAP
2560   WALK_NESTED_ENUM(OmpDefaultmapClause, VariableCategory) // OMP DEFAULTMAP
2561   WALK_NESTED_ENUM(OmpScheduleModifierType, ModType) // OMP schedule-modifier
2562   WALK_NESTED_ENUM(OmpLinearModifier, Type) // OMP linear-modifier
2563   WALK_NESTED_ENUM(OmpDependenceType, Type) // OMP dependence-type
2564   WALK_NESTED_ENUM(OmpMapType, Type) // OMP map-type
2565   WALK_NESTED_ENUM(OmpScheduleClause, ScheduleType) // OMP schedule-type
2566   WALK_NESTED_ENUM(OmpIfClause, DirectiveNameModifier) // OMP directive-modifier
2567   WALK_NESTED_ENUM(OmpCancelType, Type) // OMP cancel-type
2568 #undef WALK_NESTED_ENUM
2569 
2570   void Done() const { CHECK(indent_ == 0); }
2571 
2572 private:
2573   void Put(char);
2574   void Put(const char *);
2575   void Put(const std::string &);
2576   void PutNormalized(const std::string &);
2577   void PutKeywordLetter(char);
2578   void Word(const char *);
2579   void Word(const std::string &);
2580   void Indent() { indent_ += indentationAmount_; }
2581   void Outdent() {
2582     CHECK(indent_ >= indentationAmount_);
2583     indent_ -= indentationAmount_;
2584   }
2585   void BeginOpenMP() { openmpDirective_ = true; }
2586   void EndOpenMP() { openmpDirective_ = false; }
2587   void BeginOpenACC() { openaccDirective_ = true; }
2588   void EndOpenACC() { openaccDirective_ = false; }
2589 
2590   // Call back to the traversal framework.
2591   template <typename T> void Walk(const T &x) {
2592     Fortran::parser::Walk(x, *this);
2593   }
2594 
2595   // Traverse a std::optional<> value.  Emit a prefix and/or a suffix string
2596   // only when it contains a value.
2597   template <typename A>
2598   void Walk(
2599       const char *prefix, const std::optional<A> &x, const char *suffix = "") {
2600     if (x) {
2601       Word(prefix), Walk(*x), Word(suffix);
2602     }
2603   }
2604   template <typename A>
2605   void Walk(const std::optional<A> &x, const char *suffix = "") {
2606     return Walk("", x, suffix);
2607   }
2608 
2609   // Traverse a std::list<>.  Separate the elements with an optional string.
2610   // Emit a prefix and/or a suffix string only when the list is not empty.
2611   template <typename A>
2612   void Walk(const char *prefix, const std::list<A> &list,
2613       const char *comma = ", ", const char *suffix = "") {
2614     if (!list.empty()) {
2615       const char *str{prefix};
2616       for (const auto &x : list) {
2617         Word(str), Walk(x);
2618         str = comma;
2619       }
2620       Word(suffix);
2621     }
2622   }
2623   template <typename A>
2624   void Walk(const std::list<A> &list, const char *comma = ", ",
2625       const char *suffix = "") {
2626     return Walk("", list, comma, suffix);
2627   }
2628 
2629   // Traverse a std::tuple<>, with an optional separator.
2630   template <std::size_t J = 0, typename T>
2631   void WalkTupleElements(const T &tuple, const char *separator) {
2632     if (J > 0 && J < std::tuple_size_v<T>) {
2633       Word(separator); // this usage dodges "unused parameter" warning
2634     }
2635     if constexpr (J < std::tuple_size_v<T>) {
2636       Walk(std::get<J>(tuple));
2637       WalkTupleElements<J + 1>(tuple, separator);
2638     }
2639   }
2640   template <typename... A>
2641   void Walk(const std::tuple<A...> &tuple, const char *separator = "") {
2642     WalkTupleElements(tuple, separator);
2643   }
2644 
2645   void EndSubprogram(const char *kind, const std::optional<Name> &name) {
2646     Outdent(), Word("END "), Word(kind), Walk(" ", name);
2647     structureComponents_.clear();
2648   }
2649 
2650   llvm::raw_ostream &out_;
2651   int indent_{0};
2652   const int indentationAmount_{1};
2653   int column_{1};
2654   const int maxColumns_{80};
2655   std::set<CharBlock> structureComponents_;
2656   Encoding encoding_{Encoding::UTF_8};
2657   bool capitalizeKeywords_{true};
2658   bool openaccDirective_{false};
2659   bool openmpDirective_{false};
2660   bool backslashEscapes_{false};
2661   preStatementType *preStatement_{nullptr};
2662   AnalyzedObjectsAsFortran *asFortran_{nullptr};
2663 };
2664 
2665 void UnparseVisitor::Put(char ch) {
2666   int sav = indent_;
2667   if (openmpDirective_ || openaccDirective_) {
2668     indent_ = 0;
2669   }
2670   if (column_ <= 1) {
2671     if (ch == '\n') {
2672       return;
2673     }
2674     for (int j{0}; j < indent_; ++j) {
2675       out_ << ' ';
2676     }
2677     column_ = indent_ + 2;
2678   } else if (ch == '\n') {
2679     column_ = 1;
2680   } else if (++column_ >= maxColumns_) {
2681     out_ << "&\n";
2682     for (int j{0}; j < indent_; ++j) {
2683       out_ << ' ';
2684     }
2685     if (openmpDirective_) {
2686       out_ << "!$OMP&";
2687       column_ = 8;
2688     } else if (openaccDirective_) {
2689       out_ << "!$ACC&";
2690       column_ = 8;
2691     } else {
2692       out_ << '&';
2693       column_ = indent_ + 3;
2694     }
2695   }
2696   out_ << ch;
2697   if (openmpDirective_ || openaccDirective_) {
2698     indent_ = sav;
2699   }
2700 }
2701 
2702 void UnparseVisitor::Put(const char *str) {
2703   for (; *str != '\0'; ++str) {
2704     Put(*str);
2705   }
2706 }
2707 
2708 void UnparseVisitor::Put(const std::string &str) {
2709   for (char ch : str) {
2710     Put(ch);
2711   }
2712 }
2713 
2714 void UnparseVisitor::PutNormalized(const std::string &str) {
2715   auto decoded{DecodeString<std::string, Encoding::LATIN_1>(str, true)};
2716   std::string encoded{EncodeString<Encoding::LATIN_1>(decoded)};
2717   Put(QuoteCharacterLiteral(encoded, backslashEscapes_));
2718 }
2719 
2720 void UnparseVisitor::PutKeywordLetter(char ch) {
2721   if (capitalizeKeywords_) {
2722     Put(ToUpperCaseLetter(ch));
2723   } else {
2724     Put(ToLowerCaseLetter(ch));
2725   }
2726 }
2727 
2728 void UnparseVisitor::Word(const char *str) {
2729   for (; *str != '\0'; ++str) {
2730     PutKeywordLetter(*str);
2731   }
2732 }
2733 
2734 void UnparseVisitor::Word(const std::string &str) { Word(str.c_str()); }
2735 
2736 void Unparse(llvm::raw_ostream &out, const Program &program, Encoding encoding,
2737     bool capitalizeKeywords, bool backslashEscapes,
2738     preStatementType *preStatement, AnalyzedObjectsAsFortran *asFortran) {
2739   UnparseVisitor visitor{out, 1, encoding, capitalizeKeywords, backslashEscapes,
2740       preStatement, asFortran};
2741   Walk(program, visitor);
2742   visitor.Done();
2743 }
2744 } // namespace Fortran::parser
2745