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