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<ComponentDecl>>(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 ComponentDecl &d) { 274 const auto &init{ 275 std::get<std::optional<Initialization>>(d.t)}; 276 return init && 277 std::holds_alternative< 278 std::list<common::Indirection<DataStmtValue>>>( 279 init->u); 280 }))) { 281 Put(" ::"); 282 } 283 Put(' '), Walk(decls, ", "); 284 } 285 void Unparse(const Allocatable &) { // R738 286 Word("ALLOCATABLE"); 287 } 288 void Unparse(const Pointer &) { Word("POINTER"); } 289 void Unparse(const Contiguous &) { Word("CONTIGUOUS"); } 290 void Before(const ComponentAttrSpec &x) { 291 std::visit(common::visitors{ 292 [&](const CoarraySpec &) { Word("CODIMENSION["); }, 293 [&](const ComponentArraySpec &) { Word("DIMENSION("); }, 294 [](const auto &) {}, 295 }, 296 x.u); 297 } 298 void Post(const ComponentAttrSpec &x) { 299 std::visit(common::visitors{ 300 [&](const CoarraySpec &) { Put(']'); }, 301 [&](const ComponentArraySpec &) { Put(')'); }, 302 [](const auto &) {}, 303 }, 304 x.u); 305 } 306 void Unparse(const ComponentDecl &x) { // R739 307 Walk(std::get<ObjectName>(x.t)); 308 Walk("(", std::get<std::optional<ComponentArraySpec>>(x.t), ")"); 309 Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]"); 310 Walk("*", std::get<std::optional<CharLength>>(x.t)); 311 Walk(std::get<std::optional<Initialization>>(x.t)); 312 } 313 void Unparse(const ComponentArraySpec &x) { // R740 314 std::visit(common::visitors{ 315 [&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); }, 316 [&](const DeferredShapeSpecList &y) { Walk(y); }, 317 }, 318 x.u); 319 } 320 void Unparse(const ProcComponentDefStmt &x) { // R741 321 Word("PROCEDURE("); 322 Walk(std::get<std::optional<ProcInterface>>(x.t)), Put(')'); 323 Walk(", ", std::get<std::list<ProcComponentAttrSpec>>(x.t), ", "); 324 Put(" :: "), Walk(std::get<std::list<ProcDecl>>(x.t), ", "); 325 } 326 void Unparse(const NoPass &) { // R742 327 Word("NOPASS"); 328 } 329 void Unparse(const Pass &x) { Word("PASS"), Walk("(", x.v, ")"); } 330 void Unparse(const Initialization &x) { // R743 & R805 331 std::visit(common::visitors{ 332 [&](const ConstantExpr &y) { Put(" = "), Walk(y); }, 333 [&](const NullInit &y) { Put(" => "), Walk(y); }, 334 [&](const InitialDataTarget &y) { Put(" => "), Walk(y); }, 335 [&](const std::list<common::Indirection<DataStmtValue>> &y) { 336 Walk("/", y, ", ", "/"); 337 }, 338 }, 339 x.u); 340 } 341 void Unparse(const PrivateStmt &) { // R745 342 Word("PRIVATE"); 343 } 344 void Unparse(const TypeBoundProcedureStmt::WithoutInterface &x) { // R749 345 Word("PROCEDURE"), Walk(", ", x.attributes, ", "); 346 Put(" :: "), Walk(x.declarations, ", "); 347 } 348 void Unparse(const TypeBoundProcedureStmt::WithInterface &x) { 349 Word("PROCEDURE("), Walk(x.interfaceName), Put("), "); 350 Walk(x.attributes); 351 Put(" :: "), Walk(x.bindingNames, ", "); 352 } 353 void Unparse(const TypeBoundProcDecl &x) { // R750 354 Walk(std::get<Name>(x.t)); 355 Walk(" => ", std::get<std::optional<Name>>(x.t)); 356 } 357 void Unparse(const TypeBoundGenericStmt &x) { // R751 358 Word("GENERIC"), Walk(", ", std::get<std::optional<AccessSpec>>(x.t)); 359 Put(" :: "), Walk(std::get<common::Indirection<GenericSpec>>(x.t)); 360 Put(" => "), Walk(std::get<std::list<Name>>(x.t), ", "); 361 } 362 void Post(const BindAttr::Deferred &) { Word("DEFERRED"); } // R752 363 void Post(const BindAttr::Non_Overridable &) { Word("NON_OVERRIDABLE"); } 364 void Unparse(const FinalProcedureStmt &x) { // R753 365 Word("FINAL :: "), Walk(x.v, ", "); 366 } 367 void Unparse(const DerivedTypeSpec &x) { // R754 368 Walk(std::get<Name>(x.t)); 369 Walk("(", std::get<std::list<TypeParamSpec>>(x.t), ",", ")"); 370 } 371 void Unparse(const TypeParamSpec &x) { // R755 372 Walk(std::get<std::optional<Keyword>>(x.t), "="); 373 Walk(std::get<TypeParamValue>(x.t)); 374 } 375 void Unparse(const StructureConstructor &x) { // R756 376 Walk(std::get<DerivedTypeSpec>(x.t)); 377 Put('('), Walk(std::get<std::list<ComponentSpec>>(x.t), ", "), Put(')'); 378 } 379 void Unparse(const ComponentSpec &x) { // R757 380 Walk(std::get<std::optional<Keyword>>(x.t), "="); 381 Walk(std::get<ComponentDataSource>(x.t)); 382 } 383 void Unparse(const EnumDefStmt &) { // R760 384 Word("ENUM, BIND(C)"), Indent(); 385 } 386 void Unparse(const EnumeratorDefStmt &x) { // R761 387 Word("ENUMERATOR :: "), Walk(x.v, ", "); 388 } 389 void Unparse(const Enumerator &x) { // R762 390 Walk(std::get<NamedConstant>(x.t)); 391 Walk(" = ", std::get<std::optional<ScalarIntConstantExpr>>(x.t)); 392 } 393 void Post(const EndEnumStmt &) { // R763 394 Outdent(), Word("END ENUM"); 395 } 396 void Unparse(const BOZLiteralConstant &x) { // R764 - R767 397 Put(x.v); 398 } 399 void Unparse(const AcValue::Triplet &x) { // R773 400 Walk(std::get<0>(x.t)), Put(':'), Walk(std::get<1>(x.t)); 401 Walk(":", std::get<std::optional<ScalarIntExpr>>(x.t)); 402 } 403 void Unparse(const ArrayConstructor &x) { // R769 404 Put('['), Walk(x.v), Put(']'); 405 } 406 void Unparse(const AcSpec &x) { // R770 407 Walk(x.type, "::"), Walk(x.values, ", "); 408 } 409 template <typename A, typename B> void Unparse(const LoopBounds<A, B> &x) { 410 Walk(x.name), Put('='), Walk(x.lower), Put(','), Walk(x.upper); 411 Walk(",", x.step); 412 } 413 void Unparse(const AcImpliedDo &x) { // R774 414 Put('('), Walk(std::get<std::list<AcValue>>(x.t), ", "); 415 Put(", "), Walk(std::get<AcImpliedDoControl>(x.t)), Put(')'); 416 } 417 void Unparse(const AcImpliedDoControl &x) { // R775 418 Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::"); 419 Walk(std::get<AcImpliedDoControl::Bounds>(x.t)); 420 } 421 422 void Unparse(const TypeDeclarationStmt &x) { // R801 423 const auto &dts{std::get<DeclarationTypeSpec>(x.t)}; 424 const auto &attrs{std::get<std::list<AttrSpec>>(x.t)}; 425 const auto &decls{std::get<std::list<EntityDecl>>(x.t)}; 426 Walk(dts), Walk(", ", attrs, ", "); 427 428 static const auto isInitializerOldStyle{[](const Initialization &i) { 429 return std::holds_alternative< 430 std::list<common::Indirection<DataStmtValue>>>(i.u); 431 }}; 432 static const auto hasAssignmentInitializer{[](const EntityDecl &d) { 433 // Does a declaration have a new-style =x initializer? 434 const auto &init{std::get<std::optional<Initialization>>(d.t)}; 435 return init && !isInitializerOldStyle(*init); 436 }}; 437 static const auto hasSlashDelimitedInitializer{[](const EntityDecl &d) { 438 // Does a declaration have an old-style /x/ initializer? 439 const auto &init{std::get<std::optional<Initialization>>(d.t)}; 440 return init && isInitializerOldStyle(*init); 441 }}; 442 const auto useDoubledColons{[&]() { 443 bool isRecord{std::holds_alternative<DeclarationTypeSpec::Record>(dts.u)}; 444 if (!attrs.empty()) { 445 // Attributes after the type require :: before the entities. 446 CHECK(!isRecord); 447 return true; 448 } 449 if (std::any_of(decls.begin(), decls.end(), hasAssignmentInitializer)) { 450 // Always use :: with new style standard initializers (=x), 451 // since the standard requires them to appear (even in free form, 452 // where mandatory spaces already disambiguate INTEGER J=666). 453 CHECK(!isRecord); 454 return true; 455 } 456 if (isRecord) { 457 // Never put :: in a legacy extension RECORD// statement. 458 return false; 459 } 460 // The :: is optional for this declaration. Avoid usage that can 461 // crash the pgf90 compiler. 462 if (std::any_of( 463 decls.begin(), decls.end(), hasSlashDelimitedInitializer)) { 464 // Don't use :: when a declaration uses legacy DATA-statement-like 465 // /x/ initialization. 466 return false; 467 } 468 // Don't use :: with intrinsic types. Otherwise, use it. 469 return !std::holds_alternative<IntrinsicTypeSpec>(dts.u); 470 }}; 471 472 if (useDoubledColons()) { 473 Put(" ::"); 474 } 475 Put(' '), Walk(std::get<std::list<EntityDecl>>(x.t), ", "); 476 } 477 void Before(const AttrSpec &x) { // R802 478 std::visit(common::visitors{ 479 [&](const CoarraySpec &) { Word("CODIMENSION["); }, 480 [&](const ArraySpec &) { Word("DIMENSION("); }, 481 [](const auto &) {}, 482 }, 483 x.u); 484 } 485 void Post(const AttrSpec &x) { 486 std::visit(common::visitors{ 487 [&](const CoarraySpec &) { Put(']'); }, 488 [&](const ArraySpec &) { Put(')'); }, 489 [](const auto &) {}, 490 }, 491 x.u); 492 } 493 void Unparse(const EntityDecl &x) { // R803 494 Walk(std::get<ObjectName>(x.t)); 495 Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"); 496 Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]"); 497 Walk("*", std::get<std::optional<CharLength>>(x.t)); 498 Walk(std::get<std::optional<Initialization>>(x.t)); 499 } 500 void Unparse(const NullInit &) { // R806 501 Word("NULL()"); 502 } 503 void Unparse(const LanguageBindingSpec &x) { // R808 & R1528 504 Word("BIND(C"), Walk(", NAME=", x.v), Put(')'); 505 } 506 void Unparse(const CoarraySpec &x) { // R809 507 std::visit(common::visitors{ 508 [&](const DeferredCoshapeSpecList &y) { Walk(y); }, 509 [&](const ExplicitCoshapeSpec &y) { Walk(y); }, 510 }, 511 x.u); 512 } 513 void Unparse(const DeferredCoshapeSpecList &x) { // R810 514 for (auto j{x.v}; j > 0; --j) { 515 Put(':'); 516 if (j > 1) { 517 Put(','); 518 } 519 } 520 } 521 void Unparse(const ExplicitCoshapeSpec &x) { // R811 522 Walk(std::get<std::list<ExplicitShapeSpec>>(x.t), ",", ","); 523 Walk(std::get<std::optional<SpecificationExpr>>(x.t), ":"), Put('*'); 524 } 525 void Unparse(const ExplicitShapeSpec &x) { // R812 - R813 & R816 - R818 526 Walk(std::get<std::optional<SpecificationExpr>>(x.t), ":"); 527 Walk(std::get<SpecificationExpr>(x.t)); 528 } 529 void Unparse(const ArraySpec &x) { // R815 530 std::visit(common::visitors{ 531 [&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); }, 532 [&](const std::list<AssumedShapeSpec> &y) { Walk(y, ","); }, 533 [&](const DeferredShapeSpecList &y) { Walk(y); }, 534 [&](const AssumedSizeSpec &y) { Walk(y); }, 535 [&](const ImpliedShapeSpec &y) { Walk(y); }, 536 [&](const AssumedRankSpec &y) { Walk(y); }, 537 }, 538 x.u); 539 } 540 void Post(const AssumedShapeSpec &) { Put(':'); } // R819 541 void Unparse(const DeferredShapeSpecList &x) { // R820 542 for (auto j{x.v}; j > 0; --j) { 543 Put(':'); 544 if (j > 1) { 545 Put(','); 546 } 547 } 548 } 549 void Unparse(const AssumedImpliedSpec &x) { // R821 550 Walk(x.v, ":"); 551 Put('*'); 552 } 553 void Unparse(const AssumedSizeSpec &x) { // R822 554 Walk(std::get<std::list<ExplicitShapeSpec>>(x.t), ",", ","); 555 Walk(std::get<AssumedImpliedSpec>(x.t)); 556 } 557 void Unparse(const ImpliedShapeSpec &x) { // R823 558 Walk(x.v, ","); 559 } 560 void Post(const AssumedRankSpec &) { Put(".."); } // R825 561 void Post(const Asynchronous &) { Word("ASYNCHRONOUS"); } 562 void Post(const External &) { Word("EXTERNAL"); } 563 void Post(const Intrinsic &) { Word("INTRINSIC"); } 564 void Post(const Optional &) { Word("OPTIONAL"); } 565 void Post(const Parameter &) { Word("PARAMETER"); } 566 void Post(const Protected &) { Word("PROTECTED"); } 567 void Post(const Save &) { Word("SAVE"); } 568 void Post(const Target &) { Word("TARGET"); } 569 void Post(const Value &) { Word("VALUE"); } 570 void Post(const Volatile &) { Word("VOLATILE"); } 571 void Unparse(const IntentSpec &x) { // R826 572 Word("INTENT("), Walk(x.v), Put(")"); 573 } 574 void Unparse(const AccessStmt &x) { // R827 575 Walk(std::get<AccessSpec>(x.t)); 576 Walk(" :: ", std::get<std::list<AccessId>>(x.t), ", "); 577 } 578 void Unparse(const AllocatableStmt &x) { // R829 579 Word("ALLOCATABLE :: "), Walk(x.v, ", "); 580 } 581 void Unparse(const ObjectDecl &x) { // R830 & R860 582 Walk(std::get<ObjectName>(x.t)); 583 Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"); 584 Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]"); 585 } 586 void Unparse(const AsynchronousStmt &x) { // R831 587 Word("ASYNCHRONOUS :: "), Walk(x.v, ", "); 588 } 589 void Unparse(const BindStmt &x) { // R832 590 Walk(x.t, " :: "); 591 } 592 void Unparse(const BindEntity &x) { // R833 593 bool isCommon{std::get<BindEntity::Kind>(x.t) == BindEntity::Kind::Common}; 594 const char *slash{isCommon ? "/" : ""}; 595 Put(slash), Walk(std::get<Name>(x.t)), Put(slash); 596 } 597 void Unparse(const CodimensionStmt &x) { // R834 598 Word("CODIMENSION :: "), Walk(x.v, ", "); 599 } 600 void Unparse(const CodimensionDecl &x) { // R835 601 Walk(std::get<Name>(x.t)); 602 Put('['), Walk(std::get<CoarraySpec>(x.t)), Put(']'); 603 } 604 void Unparse(const ContiguousStmt &x) { // R836 605 Word("CONTIGUOUS :: "), Walk(x.v, ", "); 606 } 607 void Unparse(const DataStmt &x) { // R837 608 Word("DATA "), Walk(x.v, ", "); 609 } 610 void Unparse(const DataStmtSet &x) { // R838 611 Walk(std::get<std::list<DataStmtObject>>(x.t), ", "); 612 Put('/'), Walk(std::get<std::list<DataStmtValue>>(x.t), ", "), Put('/'); 613 } 614 void Unparse(const DataImpliedDo &x) { // R840, R842 615 Put('('), Walk(std::get<std::list<DataIDoObject>>(x.t), ", "), Put(','); 616 Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::"); 617 Walk(std::get<DataImpliedDo::Bounds>(x.t)), Put(')'); 618 } 619 void Unparse(const DataStmtValue &x) { // R843 620 Walk(std::get<std::optional<DataStmtRepeat>>(x.t), "*"); 621 Walk(std::get<DataStmtConstant>(x.t)); 622 } 623 void Unparse(const DimensionStmt &x) { // R848 624 Word("DIMENSION :: "), Walk(x.v, ", "); 625 } 626 void Unparse(const DimensionStmt::Declaration &x) { 627 Walk(std::get<Name>(x.t)); 628 Put('('), Walk(std::get<ArraySpec>(x.t)), Put(')'); 629 } 630 void Unparse(const IntentStmt &x) { // R849 631 Walk(x.t, " :: "); 632 } 633 void Unparse(const OptionalStmt &x) { // R850 634 Word("OPTIONAL :: "), Walk(x.v, ", "); 635 } 636 void Unparse(const ParameterStmt &x) { // R851 637 Word("PARAMETER("), Walk(x.v, ", "), Put(')'); 638 } 639 void Unparse(const NamedConstantDef &x) { // R852 640 Walk(x.t, "="); 641 } 642 void Unparse(const PointerStmt &x) { // R853 643 Word("POINTER :: "), Walk(x.v, ", "); 644 } 645 void Unparse(const PointerDecl &x) { // R854 646 Walk(std::get<Name>(x.t)); 647 Walk("(", std::get<std::optional<DeferredShapeSpecList>>(x.t), ")"); 648 } 649 void Unparse(const ProtectedStmt &x) { // R855 650 Word("PROTECTED :: "), Walk(x.v, ", "); 651 } 652 void Unparse(const SaveStmt &x) { // R856 653 Word("SAVE"), Walk(" :: ", x.v, ", "); 654 } 655 void Unparse(const SavedEntity &x) { // R857, R858 656 bool isCommon{ 657 std::get<SavedEntity::Kind>(x.t) == SavedEntity::Kind::Common}; 658 const char *slash{isCommon ? "/" : ""}; 659 Put(slash), Walk(std::get<Name>(x.t)), Put(slash); 660 } 661 void Unparse(const TargetStmt &x) { // R859 662 Word("TARGET :: "), Walk(x.v, ", "); 663 } 664 void Unparse(const ValueStmt &x) { // R861 665 Word("VALUE :: "), Walk(x.v, ", "); 666 } 667 void Unparse(const VolatileStmt &x) { // R862 668 Word("VOLATILE :: "), Walk(x.v, ", "); 669 } 670 void Unparse(const ImplicitStmt &x) { // R863 671 Word("IMPLICIT "); 672 std::visit(common::visitors{ 673 [&](const std::list<ImplicitSpec> &y) { Walk(y, ", "); }, 674 [&](const std::list<ImplicitStmt::ImplicitNoneNameSpec> &y) { 675 Word("NONE"), Walk(" (", y, ", ", ")"); 676 }, 677 }, 678 x.u); 679 } 680 void Unparse(const ImplicitSpec &x) { // R864 681 Walk(std::get<DeclarationTypeSpec>(x.t)); 682 Put('('), Walk(std::get<std::list<LetterSpec>>(x.t), ", "), Put(')'); 683 } 684 void Unparse(const LetterSpec &x) { // R865 685 Put(*std::get<const char *>(x.t)); 686 auto second{std::get<std::optional<const char *>>(x.t)}; 687 if (second) { 688 Put('-'), Put(**second); 689 } 690 } 691 void Unparse(const ImportStmt &x) { // R867 692 Word("IMPORT"); 693 switch (x.kind) { 694 case common::ImportKind::Default: 695 Walk(" :: ", x.names, ", "); 696 break; 697 case common::ImportKind::Only: 698 Put(", "), Word("ONLY: "); 699 Walk(x.names, ", "); 700 break; 701 case common::ImportKind::None: 702 Word(", NONE"); 703 break; 704 case common::ImportKind::All: 705 Word(", ALL"); 706 break; 707 } 708 } 709 void Unparse(const NamelistStmt &x) { // R868 710 Word("NAMELIST"), Walk(x.v, ", "); 711 } 712 void Unparse(const NamelistStmt::Group &x) { 713 Put('/'), Walk(std::get<Name>(x.t)), Put('/'); 714 Walk(std::get<std::list<Name>>(x.t), ", "); 715 } 716 void Unparse(const EquivalenceStmt &x) { // R870, R871 717 Word("EQUIVALENCE"); 718 const char *separator{" "}; 719 for (const std::list<EquivalenceObject> &y : x.v) { 720 Put(separator), Put('('), Walk(y), Put(')'); 721 separator = ", "; 722 } 723 } 724 void Unparse(const CommonStmt &x) { // R873 725 Word("COMMON "); 726 Walk(x.blocks); 727 } 728 void Unparse(const CommonBlockObject &x) { // R874 729 Walk(std::get<Name>(x.t)); 730 Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"); 731 } 732 void Unparse(const CommonStmt::Block &x) { 733 Word("/"), Walk(std::get<std::optional<Name>>(x.t)), Word("/"); 734 Walk(std::get<std::list<CommonBlockObject>>(x.t)); 735 } 736 737 void Unparse(const Substring &x) { // R908, R909 738 Walk(std::get<DataRef>(x.t)); 739 Put('('), Walk(std::get<SubstringRange>(x.t)), Put(')'); 740 } 741 void Unparse(const CharLiteralConstantSubstring &x) { 742 Walk(std::get<CharLiteralConstant>(x.t)); 743 Put('('), Walk(std::get<SubstringRange>(x.t)), Put(')'); 744 } 745 void Unparse(const SubstringRange &x) { // R910 746 Walk(x.t, ":"); 747 } 748 void Unparse(const PartRef &x) { // R912 749 Walk(x.name); 750 Walk("(", x.subscripts, ",", ")"); 751 Walk(x.imageSelector); 752 } 753 void Unparse(const StructureComponent &x) { // R913 754 Walk(x.base); 755 if (structureComponents_.find(x.component.source) != 756 structureComponents_.end()) { 757 Put('.'); 758 } else { 759 Put('%'); 760 } 761 Walk(x.component); 762 } 763 void Unparse(const ArrayElement &x) { // R917 764 Walk(x.base); 765 Put('('), Walk(x.subscripts, ","), Put(')'); 766 } 767 void Unparse(const SubscriptTriplet &x) { // R921 768 Walk(std::get<0>(x.t)), Put(':'), Walk(std::get<1>(x.t)); 769 Walk(":", std::get<2>(x.t)); 770 } 771 void Unparse(const ImageSelector &x) { // R924 772 Put('['), Walk(std::get<std::list<Cosubscript>>(x.t), ","); 773 Walk(",", std::get<std::list<ImageSelectorSpec>>(x.t), ","), Put(']'); 774 } 775 void Before(const ImageSelectorSpec::Stat &) { // R926 776 Word("STAT="); 777 } 778 void Before(const ImageSelectorSpec::Team_Number &) { Word("TEAM_NUMBER="); } 779 void Before(const ImageSelectorSpec &x) { 780 if (std::holds_alternative<TeamValue>(x.u)) { 781 Word("TEAM="); 782 } 783 } 784 void Unparse(const AllocateStmt &x) { // R927 785 Word("ALLOCATE("); 786 Walk(std::get<std::optional<TypeSpec>>(x.t), "::"); 787 Walk(std::get<std::list<Allocation>>(x.t), ", "); 788 Walk(", ", std::get<std::list<AllocOpt>>(x.t), ", "), Put(')'); 789 } 790 void Before(const AllocOpt &x) { // R928, R931 791 std::visit(common::visitors{ 792 [&](const AllocOpt::Mold &) { Word("MOLD="); }, 793 [&](const AllocOpt::Source &) { Word("SOURCE="); }, 794 [](const StatOrErrmsg &) {}, 795 }, 796 x.u); 797 } 798 void Unparse(const Allocation &x) { // R932 799 Walk(std::get<AllocateObject>(x.t)); 800 Walk("(", std::get<std::list<AllocateShapeSpec>>(x.t), ",", ")"); 801 Walk("[", std::get<std::optional<AllocateCoarraySpec>>(x.t), "]"); 802 } 803 void Unparse(const AllocateShapeSpec &x) { // R934 & R938 804 Walk(std::get<std::optional<BoundExpr>>(x.t), ":"); 805 Walk(std::get<BoundExpr>(x.t)); 806 } 807 void Unparse(const AllocateCoarraySpec &x) { // R937 808 Walk(std::get<std::list<AllocateCoshapeSpec>>(x.t), ",", ","); 809 Walk(std::get<std::optional<BoundExpr>>(x.t), ":"), Put('*'); 810 } 811 void Unparse(const NullifyStmt &x) { // R939 812 Word("NULLIFY("), Walk(x.v, ", "), Put(')'); 813 } 814 void Unparse(const DeallocateStmt &x) { // R941 815 Word("DEALLOCATE("); 816 Walk(std::get<std::list<AllocateObject>>(x.t), ", "); 817 Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')'); 818 } 819 void Before(const StatOrErrmsg &x) { // R942 & R1165 820 std::visit(common::visitors{ 821 [&](const StatVariable &) { Word("STAT="); }, 822 [&](const MsgVariable &) { Word("ERRMSG="); }, 823 }, 824 x.u); 825 } 826 827 // R1001 - R1022 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<OmpClauseList>(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