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