flang/lib/Evaluate/formatting.cpp

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