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
20namespace 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.
28static const bool printLbounds{false};
29
30static 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
54template <typename RESULT, typename VALUE>
55llvm::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
99template <int KIND>
100llvm::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
127llvm::raw_ostream &ActualArgument::AssumedType::AsFortran(
128 llvm::raw_ostream &o) const {
129 return o << symbol_->name().ToString();
130}
131
132llvm::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
156llvm::raw_ostream &SpecificIntrinsic::AsFortran(llvm::raw_ostream &o) const {
157 return o << name;
158}
159
160llvm::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
196enum 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
211template <typename A> constexpr Precedence ToPrecedence(const A &) {
212 return Precedence::Top;
213}
214template <int KIND>
215static 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}
229template <int KIND> constexpr Precedence ToPrecedence(const Not<KIND> &) {
230 return Precedence::Not;
231}
232template <typename T> constexpr Precedence ToPrecedence(const Relational<T> &) {
233 return Precedence::Relational;
234}
235template <typename T> constexpr Precedence ToPrecedence(const Add<T> &) {
236 return Precedence::Additive;
237}
238template <typename T> constexpr Precedence ToPrecedence(const Subtract<T> &) {
239 return Precedence::Additive;
240}
241template <int KIND> constexpr Precedence ToPrecedence(const Concat<KIND> &) {
242 return Precedence::Additive;
243}
244template <typename T> constexpr Precedence ToPrecedence(const Negate<T> &) {
245 return Precedence::Negate;
246}
247template <typename T> constexpr Precedence ToPrecedence(const Multiply<T> &) {
248 return Precedence::Multiplicative;
249}
250template <typename T> constexpr Precedence ToPrecedence(const Divide<T> &) {
251 return Precedence::Multiplicative;
252}
253template <typename T> constexpr Precedence ToPrecedence(const Power<T> &) {
254 return Precedence::Power;
255}
256template <typename T>
257constexpr Precedence ToPrecedence(const RealToIntPower<T> &) {
258 return Precedence::Power;
259}
260template <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}
271template <typename T> static Precedence ToPrecedence(const Expr<T> &expr) {
272 return common::visit([](const auto &x) { return ToPrecedence(x); }, expr.u);
273}
274
275template <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
285template <TypeCategory CAT>
286static bool IsNegatedScalarConstant(const Expr<SomeKind<CAT>> &expr) {
287 return common::visit(
288 [](const auto &x) { return IsNegatedScalarConstant(x); }, expr.u);
289}
290
291struct OperatorSpelling {
292 const char *prefix{""}, *infix{","}, *suffix{""};
293};
294
295template <typename A> constexpr OperatorSpelling SpellOperator(const A &) {
296 return OperatorSpelling{};
297}
298template <typename A>
299constexpr OperatorSpelling SpellOperator(const Negate<A> &) {
300 return OperatorSpelling{.prefix: "-", .infix: "", .suffix: ""};
301}
302template <typename A>
303constexpr OperatorSpelling SpellOperator(const Parentheses<A> &) {
304 return OperatorSpelling{.prefix: "(", .infix: "", .suffix: ")"};
305}
306template <int KIND>
307static OperatorSpelling SpellOperator(const ComplexComponent<KIND> &x) {
308 return {x.isImaginaryPart ? "aimag(" : "real(", "", ")"};
309}
310template <int KIND>
311constexpr OperatorSpelling SpellOperator(const Not<KIND> &) {
312 return OperatorSpelling{.prefix: ".NOT.", .infix: "", .suffix: ""};
313}
314template <int KIND>
315constexpr OperatorSpelling SpellOperator(const SetLength<KIND> &) {
316 return OperatorSpelling{.prefix: "%SET_LENGTH(", .infix: ",", .suffix: ")"};
317}
318template <int KIND>
319constexpr OperatorSpelling SpellOperator(const ComplexConstructor<KIND> &) {
320 return OperatorSpelling{.prefix: "(", .infix: ",", .suffix: ")"};
321}
322template <typename A> constexpr OperatorSpelling SpellOperator(const Add<A> &) {
323 return OperatorSpelling{.prefix: "", .infix: "+", .suffix: ""};
324}
325template <typename A>
326constexpr OperatorSpelling SpellOperator(const Subtract<A> &) {
327 return OperatorSpelling{.prefix: "", .infix: "-", .suffix: ""};
328}
329template <typename A>
330constexpr OperatorSpelling SpellOperator(const Multiply<A> &) {
331 return OperatorSpelling{.prefix: "", .infix: "*", .suffix: ""};
332}
333template <typename A>
334constexpr OperatorSpelling SpellOperator(const Divide<A> &) {
335 return OperatorSpelling{.prefix: "", .infix: "/", .suffix: ""};
336}
337template <typename A>
338constexpr OperatorSpelling SpellOperator(const Power<A> &) {
339 return OperatorSpelling{.prefix: "", .infix: "**", .suffix: ""};
340}
341template <typename A>
342constexpr OperatorSpelling SpellOperator(const RealToIntPower<A> &) {
343 return OperatorSpelling{.prefix: "", .infix: "**", .suffix: ""};
344}
345template <typename A>
346static OperatorSpelling SpellOperator(const Extremum<A> &x) {
347 return OperatorSpelling{
348 x.ordering == Ordering::Less ? "min(" : "max(", ",", ")"};
349}
350template <int KIND>
351constexpr OperatorSpelling SpellOperator(const Concat<KIND> &) {
352 return OperatorSpelling{.prefix: "", .infix: "//", .suffix: ""};
353}
354template <int KIND>
355static OperatorSpelling SpellOperator(const LogicalOperation<KIND> &x) {
356 return OperatorSpelling{"", AsFortran(x.logicalOperator), ""};
357}
358template <typename T>
359static OperatorSpelling SpellOperator(const Relational<T> &x) {
360 return OperatorSpelling{"", AsFortran(x.opr), ""};
361}
362
363template <typename D, typename R, typename... O>
364llvm::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
395template <typename TO, TypeCategory FROMCAT>
396llvm::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
417llvm::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
422template <typename T>
423llvm::raw_ostream &EmitArray(llvm::raw_ostream &o, const Expr<T> &expr) {
424 return expr.AsFortran(o);
425}
426
427template <typename T>
428llvm::raw_ostream &EmitArray(
429 llvm::raw_ostream &, const ArrayConstructorValues<T> &);
430
431template <typename T>
432llvm::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
443template <typename T>
444llvm::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
455template <typename T>
456llvm::raw_ostream &ArrayConstructor<T>::AsFortran(llvm::raw_ostream &o) const {
457 o << '[' << GetType().AsFortran() << "::";
458 EmitArray(o, *this);
459 return o << ']';
460}
461
462template <int KIND>
463llvm::raw_ostream &
464ArrayConstructor<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
474llvm::raw_ostream &ArrayConstructor<SomeDerived>::AsFortran(
475 llvm::raw_ostream &o) const {
476 o << '[' << GetType().AsFortran() << "::";
477 EmitArray(o, *this);
478 return o << ']';
479}
480
481template <typename RESULT>
482std::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
489template <typename RESULT>
490llvm::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
507llvm::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
522std::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 (IsUnlimitedPolymorphic()) {
543 return "CLASS(*)";
544 } else if (IsAssumedType()) {
545 return "TYPE(*)";
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
554std::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
563std::string SomeDerived::AsFortran() const {
564 if (IsUnlimitedPolymorphic()) {
565 return "CLASS(*)";
566 } else {
567 return "TYPE("s + DerivedTypeSpecAsFortran(derivedTypeSpec()) + ')';
568 }
569}
570
571std::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
594llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const Symbol &symbol) {
595 return o << symbol.name().ToString();
596}
597
598llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::string &lit) {
599 return o << parser::QuoteCharacterLiteral(lit);
600}
601
602llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u16string &lit) {
603 return o << parser::QuoteCharacterLiteral(lit);
604}
605
606llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u32string &lit) {
607 return o << parser::QuoteCharacterLiteral(lit);
608}
609
610template <typename A>
611llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const A &x) {
612 return x.AsFortran(o);
613}
614
615template <typename A>
616llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, common::Reference<A> x) {
617 return EmitVar(o, *x);
618}
619
620template <typename A>
621llvm::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
632template <typename A>
633llvm::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
644template <typename A, bool COPY>
645llvm::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
654template <typename A>
655llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::shared_ptr<A> &p) {
656 CHECK(p);
657 return EmitVar(o, *p);
658}
659
660template <typename... A>
661llvm::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
666llvm::raw_ostream &BaseObject::AsFortran(llvm::raw_ostream &o) const {
667 return EmitVar(o, u);
668}
669
670llvm::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
677llvm::raw_ostream &Component::AsFortran(llvm::raw_ostream &o) const {
678 base_.value().AsFortran(o);
679 return EmitVar(o << '%', symbol_);
680}
681
682llvm::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
691llvm::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
698llvm::raw_ostream &Subscript::AsFortran(llvm::raw_ostream &o) const {
699 return EmitVar(o, u);
700}
701
702llvm::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
712llvm::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
746llvm::raw_ostream &DataRef::AsFortran(llvm::raw_ostream &o) const {
747 return EmitVar(o, u);
748}
749
750llvm::raw_ostream &Substring::AsFortran(llvm::raw_ostream &o) const {
751 EmitVar(o, parent_) << '(';
752 EmitVar(o, lower_) << ':';
753 return EmitVar(o, upper_) << ')';
754}
755
756llvm::raw_ostream &ComplexPart::AsFortran(llvm::raw_ostream &o) const {
757 return complex_.AsFortran(o) << '%' << EnumToString(part_);
758}
759
760llvm::raw_ostream &ProcedureDesignator::AsFortran(llvm::raw_ostream &o) const {
761 return EmitVar(o, u);
762}
763
764template <typename T>
765llvm::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
774llvm::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
805llvm::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
845INSTANTIATE_CONSTANT_TEMPLATES
846INSTANTIATE_EXPRESSION_TEMPLATES
847INSTANTIATE_VARIABLE_TEMPLATES
848} // namespace Fortran::evaluate
849

source code of flang/lib/Evaluate/formatting.cpp