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