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