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