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