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