1 //===-- lib/Evaluate/formatting.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 #include "flang/Evaluate/formatting.h" 10 #include "flang/Common/Fortran.h" 11 #include "flang/Evaluate/call.h" 12 #include "flang/Evaluate/constant.h" 13 #include "flang/Evaluate/expression.h" 14 #include "flang/Evaluate/fold.h" 15 #include "flang/Evaluate/tools.h" 16 #include "flang/Parser/characters.h" 17 #include "flang/Semantics/symbol.h" 18 #include "llvm/Support/raw_ostream.h" 19 20 namespace Fortran::evaluate { 21 22 static void ShapeAsFortran( 23 llvm::raw_ostream &o, const ConstantSubscripts &shape) { 24 if (GetRank(shape) > 1) { 25 o << ",shape="; 26 char ch{'['}; 27 for (auto dim : shape) { 28 o << ch << dim; 29 ch = ','; 30 } 31 o << "])"; 32 } 33 } 34 35 template <typename RESULT, typename VALUE> 36 llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran( 37 llvm::raw_ostream &o) const { 38 if (Rank() > 1) { 39 o << "reshape("; 40 } 41 if (Rank() > 0) { 42 o << '[' << GetType().AsFortran() << "::"; 43 } 44 bool first{true}; 45 for (const auto &value : values_) { 46 if (first) { 47 first = false; 48 } else { 49 o << ','; 50 } 51 if constexpr (Result::category == TypeCategory::Integer) { 52 o << value.SignedDecimal() << '_' << Result::kind; 53 } else if constexpr (Result::category == TypeCategory::Real || 54 Result::category == TypeCategory::Complex) { 55 value.AsFortran(o, Result::kind); 56 } else if constexpr (Result::category == TypeCategory::Character) { 57 o << Result::kind << '_' << parser::QuoteCharacterLiteral(value, true); 58 } else if constexpr (Result::category == TypeCategory::Logical) { 59 if (value.IsTrue()) { 60 o << ".true."; 61 } else { 62 o << ".false."; 63 } 64 o << '_' << Result::kind; 65 } else { 66 StructureConstructor{result_.derivedTypeSpec(), value}.AsFortran(o); 67 } 68 } 69 if (Rank() > 0) { 70 o << ']'; 71 } 72 ShapeAsFortran(o, shape()); 73 return o; 74 } 75 76 template <int KIND> 77 llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran( 78 llvm::raw_ostream &o) const { 79 if (Rank() > 1) { 80 o << "reshape("; 81 } 82 if (Rank() > 0) { 83 o << '[' << GetType().AsFortran(std::to_string(length_)) << "::"; 84 } 85 auto total{static_cast<ConstantSubscript>(size())}; 86 for (ConstantSubscript j{0}; j < total; ++j) { 87 Scalar<Result> value{values_.substr(j * length_, length_)}; 88 if (j > 0) { 89 o << ','; 90 } 91 if (Result::kind != 1) { 92 o << Result::kind << '_'; 93 } 94 o << parser::QuoteCharacterLiteral(value); 95 } 96 if (Rank() > 0) { 97 o << ']'; 98 } 99 ShapeAsFortran(o, shape()); 100 return o; 101 } 102 103 llvm::raw_ostream &ActualArgument::AssumedType::AsFortran( 104 llvm::raw_ostream &o) const { 105 return o << symbol_->name().ToString(); 106 } 107 108 llvm::raw_ostream &ActualArgument::AsFortran(llvm::raw_ostream &o) const { 109 if (keyword_) { 110 o << keyword_->ToString() << '='; 111 } 112 std::visit( 113 common::visitors{ 114 [&](const common::CopyableIndirection<Expr<SomeType>> &expr) { 115 expr.value().AsFortran(o); 116 }, 117 [&](const AssumedType &assumedType) { assumedType.AsFortran(o); }, 118 [&](const common::Label &label) { o << '*' << label; }, 119 }, 120 u_); 121 return o; 122 } 123 124 llvm::raw_ostream &SpecificIntrinsic::AsFortran(llvm::raw_ostream &o) const { 125 return o << name; 126 } 127 128 llvm::raw_ostream &ProcedureRef::AsFortran(llvm::raw_ostream &o) const { 129 for (const auto &arg : arguments_) { 130 if (arg && arg->isPassedObject()) { 131 arg->AsFortran(o) << '%'; 132 break; 133 } 134 } 135 proc_.AsFortran(o); 136 char separator{'('}; 137 for (const auto &arg : arguments_) { 138 if (arg && !arg->isPassedObject()) { 139 arg->AsFortran(o << separator); 140 separator = ','; 141 } 142 } 143 if (separator == '(') { 144 o << '('; 145 } 146 return o << ')'; 147 } 148 149 // Operator precedence formatting; insert parentheses around operands 150 // only when necessary. 151 152 enum class Precedence { // in increasing order for sane comparisons 153 DefinedBinary, 154 Or, 155 And, 156 Equivalence, // .EQV., .NEQV. 157 Not, // which binds *less* tightly in Fortran than relations 158 Relational, 159 Additive, // +, -, and (arbitrarily) // 160 Negate, // which binds *less* tightly than *, /, ** 161 Multiplicative, // *, / 162 Power, // **, which is right-associative unlike the other dyadic operators 163 DefinedUnary, 164 Top, 165 }; 166 167 template <typename A> constexpr Precedence ToPrecedence(const A &) { 168 return Precedence::Top; 169 } 170 template <int KIND> 171 static Precedence ToPrecedence(const LogicalOperation<KIND> &x) { 172 switch (x.logicalOperator) { 173 SWITCH_COVERS_ALL_CASES 174 case LogicalOperator::And: 175 return Precedence::And; 176 case LogicalOperator::Or: 177 return Precedence::Or; 178 case LogicalOperator::Not: 179 return Precedence::Not; 180 case LogicalOperator::Eqv: 181 case LogicalOperator::Neqv: 182 return Precedence::Equivalence; 183 } 184 } 185 template <int KIND> constexpr Precedence ToPrecedence(const Not<KIND> &) { 186 return Precedence::Not; 187 } 188 template <typename T> constexpr Precedence ToPrecedence(const Relational<T> &) { 189 return Precedence::Relational; 190 } 191 template <typename T> constexpr Precedence ToPrecedence(const Add<T> &) { 192 return Precedence::Additive; 193 } 194 template <typename T> constexpr Precedence ToPrecedence(const Subtract<T> &) { 195 return Precedence::Additive; 196 } 197 template <int KIND> constexpr Precedence ToPrecedence(const Concat<KIND> &) { 198 return Precedence::Additive; 199 } 200 template <typename T> constexpr Precedence ToPrecedence(const Negate<T> &) { 201 return Precedence::Negate; 202 } 203 template <typename T> constexpr Precedence ToPrecedence(const Multiply<T> &) { 204 return Precedence::Multiplicative; 205 } 206 template <typename T> constexpr Precedence ToPrecedence(const Divide<T> &) { 207 return Precedence::Multiplicative; 208 } 209 template <typename T> constexpr Precedence ToPrecedence(const Power<T> &) { 210 return Precedence::Power; 211 } 212 template <typename T> 213 constexpr Precedence ToPrecedence(const RealToIntPower<T> &) { 214 return Precedence::Power; 215 } 216 template <typename T> static Precedence ToPrecedence(const Constant<T> &x) { 217 static constexpr TypeCategory cat{T::category}; 218 if constexpr (cat == TypeCategory::Integer || cat == TypeCategory::Real) { 219 if (auto n{GetScalarConstantValue<T>(x)}) { 220 if (n->IsNegative()) { 221 return Precedence::Negate; 222 } 223 } 224 } 225 return Precedence::Top; 226 } 227 template <typename T> static Precedence ToPrecedence(const Expr<T> &expr) { 228 return std::visit([](const auto &x) { return ToPrecedence(x); }, expr.u); 229 } 230 231 template <typename T> static bool IsNegatedScalarConstant(const Expr<T> &expr) { 232 static constexpr TypeCategory cat{T::category}; 233 if constexpr (cat == TypeCategory::Integer || cat == TypeCategory::Real) { 234 if (auto n{GetScalarConstantValue<T>(expr)}) { 235 return n->IsNegative(); 236 } 237 } 238 return false; 239 } 240 241 template <TypeCategory CAT> 242 static bool IsNegatedScalarConstant(const Expr<SomeKind<CAT>> &expr) { 243 return std::visit( 244 [](const auto &x) { return IsNegatedScalarConstant(x); }, expr.u); 245 } 246 247 struct OperatorSpelling { 248 const char *prefix{""}, *infix{","}, *suffix{""}; 249 }; 250 251 template <typename A> constexpr OperatorSpelling SpellOperator(const A &) { 252 return OperatorSpelling{}; 253 } 254 template <typename A> 255 constexpr OperatorSpelling SpellOperator(const Negate<A> &) { 256 return OperatorSpelling{"-", "", ""}; 257 } 258 template <typename A> 259 constexpr OperatorSpelling SpellOperator(const Parentheses<A> &) { 260 return OperatorSpelling{"(", "", ")"}; 261 } 262 template <int KIND> 263 static OperatorSpelling SpellOperator(const ComplexComponent<KIND> &x) { 264 return {x.isImaginaryPart ? "aimag(" : "real(", "", ")"}; 265 } 266 template <int KIND> 267 constexpr OperatorSpelling SpellOperator(const Not<KIND> &) { 268 return OperatorSpelling{".NOT.", "", ""}; 269 } 270 template <int KIND> 271 constexpr OperatorSpelling SpellOperator(const SetLength<KIND> &) { 272 return OperatorSpelling{"%SET_LENGTH(", ",", ")"}; 273 } 274 template <int KIND> 275 constexpr OperatorSpelling SpellOperator(const ComplexConstructor<KIND> &) { 276 return OperatorSpelling{"(", ",", ")"}; 277 } 278 template <typename A> constexpr OperatorSpelling SpellOperator(const Add<A> &) { 279 return OperatorSpelling{"", "+", ""}; 280 } 281 template <typename A> 282 constexpr OperatorSpelling SpellOperator(const Subtract<A> &) { 283 return OperatorSpelling{"", "-", ""}; 284 } 285 template <typename A> 286 constexpr OperatorSpelling SpellOperator(const Multiply<A> &) { 287 return OperatorSpelling{"", "*", ""}; 288 } 289 template <typename A> 290 constexpr OperatorSpelling SpellOperator(const Divide<A> &) { 291 return OperatorSpelling{"", "/", ""}; 292 } 293 template <typename A> 294 constexpr OperatorSpelling SpellOperator(const Power<A> &) { 295 return OperatorSpelling{"", "**", ""}; 296 } 297 template <typename A> 298 constexpr OperatorSpelling SpellOperator(const RealToIntPower<A> &) { 299 return OperatorSpelling{"", "**", ""}; 300 } 301 template <typename A> 302 static OperatorSpelling SpellOperator(const Extremum<A> &x) { 303 return OperatorSpelling{ 304 x.ordering == Ordering::Less ? "min(" : "max(", ",", ")"}; 305 } 306 template <int KIND> 307 constexpr OperatorSpelling SpellOperator(const Concat<KIND> &) { 308 return OperatorSpelling{"", "//", ""}; 309 } 310 template <int KIND> 311 static OperatorSpelling SpellOperator(const LogicalOperation<KIND> &x) { 312 return OperatorSpelling{"", AsFortran(x.logicalOperator), ""}; 313 } 314 template <typename T> 315 static OperatorSpelling SpellOperator(const Relational<T> &x) { 316 return OperatorSpelling{"", AsFortran(x.opr), ""}; 317 } 318 319 template <typename D, typename R, typename... O> 320 llvm::raw_ostream &Operation<D, R, O...>::AsFortran( 321 llvm::raw_ostream &o) const { 322 Precedence lhsPrec{ToPrecedence(left())}; 323 OperatorSpelling spelling{SpellOperator(derived())}; 324 o << spelling.prefix; 325 Precedence thisPrec{ToPrecedence(derived())}; 326 if constexpr (operands == 1) { 327 if (thisPrec != Precedence::Top && lhsPrec < thisPrec) { 328 left().AsFortran(o << '(') << ')'; 329 } else { 330 left().AsFortran(o); 331 } 332 } else { 333 if (thisPrec != Precedence::Top && 334 (lhsPrec < thisPrec || 335 (lhsPrec == Precedence::Power && thisPrec == Precedence::Power))) { 336 left().AsFortran(o << '(') << ')'; 337 } else { 338 left().AsFortran(o); 339 } 340 o << spelling.infix; 341 Precedence rhsPrec{ToPrecedence(right())}; 342 if (thisPrec != Precedence::Top && rhsPrec < thisPrec) { 343 right().AsFortran(o << '(') << ')'; 344 } else { 345 right().AsFortran(o); 346 } 347 } 348 return o << spelling.suffix; 349 } 350 351 template <typename TO, TypeCategory FROMCAT> 352 llvm::raw_ostream &Convert<TO, FROMCAT>::AsFortran(llvm::raw_ostream &o) const { 353 static_assert(TO::category == TypeCategory::Integer || 354 TO::category == TypeCategory::Real || 355 TO::category == TypeCategory::Complex || 356 TO::category == TypeCategory::Character || 357 TO::category == TypeCategory::Logical, 358 "Convert<> to bad category!"); 359 if constexpr (TO::category == TypeCategory::Character) { 360 this->left().AsFortran(o << "achar(iachar(") << ')'; 361 } else if constexpr (TO::category == TypeCategory::Integer) { 362 this->left().AsFortran(o << "int("); 363 } else if constexpr (TO::category == TypeCategory::Real) { 364 this->left().AsFortran(o << "real("); 365 } else if constexpr (TO::category == TypeCategory::Complex) { 366 this->left().AsFortran(o << "cmplx("); 367 } else { 368 this->left().AsFortran(o << "logical("); 369 } 370 return o << ",kind=" << TO::kind << ')'; 371 } 372 373 llvm::raw_ostream &Relational<SomeType>::AsFortran(llvm::raw_ostream &o) const { 374 std::visit([&](const auto &rel) { rel.AsFortran(o); }, u); 375 return o; 376 } 377 378 template <typename T> 379 llvm::raw_ostream &EmitArray(llvm::raw_ostream &o, const Expr<T> &expr) { 380 return expr.AsFortran(o); 381 } 382 383 template <typename T> 384 llvm::raw_ostream &EmitArray( 385 llvm::raw_ostream &, const ArrayConstructorValues<T> &); 386 387 template <typename T> 388 llvm::raw_ostream &EmitArray(llvm::raw_ostream &o, const ImpliedDo<T> &implDo) { 389 o << '('; 390 EmitArray(o, implDo.values()); 391 o << ',' << ImpliedDoIndex::Result::AsFortran() 392 << "::" << implDo.name().ToString() << '='; 393 implDo.lower().AsFortran(o) << ','; 394 implDo.upper().AsFortran(o) << ','; 395 implDo.stride().AsFortran(o) << ')'; 396 return o; 397 } 398 399 template <typename T> 400 llvm::raw_ostream &EmitArray( 401 llvm::raw_ostream &o, const ArrayConstructorValues<T> &values) { 402 const char *sep{""}; 403 for (const auto &value : values) { 404 o << sep; 405 std::visit([&](const auto &x) { EmitArray(o, x); }, value.u); 406 sep = ","; 407 } 408 return o; 409 } 410 411 template <typename T> 412 llvm::raw_ostream &ArrayConstructor<T>::AsFortran(llvm::raw_ostream &o) const { 413 o << '[' << GetType().AsFortran() << "::"; 414 EmitArray(o, *this); 415 return o << ']'; 416 } 417 418 template <int KIND> 419 llvm::raw_ostream & 420 ArrayConstructor<Type<TypeCategory::Character, KIND>>::AsFortran( 421 llvm::raw_ostream &o) const { 422 o << '[' << GetType().AsFortran(LEN().AsFortran()) << "::"; 423 EmitArray(o, *this); 424 return o << ']'; 425 } 426 427 llvm::raw_ostream &ArrayConstructor<SomeDerived>::AsFortran( 428 llvm::raw_ostream &o) const { 429 o << '[' << GetType().AsFortran() << "::"; 430 EmitArray(o, *this); 431 return o << ']'; 432 } 433 434 template <typename RESULT> 435 std::string ExpressionBase<RESULT>::AsFortran() const { 436 std::string buf; 437 llvm::raw_string_ostream ss{buf}; 438 AsFortran(ss); 439 return ss.str(); 440 } 441 442 template <typename RESULT> 443 llvm::raw_ostream &ExpressionBase<RESULT>::AsFortran( 444 llvm::raw_ostream &o) const { 445 std::visit(common::visitors{ 446 [&](const BOZLiteralConstant &x) { 447 o << "z'" << x.Hexadecimal() << "'"; 448 }, 449 [&](const NullPointer &) { o << "NULL()"; }, 450 [&](const common::CopyableIndirection<Substring> &s) { 451 s.value().AsFortran(o); 452 }, 453 [&](const ImpliedDoIndex &i) { o << i.name.ToString(); }, 454 [&](const auto &x) { x.AsFortran(o); }, 455 }, 456 derived().u); 457 return o; 458 } 459 460 llvm::raw_ostream &StructureConstructor::AsFortran(llvm::raw_ostream &o) const { 461 o << DerivedTypeSpecAsFortran(result_.derivedTypeSpec()); 462 if (values_.empty()) { 463 o << '('; 464 } else { 465 char ch{'('}; 466 for (const auto &[symbol, value] : values_) { 467 value.value().AsFortran(o << ch << symbol->name().ToString() << '='); 468 ch = ','; 469 } 470 } 471 return o << ')'; 472 } 473 474 std::string DynamicType::AsFortran() const { 475 if (derived_) { 476 CHECK(category_ == TypeCategory::Derived); 477 return DerivedTypeSpecAsFortran(*derived_); 478 } else if (charLengthParamValue_ || knownLength()) { 479 std::string result{"CHARACTER(KIND="s + std::to_string(kind_) + ",LEN="}; 480 if (knownLength()) { 481 result += std::to_string(*knownLength()) + "_8"; 482 } else if (charLengthParamValue_->isAssumed()) { 483 result += '*'; 484 } else if (charLengthParamValue_->isDeferred()) { 485 result += ':'; 486 } else if (const auto &length{charLengthParamValue_->GetExplicit()}) { 487 result += length->AsFortran(); 488 } 489 return result + ')'; 490 } else if (IsUnlimitedPolymorphic()) { 491 return "CLASS(*)"; 492 } else if (IsAssumedType()) { 493 return "TYPE(*)"; 494 } else if (IsTypelessIntrinsicArgument()) { 495 return "(typeless intrinsic function argument)"; 496 } else { 497 return parser::ToUpperCaseLetters(EnumToString(category_)) + '(' + 498 std::to_string(kind_) + ')'; 499 } 500 } 501 502 std::string DynamicType::AsFortran(std::string &&charLenExpr) const { 503 if (!charLenExpr.empty() && category_ == TypeCategory::Character) { 504 return "CHARACTER(KIND=" + std::to_string(kind_) + 505 ",LEN=" + std::move(charLenExpr) + ')'; 506 } else { 507 return AsFortran(); 508 } 509 } 510 511 std::string SomeDerived::AsFortran() const { 512 if (IsUnlimitedPolymorphic()) { 513 return "CLASS(*)"; 514 } else { 515 return "TYPE("s + DerivedTypeSpecAsFortran(derivedTypeSpec()) + ')'; 516 } 517 } 518 519 std::string DerivedTypeSpecAsFortran(const semantics::DerivedTypeSpec &spec) { 520 std::string buf; 521 llvm::raw_string_ostream ss{buf}; 522 ss << spec.name().ToString(); 523 char ch{'('}; 524 for (const auto &[name, value] : spec.parameters()) { 525 ss << ch << name.ToString() << '='; 526 ch = ','; 527 if (value.isAssumed()) { 528 ss << '*'; 529 } else if (value.isDeferred()) { 530 ss << ':'; 531 } else { 532 value.GetExplicit()->AsFortran(ss); 533 } 534 } 535 if (ch != '(') { 536 ss << ')'; 537 } 538 return ss.str(); 539 } 540 541 llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const Symbol &symbol) { 542 return o << symbol.name().ToString(); 543 } 544 545 llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::string &lit) { 546 return o << parser::QuoteCharacterLiteral(lit); 547 } 548 549 llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u16string &lit) { 550 return o << parser::QuoteCharacterLiteral(lit); 551 } 552 553 llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u32string &lit) { 554 return o << parser::QuoteCharacterLiteral(lit); 555 } 556 557 template <typename A> 558 llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const A &x) { 559 return x.AsFortran(o); 560 } 561 562 template <typename A> 563 llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, common::Reference<A> x) { 564 return EmitVar(o, *x); 565 } 566 567 template <typename A> 568 llvm::raw_ostream &EmitVar( 569 llvm::raw_ostream &o, const A *p, const char *kw = nullptr) { 570 if (p) { 571 if (kw) { 572 o << kw; 573 } 574 EmitVar(o, *p); 575 } 576 return o; 577 } 578 579 template <typename A> 580 llvm::raw_ostream &EmitVar( 581 llvm::raw_ostream &o, const std::optional<A> &x, const char *kw = nullptr) { 582 if (x) { 583 if (kw) { 584 o << kw; 585 } 586 EmitVar(o, *x); 587 } 588 return o; 589 } 590 591 template <typename A, bool COPY> 592 llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, 593 const common::Indirection<A, COPY> &p, const char *kw = nullptr) { 594 if (kw) { 595 o << kw; 596 } 597 EmitVar(o, p.value()); 598 return o; 599 } 600 601 template <typename A> 602 llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::shared_ptr<A> &p) { 603 CHECK(p); 604 return EmitVar(o, *p); 605 } 606 607 template <typename... A> 608 llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::variant<A...> &u) { 609 std::visit([&](const auto &x) { EmitVar(o, x); }, u); 610 return o; 611 } 612 613 llvm::raw_ostream &BaseObject::AsFortran(llvm::raw_ostream &o) const { 614 return EmitVar(o, u); 615 } 616 617 llvm::raw_ostream &TypeParamInquiry::AsFortran(llvm::raw_ostream &o) const { 618 if (base_) { 619 base_.value().AsFortran(o) << '%'; 620 } 621 return EmitVar(o, parameter_); 622 } 623 624 llvm::raw_ostream &Component::AsFortran(llvm::raw_ostream &o) const { 625 base_.value().AsFortran(o); 626 return EmitVar(o << '%', symbol_); 627 } 628 629 llvm::raw_ostream &NamedEntity::AsFortran(llvm::raw_ostream &o) const { 630 std::visit(common::visitors{ 631 [&](SymbolRef s) { EmitVar(o, s); }, 632 [&](const Component &c) { c.AsFortran(o); }, 633 }, 634 u_); 635 return o; 636 } 637 638 llvm::raw_ostream &Triplet::AsFortran(llvm::raw_ostream &o) const { 639 EmitVar(o, lower_) << ':'; 640 EmitVar(o, upper_); 641 EmitVar(o << ':', stride_.value()); 642 return o; 643 } 644 645 llvm::raw_ostream &Subscript::AsFortran(llvm::raw_ostream &o) const { 646 return EmitVar(o, u); 647 } 648 649 llvm::raw_ostream &ArrayRef::AsFortran(llvm::raw_ostream &o) const { 650 base_.AsFortran(o); 651 char separator{'('}; 652 for (const Subscript &ss : subscript_) { 653 ss.AsFortran(o << separator); 654 separator = ','; 655 } 656 return o << ')'; 657 } 658 659 llvm::raw_ostream &CoarrayRef::AsFortran(llvm::raw_ostream &o) const { 660 bool first{true}; 661 for (const Symbol &part : base_) { 662 if (first) { 663 first = false; 664 } else { 665 o << '%'; 666 } 667 EmitVar(o, part); 668 } 669 char separator{'('}; 670 for (const auto &sscript : subscript_) { 671 EmitVar(o << separator, sscript); 672 separator = ','; 673 } 674 if (separator == ',') { 675 o << ')'; 676 } 677 separator = '['; 678 for (const auto &css : cosubscript_) { 679 EmitVar(o << separator, css); 680 separator = ','; 681 } 682 if (stat_) { 683 EmitVar(o << separator, stat_, "STAT="); 684 separator = ','; 685 } 686 if (team_) { 687 EmitVar( 688 o << separator, team_, teamIsTeamNumber_ ? "TEAM_NUMBER=" : "TEAM="); 689 } 690 return o << ']'; 691 } 692 693 llvm::raw_ostream &DataRef::AsFortran(llvm::raw_ostream &o) const { 694 return EmitVar(o, u); 695 } 696 697 llvm::raw_ostream &Substring::AsFortran(llvm::raw_ostream &o) const { 698 EmitVar(o, parent_) << '('; 699 EmitVar(o, lower_) << ':'; 700 return EmitVar(o, upper_) << ')'; 701 } 702 703 llvm::raw_ostream &ComplexPart::AsFortran(llvm::raw_ostream &o) const { 704 return complex_.AsFortran(o) << '%' << EnumToString(part_); 705 } 706 707 llvm::raw_ostream &ProcedureDesignator::AsFortran(llvm::raw_ostream &o) const { 708 return EmitVar(o, u); 709 } 710 711 template <typename T> 712 llvm::raw_ostream &Designator<T>::AsFortran(llvm::raw_ostream &o) const { 713 std::visit(common::visitors{ 714 [&](SymbolRef symbol) { EmitVar(o, symbol); }, 715 [&](const auto &x) { x.AsFortran(o); }, 716 }, 717 u); 718 return o; 719 } 720 721 llvm::raw_ostream &DescriptorInquiry::AsFortran(llvm::raw_ostream &o) const { 722 switch (field_) { 723 case Field::LowerBound: 724 o << "lbound("; 725 break; 726 case Field::Extent: 727 o << "size("; 728 break; 729 case Field::Stride: 730 o << "%STRIDE("; 731 break; 732 case Field::Rank: 733 o << "rank("; 734 break; 735 case Field::Len: 736 break; 737 } 738 base_.AsFortran(o); 739 if (field_ == Field::Len) { 740 return o << "%len"; 741 } else { 742 if (field_ != Field::Rank && dimension_ >= 0) { 743 o << ",dim=" << (dimension_ + 1); 744 } 745 return o << ')'; 746 } 747 } 748 749 llvm::raw_ostream &Assignment::AsFortran(llvm::raw_ostream &o) const { 750 std::visit( 751 common::visitors{ 752 [&](const Assignment::Intrinsic &) { 753 rhs.AsFortran(lhs.AsFortran(o) << '='); 754 }, 755 [&](const ProcedureRef &proc) { proc.AsFortran(o << "CALL "); }, 756 [&](const BoundsSpec &bounds) { 757 lhs.AsFortran(o); 758 if (!bounds.empty()) { 759 char sep{'('}; 760 for (const auto &bound : bounds) { 761 bound.AsFortran(o << sep) << ':'; 762 sep = ','; 763 } 764 o << ')'; 765 } 766 rhs.AsFortran(o << " => "); 767 }, 768 [&](const BoundsRemapping &bounds) { 769 lhs.AsFortran(o); 770 if (!bounds.empty()) { 771 char sep{'('}; 772 for (const auto &bound : bounds) { 773 bound.first.AsFortran(o << sep) << ':'; 774 bound.second.AsFortran(o); 775 sep = ','; 776 } 777 o << ')'; 778 } 779 rhs.AsFortran(o << " => "); 780 }, 781 }, 782 u); 783 return o; 784 } 785 786 INSTANTIATE_CONSTANT_TEMPLATES 787 INSTANTIATE_EXPRESSION_TEMPLATES 788 INSTANTIATE_VARIABLE_TEMPLATES 789 } // namespace Fortran::evaluate 790