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