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

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