xref: /llvm-project/flang/lib/Evaluate/formatting.cpp (revision 9ce8e63ceb447f7c2a0e92595466ed13a5acac48) 
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 ss.str();
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 ss.str();
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
856