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