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