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