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 #define GEN_FLANG_CLAUSE_UNPARSE 1834 #include "llvm/Frontend/OpenACC/ACC.inc" 1835 void Unparse(const AccObjectListWithModifier &x) { 1836 Walk(std::get<std::optional<AccDataModifier>>(x.t), ":"); 1837 Walk(std::get<AccObjectList>(x.t)); 1838 } 1839 void Unparse(const AccDataModifier::Modifier &x) { 1840 Word(AccDataModifier::EnumToString(x)); 1841 } 1842 void Unparse(const AccBindClause &x) { 1843 std::visit(common::visitors{ 1844 [&](const Name &y) { Put('('), Walk(y), Put(')'); }, 1845 [&](const ScalarDefaultCharExpr &y) { 1846 Put('('), Walk(y), Put(')'); 1847 }, 1848 }, 1849 x.u); 1850 } 1851 void Unparse(const AccDefaultClause &x) { 1852 switch (x.v) { 1853 case llvm::acc::DefaultValue::ACC_Default_none: 1854 Put("NONE"); 1855 break; 1856 case llvm::acc::DefaultValue::ACC_Default_present: 1857 Put("PRESENT"); 1858 break; 1859 } 1860 } 1861 void Unparse(const AccClauseList &x) { Walk(" ", x.v, " "); } 1862 void Unparse(const AccGangArgument &x) { 1863 Walk("NUM:", std::get<std::optional<ScalarIntExpr>>(x.t)); 1864 Walk(", STATIC:", std::get<std::optional<AccSizeExpr>>(x.t)); 1865 } 1866 void Unparse(const OpenACCBlockConstruct &x) { 1867 BeginOpenACC(); 1868 Word("!$ACC "); 1869 Walk(std::get<AccBeginBlockDirective>(x.t)); 1870 Put("\n"); 1871 EndOpenACC(); 1872 Walk(std::get<Block>(x.t), ""); 1873 BeginOpenACC(); 1874 Word("!$ACC END "); 1875 Walk(std::get<AccEndBlockDirective>(x.t)); 1876 Put("\n"); 1877 EndOpenACC(); 1878 } 1879 void Unparse(const OpenACCLoopConstruct &x) { 1880 BeginOpenACC(); 1881 Word("!$ACC "); 1882 Walk(std::get<AccBeginLoopDirective>(x.t)); 1883 Put("\n"); 1884 EndOpenACC(); 1885 Walk(std::get<std::optional<DoConstruct>>(x.t)); 1886 } 1887 void Unparse(const AccBeginLoopDirective &x) { 1888 Walk(std::get<AccLoopDirective>(x.t)); 1889 Walk(std::get<AccClauseList>(x.t)); 1890 } 1891 void Unparse(const OpenACCStandaloneConstruct &x) { 1892 BeginOpenACC(); 1893 Word("!$ACC "); 1894 Walk(std::get<AccStandaloneDirective>(x.t)); 1895 Walk(std::get<AccClauseList>(x.t)); 1896 Put("\n"); 1897 EndOpenACC(); 1898 } 1899 void Unparse(const OpenACCStandaloneDeclarativeConstruct &x) { 1900 BeginOpenACC(); 1901 Word("!$ACC "); 1902 Walk(std::get<AccDeclarativeDirective>(x.t)); 1903 Walk(std::get<AccClauseList>(x.t)); 1904 Put("\n"); 1905 EndOpenACC(); 1906 } 1907 void Unparse(const OpenACCCombinedConstruct &x) { 1908 BeginOpenACC(); 1909 Word("!$ACC "); 1910 Walk(std::get<AccBeginCombinedDirective>(x.t)); 1911 Put("\n"); 1912 EndOpenACC(); 1913 Walk(std::get<std::optional<DoConstruct>>(x.t)); 1914 BeginOpenACC(); 1915 Walk("!$ACC END ", std::get<std::optional<AccEndCombinedDirective>>(x.t), 1916 "\n"); 1917 EndOpenACC(); 1918 } 1919 void Unparse(const OpenACCRoutineConstruct &x) { 1920 BeginOpenACC(); 1921 Word("!$ACC ROUTINE"); 1922 Walk("(", std::get<std::optional<Name>>(x.t), ")"); 1923 Walk(std::get<AccClauseList>(x.t)); 1924 Put("\n"); 1925 EndOpenACC(); 1926 } 1927 void Unparse(const AccObject &x) { 1928 std::visit(common::visitors{ 1929 [&](const Designator &y) { Walk(y); }, 1930 [&](const Name &y) { Put("/"), Walk(y), Put("/"); }, 1931 }, 1932 x.u); 1933 } 1934 void Unparse(const AccObjectList &x) { Walk(x.v, ","); } 1935 void Unparse(const AccReductionOperator::Operator &x) { 1936 Word(AccReductionOperator::EnumToString(x)); 1937 } 1938 void Unparse(const AccObjectListWithReduction &x) { 1939 Walk(std::get<AccReductionOperator>(x.t)); 1940 Put(":"); 1941 Walk(std::get<AccObjectList>(x.t)); 1942 } 1943 void Unparse(const OpenACCCacheConstruct &x) { 1944 BeginOpenACC(); 1945 Word("!$ACC "); 1946 Word("CACHE("); 1947 Walk(std::get<AccObjectListWithModifier>(x.t)); 1948 Put(")"); 1949 Put("\n"); 1950 EndOpenACC(); 1951 } 1952 void Unparse(const AccWaitArgument &x) { 1953 Walk("DEVNUM:", std::get<std::optional<ScalarIntExpr>>(x.t), ":"); 1954 Walk(std::get<std::list<ScalarIntExpr>>(x.t), ","); 1955 } 1956 void Unparse(const OpenACCWaitConstruct &x) { 1957 BeginOpenACC(); 1958 Word("!$ACC "); 1959 Word("WAIT("); 1960 Walk(std::get<std::optional<AccWaitArgument>>(x.t)); 1961 Walk(std::get<AccClauseList>(x.t)); 1962 Put(")"); 1963 Put("\n"); 1964 EndOpenACC(); 1965 } 1966 1967 // OpenMP Clauses & Directives 1968 void Unparse(const OmpObject &x) { 1969 std::visit(common::visitors{ 1970 [&](const Designator &y) { Walk(y); }, 1971 [&](const Name &y) { Put("/"), Walk(y), Put("/"); }, 1972 }, 1973 x.u); 1974 } 1975 void Unparse(const OmpMapType::Always &) { Word("ALWAYS,"); } 1976 void Unparse(const OmpMapClause &x) { 1977 Walk(std::get<std::optional<OmpMapType>>(x.t), ":"); 1978 Walk(std::get<OmpObjectList>(x.t)); 1979 } 1980 void Unparse(const OmpScheduleModifier &x) { 1981 Walk(std::get<OmpScheduleModifier::Modifier1>(x.t)); 1982 Walk(",", std::get<std::optional<OmpScheduleModifier::Modifier2>>(x.t)); 1983 } 1984 void Unparse(const OmpScheduleClause &x) { 1985 Walk(std::get<std::optional<OmpScheduleModifier>>(x.t), ":"); 1986 Walk(std::get<OmpScheduleClause::ScheduleType>(x.t)); 1987 Walk(",", std::get<std::optional<ScalarIntExpr>>(x.t)); 1988 } 1989 void Unparse(const OmpAlignedClause &x) { 1990 Walk(std::get<std::list<Name>>(x.t), ","); 1991 Walk(std::get<std::optional<ScalarIntConstantExpr>>(x.t)); 1992 } 1993 void Unparse(const OmpIfClause &x) { 1994 Walk(std::get<std::optional<OmpIfClause::DirectiveNameModifier>>(x.t), ":"); 1995 Walk(std::get<ScalarLogicalExpr>(x.t)); 1996 } 1997 void Unparse(const OmpLinearClause::WithoutModifier &x) { 1998 Walk(x.names, ", "); 1999 Walk(":", x.step); 2000 } 2001 void Unparse(const OmpLinearClause::WithModifier &x) { 2002 Walk(x.modifier), Put("("), Walk(x.names, ","), Put(")"); 2003 Walk(":", x.step); 2004 } 2005 void Unparse(const OmpReductionClause &x) { 2006 Walk(std::get<OmpReductionOperator>(x.t)); 2007 Put(":"); 2008 Walk(std::get<OmpObjectList>(x.t)); 2009 } 2010 void Unparse(const OmpAllocateClause &x) { 2011 Walk(std::get<std::optional<OmpAllocateClause::Allocator>>(x.t)); 2012 Put(":"); 2013 Walk(std::get<OmpObjectList>(x.t)); 2014 } 2015 void Unparse(const OmpDependSinkVecLength &x) { 2016 Walk(std::get<DefinedOperator>(x.t)); 2017 Walk(std::get<ScalarIntConstantExpr>(x.t)); 2018 } 2019 void Unparse(const OmpDependSinkVec &x) { 2020 Walk(std::get<Name>(x.t)); 2021 Walk(std::get<std::optional<OmpDependSinkVecLength>>(x.t)); 2022 } 2023 void Unparse(const OmpDependClause::InOut &x) { 2024 Put("("); 2025 Walk(std::get<OmpDependenceType>(x.t)); 2026 Put(":"); 2027 Walk(std::get<std::list<Designator>>(x.t), ","); 2028 Put(")"); 2029 } 2030 bool Pre(const OmpDependClause &x) { 2031 return std::visit(common::visitors{ 2032 [&](const OmpDependClause::Source &) { 2033 Word("SOURCE"); 2034 return false; 2035 }, 2036 [&](const OmpDependClause::Sink &y) { 2037 Word("SINK:"); 2038 Walk(y.v); 2039 Put(")"); 2040 return false; 2041 }, 2042 [&](const OmpDependClause::InOut &) { return true; }, 2043 }, 2044 x.u); 2045 } 2046 void Unparse(const OmpDefaultmapClause &x) { 2047 Walk(std::get<OmpDefaultmapClause::ImplicitBehavior>(x.t)); 2048 Walk(":", 2049 std::get<std::optional<OmpDefaultmapClause::VariableCategory>>(x.t)); 2050 } 2051 #define GEN_FLANG_CLAUSE_UNPARSE 2052 #include "llvm/Frontend/OpenMP/OMP.inc" 2053 void Unparse(const OmpLoopDirective &x) { 2054 switch (x.v) { 2055 case llvm::omp::Directive::OMPD_distribute: 2056 Word("DISTRIBUTE "); 2057 break; 2058 case llvm::omp::Directive::OMPD_distribute_parallel_do: 2059 Word("DISTRIBUTE PARALLEL DO "); 2060 break; 2061 case llvm::omp::Directive::OMPD_distribute_parallel_do_simd: 2062 Word("DISTRIBUTE PARALLEL DO SIMD "); 2063 break; 2064 case llvm::omp::Directive::OMPD_distribute_simd: 2065 Word("DISTRIBUTE SIMD "); 2066 break; 2067 case llvm::omp::Directive::OMPD_do: 2068 Word("DO "); 2069 break; 2070 case llvm::omp::Directive::OMPD_do_simd: 2071 Word("DO SIMD "); 2072 break; 2073 case llvm::omp::Directive::OMPD_parallel_do: 2074 Word("PARALLEL DO "); 2075 break; 2076 case llvm::omp::Directive::OMPD_parallel_do_simd: 2077 Word("PARALLEL DO SIMD "); 2078 break; 2079 case llvm::omp::Directive::OMPD_simd: 2080 Word("SIMD "); 2081 break; 2082 case llvm::omp::Directive::OMPD_target_parallel_do: 2083 Word("TARGET PARALLEL DO "); 2084 break; 2085 case llvm::omp::Directive::OMPD_target_parallel_do_simd: 2086 Word("TARGET PARALLEL DO SIMD "); 2087 break; 2088 case llvm::omp::Directive::OMPD_target_teams_distribute: 2089 Word("TARGET TEAMS DISTRIBUTE "); 2090 break; 2091 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do: 2092 Word("TARGET TEAMS DISTRIBUTE PARALLEL DO "); 2093 break; 2094 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd: 2095 Word("TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD "); 2096 break; 2097 case llvm::omp::Directive::OMPD_target_teams_distribute_simd: 2098 Word("TARGET TEAMS DISTRIBUTE SIMD "); 2099 break; 2100 case llvm::omp::Directive::OMPD_target_simd: 2101 Word("TARGET SIMD "); 2102 break; 2103 case llvm::omp::Directive::OMPD_taskloop: 2104 Word("TASKLOOP "); 2105 break; 2106 case llvm::omp::Directive::OMPD_taskloop_simd: 2107 Word("TASKLOOP SIMD "); 2108 break; 2109 case llvm::omp::Directive::OMPD_teams_distribute: 2110 Word("TEAMS DISTRIBUTE "); 2111 break; 2112 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do: 2113 Word("TEAMS DISTRIBUTE PARALLEL DO "); 2114 break; 2115 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd: 2116 Word("TEAMS DISTRIBUTE PARALLEL DO SIMD "); 2117 break; 2118 case llvm::omp::Directive::OMPD_teams_distribute_simd: 2119 Word("TEAMS DISTRIBUTE SIMD "); 2120 break; 2121 default: 2122 break; 2123 } 2124 } 2125 void Unparse(const OmpObjectList &x) { Walk(x.v, ","); } 2126 void Unparse(const OmpSimpleStandaloneDirective &x) { 2127 switch (x.v) { 2128 case llvm::omp::Directive::OMPD_barrier: 2129 Word("BARRIER "); 2130 break; 2131 case llvm::omp::Directive::OMPD_taskwait: 2132 Word("TASKWAIT "); 2133 break; 2134 case llvm::omp::Directive::OMPD_taskyield: 2135 Word("TASKYIELD "); 2136 break; 2137 case llvm::omp::Directive::OMPD_target_enter_data: 2138 Word("TARGET ENTER DATA "); 2139 break; 2140 case llvm::omp::Directive::OMPD_target_exit_data: 2141 Word("TARGET EXIT DATA "); 2142 break; 2143 case llvm::omp::Directive::OMPD_target_update: 2144 Word("TARGET UPDATE "); 2145 break; 2146 case llvm::omp::Directive::OMPD_ordered: 2147 Word("ORDERED "); 2148 break; 2149 default: 2150 // Nothing to be done 2151 break; 2152 } 2153 } 2154 void Unparse(const OmpBlockDirective &x) { 2155 switch (x.v) { 2156 case llvm::omp::Directive::OMPD_master: 2157 Word("MASTER"); 2158 break; 2159 case llvm::omp::Directive::OMPD_ordered: 2160 Word("ORDERED "); 2161 break; 2162 case llvm::omp::Directive::OMPD_parallel_workshare: 2163 Word("PARALLEL WORKSHARE "); 2164 break; 2165 case llvm::omp::Directive::OMPD_parallel: 2166 Word("PARALLEL "); 2167 break; 2168 case llvm::omp::Directive::OMPD_single: 2169 Word("SINGLE "); 2170 break; 2171 case llvm::omp::Directive::OMPD_target_data: 2172 Word("TARGET DATA "); 2173 break; 2174 case llvm::omp::Directive::OMPD_target_parallel: 2175 Word("TARGET PARALLEL "); 2176 break; 2177 case llvm::omp::Directive::OMPD_target_teams: 2178 Word("TARGET TEAMS "); 2179 break; 2180 case llvm::omp::Directive::OMPD_target: 2181 Word("TARGET "); 2182 break; 2183 case llvm::omp::Directive::OMPD_taskgroup: 2184 Word("TASKGROUP "); 2185 break; 2186 case llvm::omp::Directive::OMPD_task: 2187 Word("TASK "); 2188 break; 2189 case llvm::omp::Directive::OMPD_teams: 2190 Word("TEAMS "); 2191 break; 2192 case llvm::omp::Directive::OMPD_workshare: 2193 Word("WORKSHARE "); 2194 break; 2195 default: 2196 // Nothing to be done 2197 break; 2198 } 2199 } 2200 void Unparse(const OmpAtomicClauseList &x) { Walk(" ", x.v, " "); } 2201 2202 void Unparse(const OmpAtomic &x) { 2203 BeginOpenMP(); 2204 Word("!$OMP ATOMIC"); 2205 Walk(std::get<OmpAtomicClauseList>(x.t)); 2206 Put("\n"); 2207 EndOpenMP(); 2208 Walk(std::get<Statement<AssignmentStmt>>(x.t)); 2209 BeginOpenMP(); 2210 Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n"); 2211 EndOpenMP(); 2212 } 2213 void Unparse(const OmpAtomicCapture &x) { 2214 BeginOpenMP(); 2215 Word("!$OMP ATOMIC"); 2216 Walk(std::get<0>(x.t)); 2217 Word(" CAPTURE"); 2218 Walk(std::get<2>(x.t)); 2219 Put("\n"); 2220 EndOpenMP(); 2221 Walk(std::get<OmpAtomicCapture::Stmt1>(x.t)); 2222 Put("\n"); 2223 Walk(std::get<OmpAtomicCapture::Stmt2>(x.t)); 2224 BeginOpenMP(); 2225 Word("!$OMP END ATOMIC\n"); 2226 EndOpenMP(); 2227 } 2228 void Unparse(const OmpAtomicRead &x) { 2229 BeginOpenMP(); 2230 Word("!$OMP ATOMIC"); 2231 Walk(std::get<0>(x.t)); 2232 Word(" READ"); 2233 Walk(std::get<2>(x.t)); 2234 Put("\n"); 2235 EndOpenMP(); 2236 Walk(std::get<Statement<AssignmentStmt>>(x.t)); 2237 BeginOpenMP(); 2238 Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n"); 2239 EndOpenMP(); 2240 } 2241 void Unparse(const OmpAtomicUpdate &x) { 2242 BeginOpenMP(); 2243 Word("!$OMP ATOMIC"); 2244 Walk(std::get<0>(x.t)); 2245 Word(" UPDATE"); 2246 Walk(std::get<2>(x.t)); 2247 Put("\n"); 2248 EndOpenMP(); 2249 Walk(std::get<Statement<AssignmentStmt>>(x.t)); 2250 BeginOpenMP(); 2251 Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n"); 2252 EndOpenMP(); 2253 } 2254 void Unparse(const OmpAtomicWrite &x) { 2255 BeginOpenMP(); 2256 Word("!$OMP ATOMIC"); 2257 Walk(std::get<0>(x.t)); 2258 Word(" WRITE"); 2259 Walk(std::get<2>(x.t)); 2260 Put("\n"); 2261 EndOpenMP(); 2262 Walk(std::get<Statement<AssignmentStmt>>(x.t)); 2263 BeginOpenMP(); 2264 Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n"); 2265 EndOpenMP(); 2266 } 2267 void Unparse(const OpenMPExecutableAllocate &x) { 2268 BeginOpenMP(); 2269 Word("!$OMP ALLOCATE"); 2270 Walk(" (", std::get<std::optional<OmpObjectList>>(x.t), ")"); 2271 Walk(std::get<OmpClauseList>(x.t)); 2272 Put("\n"); 2273 EndOpenMP(); 2274 Walk(std::get<Statement<AllocateStmt>>(x.t)); 2275 } 2276 void Unparse(const OpenMPDeclarativeAllocate &x) { 2277 BeginOpenMP(); 2278 Word("!$OMP ALLOCATE"); 2279 Put(" ("); 2280 Walk(std::get<OmpObjectList>(x.t)); 2281 Put(")"); 2282 Walk(std::get<OmpClauseList>(x.t)); 2283 Put("\n"); 2284 EndOpenMP(); 2285 } 2286 void Unparse(const OmpCriticalDirective &x) { 2287 BeginOpenMP(); 2288 Word("!$OMP CRITICAL"); 2289 Walk(" (", std::get<std::optional<Name>>(x.t), ")"); 2290 Walk(std::get<std::optional<OmpClause>>(x.t)); 2291 Put("\n"); 2292 EndOpenMP(); 2293 } 2294 void Unparse(const OmpEndCriticalDirective &x) { 2295 BeginOpenMP(); 2296 Word("!$OMP END CRITICAL"); 2297 Walk(" (", std::get<std::optional<Name>>(x.t), ")"); 2298 Put("\n"); 2299 EndOpenMP(); 2300 } 2301 void Unparse(const OpenMPCriticalConstruct &x) { 2302 Walk(std::get<OmpCriticalDirective>(x.t)); 2303 Walk(std::get<Block>(x.t), ""); 2304 Walk(std::get<OmpEndCriticalDirective>(x.t)); 2305 } 2306 void Unparse(const OmpDeclareTargetWithList &x) { 2307 Put("("), Walk(x.v), Put(")"); 2308 } 2309 void Unparse(const OmpReductionInitializerClause &x) { 2310 Word(" INITIALIZER(OMP_PRIV = "); 2311 Walk(x.v); 2312 Put(")"); 2313 } 2314 void Unparse(const OmpReductionCombiner::FunctionCombiner &x) { 2315 const auto &pd = std::get<ProcedureDesignator>(x.v.t); 2316 const auto &args = std::get<std::list<ActualArgSpec>>(x.v.t); 2317 Walk(pd); 2318 if (args.empty()) { 2319 if (std::holds_alternative<ProcComponentRef>(pd.u)) { 2320 Put("()"); 2321 } 2322 } else { 2323 Walk("(", args, ", ", ")"); 2324 } 2325 } 2326 void Unparse(const OpenMPDeclareReductionConstruct &x) { 2327 Put("("); 2328 Walk(std::get<OmpReductionOperator>(x.t)), Put(" : "); 2329 Walk(std::get<std::list<DeclarationTypeSpec>>(x.t), ","), Put(" : "); 2330 Walk(std::get<OmpReductionCombiner>(x.t)); 2331 Put(")"); 2332 Walk(std::get<std::optional<OmpReductionInitializerClause>>(x.t)); 2333 } 2334 bool Pre(const OpenMPDeclarativeConstruct &x) { 2335 BeginOpenMP(); 2336 Word("!$OMP "); 2337 return std::visit(common::visitors{ 2338 [&](const OpenMPDeclarativeAllocate &z) { 2339 Word("ALLOCATE ("); 2340 Walk(std::get<OmpObjectList>(z.t)); 2341 Put(")"); 2342 Walk(std::get<OmpClauseList>(z.t)); 2343 Put("\n"); 2344 EndOpenMP(); 2345 return false; 2346 }, 2347 [&](const OpenMPDeclareReductionConstruct &) { 2348 Word("DECLARE REDUCTION "); 2349 return true; 2350 }, 2351 [&](const OpenMPDeclareSimdConstruct &y) { 2352 Word("DECLARE SIMD "); 2353 Walk("(", std::get<std::optional<Name>>(y.t), ")"); 2354 Walk(std::get<OmpClauseList>(y.t)); 2355 Put("\n"); 2356 EndOpenMP(); 2357 return false; 2358 }, 2359 [&](const OpenMPDeclareTargetConstruct &) { 2360 Word("DECLARE TARGET "); 2361 return true; 2362 }, 2363 [&](const OpenMPThreadprivate &) { 2364 Word("THREADPRIVATE ("); 2365 return true; 2366 }, 2367 }, 2368 x.u); 2369 } 2370 void Post(const OpenMPDeclarativeConstruct &) { 2371 Put("\n"); 2372 EndOpenMP(); 2373 } 2374 void Post(const OpenMPThreadprivate &) { 2375 Put(")\n"); 2376 EndOpenMP(); 2377 } 2378 void Unparse(const OmpSectionsDirective &x) { 2379 switch (x.v) { 2380 case llvm::omp::Directive::OMPD_sections: 2381 Word("SECTIONS "); 2382 break; 2383 case llvm::omp::Directive::OMPD_parallel_sections: 2384 Word("PARALLEL SECTIONS "); 2385 break; 2386 default: 2387 break; 2388 } 2389 } 2390 void Unparse(const OmpSectionBlocks &x) { 2391 for (const auto &y : x.v) { 2392 BeginOpenMP(); 2393 Word("!$OMP SECTION"); 2394 Put("\n"); 2395 EndOpenMP(); 2396 Walk(y, ""); // y is Block 2397 } 2398 } 2399 void Unparse(const OpenMPSectionsConstruct &x) { 2400 BeginOpenMP(); 2401 Word("!$OMP "); 2402 Walk(std::get<OmpBeginSectionsDirective>(x.t)); 2403 Put("\n"); 2404 EndOpenMP(); 2405 Walk(std::get<OmpSectionBlocks>(x.t)); 2406 BeginOpenMP(); 2407 Word("!$OMP END "); 2408 Walk(std::get<OmpEndSectionsDirective>(x.t)); 2409 Put("\n"); 2410 EndOpenMP(); 2411 } 2412 void Unparse(const OpenMPCancellationPointConstruct &x) { 2413 BeginOpenMP(); 2414 Word("!$OMP CANCELLATION POINT "); 2415 Walk(std::get<OmpCancelType>(x.t)); 2416 Put("\n"); 2417 EndOpenMP(); 2418 } 2419 void Unparse(const OpenMPCancelConstruct &x) { 2420 BeginOpenMP(); 2421 Word("!$OMP CANCEL "); 2422 Walk(std::get<OmpCancelType>(x.t)); 2423 Walk(std::get<std::optional<OpenMPCancelConstruct::If>>(x.t)); 2424 Put("\n"); 2425 EndOpenMP(); 2426 } 2427 void Unparse(const OmpMemoryOrderClause &x) { Walk(x.v); } 2428 void Unparse(const OmpAtomicClause &x) { 2429 std::visit(common::visitors{ 2430 [&](const OmpMemoryOrderClause &y) { Walk(y); }, 2431 [&](const OmpClause &z) { Walk(z); }, 2432 }, 2433 x.u); 2434 } 2435 void Unparse(const OpenMPFlushConstruct &x) { 2436 BeginOpenMP(); 2437 Word("!$OMP FLUSH "); 2438 Walk(std::get<std::optional<std::list<OmpMemoryOrderClause>>>(x.t)); 2439 Walk(" (", std::get<std::optional<OmpObjectList>>(x.t), ")"); 2440 Put("\n"); 2441 EndOpenMP(); 2442 } 2443 void Unparse(const OmpEndLoopDirective &x) { 2444 BeginOpenMP(); 2445 Word("!$OMP END "); 2446 Walk(std::get<OmpLoopDirective>(x.t)); 2447 Walk(std::get<OmpClauseList>(x.t)); 2448 Put("\n"); 2449 EndOpenMP(); 2450 } 2451 void Unparse(const OmpClauseList &x) { Walk(" ", x.v, " "); } 2452 void Unparse(const OpenMPSimpleStandaloneConstruct &x) { 2453 BeginOpenMP(); 2454 Word("!$OMP "); 2455 Walk(std::get<OmpSimpleStandaloneDirective>(x.t)); 2456 Walk(std::get<OmpClauseList>(x.t)); 2457 Put("\n"); 2458 EndOpenMP(); 2459 } 2460 void Unparse(const OpenMPBlockConstruct &x) { 2461 BeginOpenMP(); 2462 Word("!$OMP "); 2463 Walk(std::get<OmpBeginBlockDirective>(x.t)); 2464 Put("\n"); 2465 EndOpenMP(); 2466 Walk(std::get<Block>(x.t), ""); 2467 BeginOpenMP(); 2468 Word("!$OMP END "); 2469 Walk(std::get<OmpEndBlockDirective>(x.t)); 2470 Put("\n"); 2471 EndOpenMP(); 2472 } 2473 void Unparse(const OpenMPLoopConstruct &x) { 2474 BeginOpenMP(); 2475 Word("!$OMP "); 2476 Walk(std::get<OmpBeginLoopDirective>(x.t)); 2477 Put("\n"); 2478 EndOpenMP(); 2479 Walk(std::get<std::optional<DoConstruct>>(x.t)); 2480 Walk(std::get<std::optional<OmpEndLoopDirective>>(x.t)); 2481 } 2482 void Unparse(const BasedPointer &x) { 2483 Put('('), Walk(std::get<0>(x.t)), Put(","), Walk(std::get<1>(x.t)); 2484 Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"), Put(')'); 2485 } 2486 void Unparse(const BasedPointerStmt &x) { Walk("POINTER ", x.v, ","); } 2487 void Post(const StructureField &x) { 2488 if (const auto *def{std::get_if<Statement<DataComponentDefStmt>>(&x.u)}) { 2489 for (const auto &decl : 2490 std::get<std::list<ComponentDecl>>(def->statement.t)) { 2491 structureComponents_.insert(std::get<Name>(decl.t).source); 2492 } 2493 } 2494 } 2495 void Unparse(const StructureStmt &x) { 2496 Word("STRUCTURE "); 2497 if (std::get<bool>(x.t)) { // slashes around name 2498 Put('/'), Walk(std::get<Name>(x.t)), Put('/'); 2499 Walk(" ", std::get<std::list<EntityDecl>>(x.t), ", "); 2500 } else { 2501 CHECK(std::get<std::list<EntityDecl>>(x.t).empty()); 2502 Walk(std::get<Name>(x.t)); 2503 } 2504 Indent(); 2505 } 2506 void Post(const Union::UnionStmt &) { Word("UNION"), Indent(); } 2507 void Post(const Union::EndUnionStmt &) { Outdent(), Word("END UNION"); } 2508 void Post(const Map::MapStmt &) { Word("MAP"), Indent(); } 2509 void Post(const Map::EndMapStmt &) { Outdent(), Word("END MAP"); } 2510 void Post(const StructureDef::EndStructureStmt &) { 2511 Outdent(), Word("END STRUCTURE"); 2512 } 2513 void Unparse(const OldParameterStmt &x) { 2514 Word("PARAMETER "), Walk(x.v, ", "); 2515 } 2516 void Unparse(const ArithmeticIfStmt &x) { 2517 Word("IF ("), Walk(std::get<Expr>(x.t)), Put(") "); 2518 Walk(std::get<1>(x.t)), Put(", "); 2519 Walk(std::get<2>(x.t)), Put(", "); 2520 Walk(std::get<3>(x.t)); 2521 } 2522 void Unparse(const AssignStmt &x) { 2523 Word("ASSIGN "), Walk(std::get<Label>(x.t)); 2524 Word(" TO "), Walk(std::get<Name>(x.t)); 2525 } 2526 void Unparse(const AssignedGotoStmt &x) { 2527 Word("GO TO "), Walk(std::get<Name>(x.t)); 2528 Walk(", (", std::get<std::list<Label>>(x.t), ", ", ")"); 2529 } 2530 void Unparse(const PauseStmt &x) { Word("PAUSE"), Walk(" ", x.v); } 2531 2532 #define WALK_NESTED_ENUM(CLASS, ENUM) \ 2533 void Unparse(const CLASS::ENUM &x) { Word(CLASS::EnumToString(x)); } 2534 WALK_NESTED_ENUM(AccessSpec, Kind) // R807 2535 WALK_NESTED_ENUM(common, TypeParamAttr) // R734 2536 WALK_NESTED_ENUM(IntentSpec, Intent) // R826 2537 WALK_NESTED_ENUM(ImplicitStmt, ImplicitNoneNameSpec) // R866 2538 WALK_NESTED_ENUM(ConnectSpec::CharExpr, Kind) // R1205 2539 WALK_NESTED_ENUM(IoControlSpec::CharExpr, Kind) 2540 WALK_NESTED_ENUM(InquireSpec::CharVar, Kind) 2541 WALK_NESTED_ENUM(InquireSpec::IntVar, Kind) 2542 WALK_NESTED_ENUM(InquireSpec::LogVar, Kind) 2543 WALK_NESTED_ENUM(ProcedureStmt, Kind) // R1506 2544 WALK_NESTED_ENUM(UseStmt, ModuleNature) // R1410 2545 WALK_NESTED_ENUM(OmpProcBindClause, Type) // OMP PROC_BIND 2546 WALK_NESTED_ENUM(OmpDefaultClause, Type) // OMP DEFAULT 2547 WALK_NESTED_ENUM(OmpDefaultmapClause, ImplicitBehavior) // OMP DEFAULTMAP 2548 WALK_NESTED_ENUM(OmpDefaultmapClause, VariableCategory) // OMP DEFAULTMAP 2549 WALK_NESTED_ENUM(OmpScheduleModifierType, ModType) // OMP schedule-modifier 2550 WALK_NESTED_ENUM(OmpLinearModifier, Type) // OMP linear-modifier 2551 WALK_NESTED_ENUM(OmpDependenceType, Type) // OMP dependence-type 2552 WALK_NESTED_ENUM(OmpMapType, Type) // OMP map-type 2553 WALK_NESTED_ENUM(OmpScheduleClause, ScheduleType) // OMP schedule-type 2554 WALK_NESTED_ENUM(OmpIfClause, DirectiveNameModifier) // OMP directive-modifier 2555 WALK_NESTED_ENUM(OmpCancelType, Type) // OMP cancel-type 2556 #undef WALK_NESTED_ENUM 2557 2558 void Done() const { CHECK(indent_ == 0); } 2559 2560 private: 2561 void Put(char); 2562 void Put(const char *); 2563 void Put(const std::string &); 2564 void PutNormalized(const std::string &); 2565 void PutKeywordLetter(char); 2566 void Word(const char *); 2567 void Word(const std::string &); 2568 void Indent() { indent_ += indentationAmount_; } 2569 void Outdent() { 2570 CHECK(indent_ >= indentationAmount_); 2571 indent_ -= indentationAmount_; 2572 } 2573 void BeginOpenMP() { openmpDirective_ = true; } 2574 void EndOpenMP() { openmpDirective_ = false; } 2575 void BeginOpenACC() { openaccDirective_ = true; } 2576 void EndOpenACC() { openaccDirective_ = false; } 2577 2578 // Call back to the traversal framework. 2579 template <typename T> void Walk(const T &x) { 2580 Fortran::parser::Walk(x, *this); 2581 } 2582 2583 // Traverse a std::optional<> value. Emit a prefix and/or a suffix string 2584 // only when it contains a value. 2585 template <typename A> 2586 void Walk( 2587 const char *prefix, const std::optional<A> &x, const char *suffix = "") { 2588 if (x) { 2589 Word(prefix), Walk(*x), Word(suffix); 2590 } 2591 } 2592 template <typename A> 2593 void Walk(const std::optional<A> &x, const char *suffix = "") { 2594 return Walk("", x, suffix); 2595 } 2596 2597 // Traverse a std::list<>. Separate the elements with an optional string. 2598 // Emit a prefix and/or a suffix string only when the list is not empty. 2599 template <typename A> 2600 void Walk(const char *prefix, const std::list<A> &list, 2601 const char *comma = ", ", const char *suffix = "") { 2602 if (!list.empty()) { 2603 const char *str{prefix}; 2604 for (const auto &x : list) { 2605 Word(str), Walk(x); 2606 str = comma; 2607 } 2608 Word(suffix); 2609 } 2610 } 2611 template <typename A> 2612 void Walk(const std::list<A> &list, const char *comma = ", ", 2613 const char *suffix = "") { 2614 return Walk("", list, comma, suffix); 2615 } 2616 2617 // Traverse a std::tuple<>, with an optional separator. 2618 template <std::size_t J = 0, typename T> 2619 void WalkTupleElements(const T &tuple, const char *separator) { 2620 if (J > 0 && J < std::tuple_size_v<T>) { 2621 Word(separator); // this usage dodges "unused parameter" warning 2622 } 2623 if constexpr (J < std::tuple_size_v<T>) { 2624 Walk(std::get<J>(tuple)); 2625 WalkTupleElements<J + 1>(tuple, separator); 2626 } 2627 } 2628 template <typename... A> 2629 void Walk(const std::tuple<A...> &tuple, const char *separator = "") { 2630 WalkTupleElements(tuple, separator); 2631 } 2632 2633 void EndSubprogram(const char *kind, const std::optional<Name> &name) { 2634 Outdent(), Word("END "), Word(kind), Walk(" ", name); 2635 structureComponents_.clear(); 2636 } 2637 2638 llvm::raw_ostream &out_; 2639 int indent_{0}; 2640 const int indentationAmount_{1}; 2641 int column_{1}; 2642 const int maxColumns_{80}; 2643 std::set<CharBlock> structureComponents_; 2644 Encoding encoding_{Encoding::UTF_8}; 2645 bool capitalizeKeywords_{true}; 2646 bool openaccDirective_{false}; 2647 bool openmpDirective_{false}; 2648 bool backslashEscapes_{false}; 2649 preStatementType *preStatement_{nullptr}; 2650 AnalyzedObjectsAsFortran *asFortran_{nullptr}; 2651 }; 2652 2653 void UnparseVisitor::Put(char ch) { 2654 int sav = indent_; 2655 if (openmpDirective_ || openaccDirective_) { 2656 indent_ = 0; 2657 } 2658 if (column_ <= 1) { 2659 if (ch == '\n') { 2660 return; 2661 } 2662 for (int j{0}; j < indent_; ++j) { 2663 out_ << ' '; 2664 } 2665 column_ = indent_ + 2; 2666 } else if (ch == '\n') { 2667 column_ = 1; 2668 } else if (++column_ >= maxColumns_) { 2669 out_ << "&\n"; 2670 for (int j{0}; j < indent_; ++j) { 2671 out_ << ' '; 2672 } 2673 if (openmpDirective_) { 2674 out_ << "!$OMP&"; 2675 column_ = 8; 2676 } else if (openaccDirective_) { 2677 out_ << "!$ACC&"; 2678 column_ = 8; 2679 } else { 2680 out_ << '&'; 2681 column_ = indent_ + 3; 2682 } 2683 } 2684 out_ << ch; 2685 if (openmpDirective_ || openaccDirective_) { 2686 indent_ = sav; 2687 } 2688 } 2689 2690 void UnparseVisitor::Put(const char *str) { 2691 for (; *str != '\0'; ++str) { 2692 Put(*str); 2693 } 2694 } 2695 2696 void UnparseVisitor::Put(const std::string &str) { 2697 for (char ch : str) { 2698 Put(ch); 2699 } 2700 } 2701 2702 void UnparseVisitor::PutNormalized(const std::string &str) { 2703 auto decoded{DecodeString<std::string, Encoding::LATIN_1>(str, true)}; 2704 std::string encoded{EncodeString<Encoding::LATIN_1>(decoded)}; 2705 Put(QuoteCharacterLiteral(encoded, backslashEscapes_)); 2706 } 2707 2708 void UnparseVisitor::PutKeywordLetter(char ch) { 2709 if (capitalizeKeywords_) { 2710 Put(ToUpperCaseLetter(ch)); 2711 } else { 2712 Put(ToLowerCaseLetter(ch)); 2713 } 2714 } 2715 2716 void UnparseVisitor::Word(const char *str) { 2717 for (; *str != '\0'; ++str) { 2718 PutKeywordLetter(*str); 2719 } 2720 } 2721 2722 void UnparseVisitor::Word(const std::string &str) { Word(str.c_str()); } 2723 2724 void Unparse(llvm::raw_ostream &out, const Program &program, Encoding encoding, 2725 bool capitalizeKeywords, bool backslashEscapes, 2726 preStatementType *preStatement, AnalyzedObjectsAsFortran *asFortran) { 2727 UnparseVisitor visitor{out, 1, encoding, capitalizeKeywords, backslashEscapes, 2728 preStatement, asFortran}; 2729 Walk(program, visitor); 2730 visitor.Done(); 2731 } 2732 } // namespace Fortran::parser 2733