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