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