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