| //===-- lib/Evaluate/formatting.cpp ---------------------------------------===// |
| // |
| // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
| // See https://llvm.org/LICENSE.txt for license information. |
| // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
| // |
| //===----------------------------------------------------------------------===// |
| |
| #include "flang/Evaluate/formatting.h" |
| #include "flang/Common/Fortran.h" |
| #include "flang/Evaluate/call.h" |
| #include "flang/Evaluate/constant.h" |
| #include "flang/Evaluate/expression.h" |
| #include "flang/Evaluate/fold.h" |
| #include "flang/Evaluate/tools.h" |
| #include "flang/Parser/characters.h" |
| #include "flang/Semantics/symbol.h" |
| #include "llvm/Support/raw_ostream.h" |
| |
| namespace Fortran::evaluate { |
| |
| static void ShapeAsFortran( |
| llvm::raw_ostream &o, const ConstantSubscripts &shape) { |
| if (GetRank(shape) > 1) { |
| o << ",shape="; |
| char ch{'['}; |
| for (auto dim : shape) { |
| o << ch << dim; |
| ch = ','; |
| } |
| o << "])"; |
| } |
| } |
| |
| template <typename RESULT, typename VALUE> |
| llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran( |
| llvm::raw_ostream &o) const { |
| if (Rank() > 1) { |
| o << "reshape("; |
| } |
| if (Rank() > 0) { |
| o << '[' << GetType().AsFortran() << "::"; |
| } |
| bool first{true}; |
| for (const auto &value : values_) { |
| if (first) { |
| first = false; |
| } else { |
| o << ','; |
| } |
| if constexpr (Result::category == TypeCategory::Integer) { |
| o << value.SignedDecimal() << '_' << Result::kind; |
| } else if constexpr (Result::category == TypeCategory::Real || |
| Result::category == TypeCategory::Complex) { |
| value.AsFortran(o, Result::kind); |
| } else if constexpr (Result::category == TypeCategory::Character) { |
| o << Result::kind << '_' << parser::QuoteCharacterLiteral(value, true); |
| } else if constexpr (Result::category == TypeCategory::Logical) { |
| if (value.IsTrue()) { |
| o << ".true."; |
| } else { |
| o << ".false."; |
| } |
| o << '_' << Result::kind; |
| } else { |
| StructureConstructor{result_.derivedTypeSpec(), value}.AsFortran(o); |
| } |
| } |
| if (Rank() > 0) { |
| o << ']'; |
| } |
| ShapeAsFortran(o, shape()); |
| return o; |
| } |
| |
| template <int KIND> |
| llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran( |
| llvm::raw_ostream &o) const { |
| if (Rank() > 1) { |
| o << "reshape("; |
| } |
| if (Rank() > 0) { |
| o << '[' << GetType().AsFortran(std::to_string(length_)) << "::"; |
| } |
| auto total{static_cast<ConstantSubscript>(size())}; |
| for (ConstantSubscript j{0}; j < total; ++j) { |
| Scalar<Result> value{values_.substr(j * length_, length_)}; |
| if (j > 0) { |
| o << ','; |
| } |
| if (Result::kind != 1) { |
| o << Result::kind << '_'; |
| } |
| o << parser::QuoteCharacterLiteral(value); |
| } |
| if (Rank() > 0) { |
| o << ']'; |
| } |
| ShapeAsFortran(o, shape()); |
| return o; |
| } |
| |
| llvm::raw_ostream &ActualArgument::AssumedType::AsFortran( |
| llvm::raw_ostream &o) const { |
| return o << symbol_->name().ToString(); |
| } |
| |
| llvm::raw_ostream &ActualArgument::AsFortran(llvm::raw_ostream &o) const { |
| if (keyword_) { |
| o << keyword_->ToString() << '='; |
| } |
| std::visit( |
| common::visitors{ |
| [&](const common::CopyableIndirection<Expr<SomeType>> &expr) { |
| expr.value().AsFortran(o); |
| }, |
| [&](const AssumedType &assumedType) { assumedType.AsFortran(o); }, |
| [&](const common::Label &label) { o << '*' << label; }, |
| }, |
| u_); |
| return o; |
| } |
| |
| llvm::raw_ostream &SpecificIntrinsic::AsFortran(llvm::raw_ostream &o) const { |
| return o << name; |
| } |
| |
| llvm::raw_ostream &ProcedureRef::AsFortran(llvm::raw_ostream &o) const { |
| for (const auto &arg : arguments_) { |
| if (arg && arg->isPassedObject()) { |
| arg->AsFortran(o) << '%'; |
| break; |
| } |
| } |
| proc_.AsFortran(o); |
| char separator{'('}; |
| for (const auto &arg : arguments_) { |
| if (arg && !arg->isPassedObject()) { |
| arg->AsFortran(o << separator); |
| separator = ','; |
| } |
| } |
| if (separator == '(') { |
| o << '('; |
| } |
| return o << ')'; |
| } |
| |
| // Operator precedence formatting; insert parentheses around operands |
| // only when necessary. |
| |
| enum class Precedence { // in increasing order for sane comparisons |
| DefinedBinary, |
| Or, |
| And, |
| Equivalence, // .EQV., .NEQV. |
| Not, // which binds *less* tightly in Fortran than relations |
| Relational, |
| Additive, // +, -, and (arbitrarily) // |
| Negate, // which binds *less* tightly than *, /, ** |
| Multiplicative, // *, / |
| Power, // **, which is right-associative unlike the other dyadic operators |
| DefinedUnary, |
| Top, |
| }; |
| |
| template <typename A> constexpr Precedence ToPrecedence(const A &) { |
| return Precedence::Top; |
| } |
| template <int KIND> |
| static Precedence ToPrecedence(const LogicalOperation<KIND> &x) { |
| switch (x.logicalOperator) { |
| SWITCH_COVERS_ALL_CASES |
| case LogicalOperator::And: |
| return Precedence::And; |
| case LogicalOperator::Or: |
| return Precedence::Or; |
| case LogicalOperator::Not: |
| return Precedence::Not; |
| case LogicalOperator::Eqv: |
| case LogicalOperator::Neqv: |
| return Precedence::Equivalence; |
| } |
| } |
| template <int KIND> constexpr Precedence ToPrecedence(const Not<KIND> &) { |
| return Precedence::Not; |
| } |
| template <typename T> constexpr Precedence ToPrecedence(const Relational<T> &) { |
| return Precedence::Relational; |
| } |
| template <typename T> constexpr Precedence ToPrecedence(const Add<T> &) { |
| return Precedence::Additive; |
| } |
| template <typename T> constexpr Precedence ToPrecedence(const Subtract<T> &) { |
| return Precedence::Additive; |
| } |
| template <int KIND> constexpr Precedence ToPrecedence(const Concat<KIND> &) { |
| return Precedence::Additive; |
| } |
| template <typename T> constexpr Precedence ToPrecedence(const Negate<T> &) { |
| return Precedence::Negate; |
| } |
| template <typename T> constexpr Precedence ToPrecedence(const Multiply<T> &) { |
| return Precedence::Multiplicative; |
| } |
| template <typename T> constexpr Precedence ToPrecedence(const Divide<T> &) { |
| return Precedence::Multiplicative; |
| } |
| template <typename T> constexpr Precedence ToPrecedence(const Power<T> &) { |
| return Precedence::Power; |
| } |
| template <typename T> |
| constexpr Precedence ToPrecedence(const RealToIntPower<T> &) { |
| return Precedence::Power; |
| } |
| template <typename T> static Precedence ToPrecedence(const Constant<T> &x) { |
| static constexpr TypeCategory cat{T::category}; |
| if constexpr (cat == TypeCategory::Integer || cat == TypeCategory::Real) { |
| if (auto n{GetScalarConstantValue<T>(x)}) { |
| if (n->IsNegative()) { |
| return Precedence::Negate; |
| } |
| } |
| } |
| return Precedence::Top; |
| } |
| template <typename T> static Precedence ToPrecedence(const Expr<T> &expr) { |
| return std::visit([](const auto &x) { return ToPrecedence(x); }, expr.u); |
| } |
| |
| template <typename T> static bool IsNegatedScalarConstant(const Expr<T> &expr) { |
| static constexpr TypeCategory cat{T::category}; |
| if constexpr (cat == TypeCategory::Integer || cat == TypeCategory::Real) { |
| if (auto n{GetScalarConstantValue<T>(expr)}) { |
| return n->IsNegative(); |
| } |
| } |
| return false; |
| } |
| |
| template <TypeCategory CAT> |
| static bool IsNegatedScalarConstant(const Expr<SomeKind<CAT>> &expr) { |
| return std::visit( |
| [](const auto &x) { return IsNegatedScalarConstant(x); }, expr.u); |
| } |
| |
| struct OperatorSpelling { |
| const char *prefix{""}, *infix{","}, *suffix{""}; |
| }; |
| |
| template <typename A> constexpr OperatorSpelling SpellOperator(const A &) { |
| return OperatorSpelling{}; |
| } |
| template <typename A> |
| constexpr OperatorSpelling SpellOperator(const Negate<A> &) { |
| return OperatorSpelling{"-", "", ""}; |
| } |
| template <typename A> |
| constexpr OperatorSpelling SpellOperator(const Parentheses<A> &) { |
| return OperatorSpelling{"(", "", ")"}; |
| } |
| template <int KIND> |
| static OperatorSpelling SpellOperator(const ComplexComponent<KIND> &x) { |
| return {x.isImaginaryPart ? "aimag(" : "real(", "", ")"}; |
| } |
| template <int KIND> |
| constexpr OperatorSpelling SpellOperator(const Not<KIND> &) { |
| return OperatorSpelling{".NOT.", "", ""}; |
| } |
| template <int KIND> |
| constexpr OperatorSpelling SpellOperator(const SetLength<KIND> &) { |
| return OperatorSpelling{"%SET_LENGTH(", ",", ")"}; |
| } |
| template <int KIND> |
| constexpr OperatorSpelling SpellOperator(const ComplexConstructor<KIND> &) { |
| return OperatorSpelling{"(", ",", ")"}; |
| } |
| template <typename A> constexpr OperatorSpelling SpellOperator(const Add<A> &) { |
| return OperatorSpelling{"", "+", ""}; |
| } |
| template <typename A> |
| constexpr OperatorSpelling SpellOperator(const Subtract<A> &) { |
| return OperatorSpelling{"", "-", ""}; |
| } |
| template <typename A> |
| constexpr OperatorSpelling SpellOperator(const Multiply<A> &) { |
| return OperatorSpelling{"", "*", ""}; |
| } |
| template <typename A> |
| constexpr OperatorSpelling SpellOperator(const Divide<A> &) { |
| return OperatorSpelling{"", "/", ""}; |
| } |
| template <typename A> |
| constexpr OperatorSpelling SpellOperator(const Power<A> &) { |
| return OperatorSpelling{"", "**", ""}; |
| } |
| template <typename A> |
| constexpr OperatorSpelling SpellOperator(const RealToIntPower<A> &) { |
| return OperatorSpelling{"", "**", ""}; |
| } |
| template <typename A> |
| static OperatorSpelling SpellOperator(const Extremum<A> &x) { |
| return OperatorSpelling{ |
| x.ordering == Ordering::Less ? "min(" : "max(", ",", ")"}; |
| } |
| template <int KIND> |
| constexpr OperatorSpelling SpellOperator(const Concat<KIND> &) { |
| return OperatorSpelling{"", "//", ""}; |
| } |
| template <int KIND> |
| static OperatorSpelling SpellOperator(const LogicalOperation<KIND> &x) { |
| return OperatorSpelling{"", AsFortran(x.logicalOperator), ""}; |
| } |
| template <typename T> |
| static OperatorSpelling SpellOperator(const Relational<T> &x) { |
| return OperatorSpelling{"", AsFortran(x.opr), ""}; |
| } |
| |
| template <typename D, typename R, typename... O> |
| llvm::raw_ostream &Operation<D, R, O...>::AsFortran( |
| llvm::raw_ostream &o) const { |
| Precedence lhsPrec{ToPrecedence(left())}; |
| OperatorSpelling spelling{SpellOperator(derived())}; |
| o << spelling.prefix; |
| Precedence thisPrec{ToPrecedence(derived())}; |
| if constexpr (operands == 1) { |
| if (thisPrec != Precedence::Top && lhsPrec < thisPrec) { |
| left().AsFortran(o << '(') << ')'; |
| } else { |
| left().AsFortran(o); |
| } |
| } else { |
| if (thisPrec != Precedence::Top && |
| (lhsPrec < thisPrec || |
| (lhsPrec == Precedence::Power && thisPrec == Precedence::Power))) { |
| left().AsFortran(o << '(') << ')'; |
| } else { |
| left().AsFortran(o); |
| } |
| o << spelling.infix; |
| Precedence rhsPrec{ToPrecedence(right())}; |
| if (thisPrec != Precedence::Top && rhsPrec < thisPrec) { |
| right().AsFortran(o << '(') << ')'; |
| } else { |
| right().AsFortran(o); |
| } |
| } |
| return o << spelling.suffix; |
| } |
| |
| template <typename TO, TypeCategory FROMCAT> |
| llvm::raw_ostream &Convert<TO, FROMCAT>::AsFortran(llvm::raw_ostream &o) const { |
| static_assert(TO::category == TypeCategory::Integer || |
| TO::category == TypeCategory::Real || |
| TO::category == TypeCategory::Complex || |
| TO::category == TypeCategory::Character || |
| TO::category == TypeCategory::Logical, |
| "Convert<> to bad category!"); |
| if constexpr (TO::category == TypeCategory::Character) { |
| this->left().AsFortran(o << "achar(iachar(") << ')'; |
| } else if constexpr (TO::category == TypeCategory::Integer) { |
| this->left().AsFortran(o << "int("); |
| } else if constexpr (TO::category == TypeCategory::Real) { |
| this->left().AsFortran(o << "real("); |
| } else if constexpr (TO::category == TypeCategory::Complex) { |
| this->left().AsFortran(o << "cmplx("); |
| } else { |
| this->left().AsFortran(o << "logical("); |
| } |
| return o << ",kind=" << TO::kind << ')'; |
| } |
| |
| llvm::raw_ostream &Relational<SomeType>::AsFortran(llvm::raw_ostream &o) const { |
| std::visit([&](const auto &rel) { rel.AsFortran(o); }, u); |
| return o; |
| } |
| |
| template <typename T> |
| llvm::raw_ostream &EmitArray(llvm::raw_ostream &o, const Expr<T> &expr) { |
| return expr.AsFortran(o); |
| } |
| |
| template <typename T> |
| llvm::raw_ostream &EmitArray( |
| llvm::raw_ostream &, const ArrayConstructorValues<T> &); |
| |
| template <typename T> |
| llvm::raw_ostream &EmitArray(llvm::raw_ostream &o, const ImpliedDo<T> &implDo) { |
| o << '('; |
| EmitArray(o, implDo.values()); |
| o << ',' << ImpliedDoIndex::Result::AsFortran() |
| << "::" << implDo.name().ToString() << '='; |
| implDo.lower().AsFortran(o) << ','; |
| implDo.upper().AsFortran(o) << ','; |
| implDo.stride().AsFortran(o) << ')'; |
| return o; |
| } |
| |
| template <typename T> |
| llvm::raw_ostream &EmitArray( |
| llvm::raw_ostream &o, const ArrayConstructorValues<T> &values) { |
| const char *sep{""}; |
| for (const auto &value : values) { |
| o << sep; |
| std::visit([&](const auto &x) { EmitArray(o, x); }, value.u); |
| sep = ","; |
| } |
| return o; |
| } |
| |
| template <typename T> |
| llvm::raw_ostream &ArrayConstructor<T>::AsFortran(llvm::raw_ostream &o) const { |
| o << '[' << GetType().AsFortran() << "::"; |
| EmitArray(o, *this); |
| return o << ']'; |
| } |
| |
| template <int KIND> |
| llvm::raw_ostream & |
| ArrayConstructor<Type<TypeCategory::Character, KIND>>::AsFortran( |
| llvm::raw_ostream &o) const { |
| o << '[' << GetType().AsFortran(LEN().AsFortran()) << "::"; |
| EmitArray(o, *this); |
| return o << ']'; |
| } |
| |
| llvm::raw_ostream &ArrayConstructor<SomeDerived>::AsFortran( |
| llvm::raw_ostream &o) const { |
| o << '[' << GetType().AsFortran() << "::"; |
| EmitArray(o, *this); |
| return o << ']'; |
| } |
| |
| template <typename RESULT> |
| std::string ExpressionBase<RESULT>::AsFortran() const { |
| std::string buf; |
| llvm::raw_string_ostream ss{buf}; |
| AsFortran(ss); |
| return ss.str(); |
| } |
| |
| template <typename RESULT> |
| llvm::raw_ostream &ExpressionBase<RESULT>::AsFortran( |
| llvm::raw_ostream &o) const { |
| std::visit(common::visitors{ |
| [&](const BOZLiteralConstant &x) { |
| o << "z'" << x.Hexadecimal() << "'"; |
| }, |
| [&](const NullPointer &) { o << "NULL()"; }, |
| [&](const common::CopyableIndirection<Substring> &s) { |
| s.value().AsFortran(o); |
| }, |
| [&](const ImpliedDoIndex &i) { o << i.name.ToString(); }, |
| [&](const auto &x) { x.AsFortran(o); }, |
| }, |
| derived().u); |
| return o; |
| } |
| |
| llvm::raw_ostream &StructureConstructor::AsFortran(llvm::raw_ostream &o) const { |
| o << DerivedTypeSpecAsFortran(result_.derivedTypeSpec()); |
| if (values_.empty()) { |
| o << '('; |
| } else { |
| char ch{'('}; |
| for (const auto &[symbol, value] : values_) { |
| value.value().AsFortran(o << ch << symbol->name().ToString() << '='); |
| ch = ','; |
| } |
| } |
| return o << ')'; |
| } |
| |
| std::string DynamicType::AsFortran() const { |
| if (derived_) { |
| CHECK(category_ == TypeCategory::Derived); |
| return DerivedTypeSpecAsFortran(*derived_); |
| } else if (charLengthParamValue_ || knownLength()) { |
| std::string result{"CHARACTER(KIND="s + std::to_string(kind_) + ",LEN="}; |
| if (knownLength()) { |
| result += std::to_string(*knownLength()) + "_8"; |
| } else if (charLengthParamValue_->isAssumed()) { |
| result += '*'; |
| } else if (charLengthParamValue_->isDeferred()) { |
| result += ':'; |
| } else if (const auto &length{charLengthParamValue_->GetExplicit()}) { |
| result += length->AsFortran(); |
| } |
| return result + ')'; |
| } else if (IsUnlimitedPolymorphic()) { |
| return "CLASS(*)"; |
| } else if (IsAssumedType()) { |
| return "TYPE(*)"; |
| } else if (IsTypelessIntrinsicArgument()) { |
| return "(typeless intrinsic function argument)"; |
| } else { |
| return parser::ToUpperCaseLetters(EnumToString(category_)) + '(' + |
| std::to_string(kind_) + ')'; |
| } |
| } |
| |
| std::string DynamicType::AsFortran(std::string &&charLenExpr) const { |
| if (!charLenExpr.empty() && category_ == TypeCategory::Character) { |
| return "CHARACTER(KIND=" + std::to_string(kind_) + |
| ",LEN=" + std::move(charLenExpr) + ')'; |
| } else { |
| return AsFortran(); |
| } |
| } |
| |
| std::string SomeDerived::AsFortran() const { |
| if (IsUnlimitedPolymorphic()) { |
| return "CLASS(*)"; |
| } else { |
| return "TYPE("s + DerivedTypeSpecAsFortran(derivedTypeSpec()) + ')'; |
| } |
| } |
| |
| std::string DerivedTypeSpecAsFortran(const semantics::DerivedTypeSpec &spec) { |
| std::string buf; |
| llvm::raw_string_ostream ss{buf}; |
| ss << spec.name().ToString(); |
| char ch{'('}; |
| for (const auto &[name, value] : spec.parameters()) { |
| ss << ch << name.ToString() << '='; |
| ch = ','; |
| if (value.isAssumed()) { |
| ss << '*'; |
| } else if (value.isDeferred()) { |
| ss << ':'; |
| } else { |
| value.GetExplicit()->AsFortran(ss); |
| } |
| } |
| if (ch != '(') { |
| ss << ')'; |
| } |
| return ss.str(); |
| } |
| |
| llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const Symbol &symbol) { |
| return o << symbol.name().ToString(); |
| } |
| |
| llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::string &lit) { |
| return o << parser::QuoteCharacterLiteral(lit); |
| } |
| |
| llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u16string &lit) { |
| return o << parser::QuoteCharacterLiteral(lit); |
| } |
| |
| llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u32string &lit) { |
| return o << parser::QuoteCharacterLiteral(lit); |
| } |
| |
| template <typename A> |
| llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const A &x) { |
| return x.AsFortran(o); |
| } |
| |
| template <typename A> |
| llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, common::Reference<A> x) { |
| return EmitVar(o, *x); |
| } |
| |
| template <typename A> |
| llvm::raw_ostream &EmitVar( |
| llvm::raw_ostream &o, const A *p, const char *kw = nullptr) { |
| if (p) { |
| if (kw) { |
| o << kw; |
| } |
| EmitVar(o, *p); |
| } |
| return o; |
| } |
| |
| template <typename A> |
| llvm::raw_ostream &EmitVar( |
| llvm::raw_ostream &o, const std::optional<A> &x, const char *kw = nullptr) { |
| if (x) { |
| if (kw) { |
| o << kw; |
| } |
| EmitVar(o, *x); |
| } |
| return o; |
| } |
| |
| template <typename A, bool COPY> |
| llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, |
| const common::Indirection<A, COPY> &p, const char *kw = nullptr) { |
| if (kw) { |
| o << kw; |
| } |
| EmitVar(o, p.value()); |
| return o; |
| } |
| |
| template <typename A> |
| llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::shared_ptr<A> &p) { |
| CHECK(p); |
| return EmitVar(o, *p); |
| } |
| |
| template <typename... A> |
| llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::variant<A...> &u) { |
| std::visit([&](const auto &x) { EmitVar(o, x); }, u); |
| return o; |
| } |
| |
| llvm::raw_ostream &BaseObject::AsFortran(llvm::raw_ostream &o) const { |
| return EmitVar(o, u); |
| } |
| |
| llvm::raw_ostream &TypeParamInquiry::AsFortran(llvm::raw_ostream &o) const { |
| if (base_) { |
| base_.value().AsFortran(o) << '%'; |
| } |
| return EmitVar(o, parameter_); |
| } |
| |
| llvm::raw_ostream &Component::AsFortran(llvm::raw_ostream &o) const { |
| base_.value().AsFortran(o); |
| return EmitVar(o << '%', symbol_); |
| } |
| |
| llvm::raw_ostream &NamedEntity::AsFortran(llvm::raw_ostream &o) const { |
| std::visit(common::visitors{ |
| [&](SymbolRef s) { EmitVar(o, s); }, |
| [&](const Component &c) { c.AsFortran(o); }, |
| }, |
| u_); |
| return o; |
| } |
| |
| llvm::raw_ostream &Triplet::AsFortran(llvm::raw_ostream &o) const { |
| EmitVar(o, lower_) << ':'; |
| EmitVar(o, upper_); |
| EmitVar(o << ':', stride_.value()); |
| return o; |
| } |
| |
| llvm::raw_ostream &Subscript::AsFortran(llvm::raw_ostream &o) const { |
| return EmitVar(o, u); |
| } |
| |
| llvm::raw_ostream &ArrayRef::AsFortran(llvm::raw_ostream &o) const { |
| base_.AsFortran(o); |
| char separator{'('}; |
| for (const Subscript &ss : subscript_) { |
| ss.AsFortran(o << separator); |
| separator = ','; |
| } |
| return o << ')'; |
| } |
| |
| llvm::raw_ostream &CoarrayRef::AsFortran(llvm::raw_ostream &o) const { |
| bool first{true}; |
| for (const Symbol &part : base_) { |
| if (first) { |
| first = false; |
| } else { |
| o << '%'; |
| } |
| EmitVar(o, part); |
| } |
| char separator{'('}; |
| for (const auto &sscript : subscript_) { |
| EmitVar(o << separator, sscript); |
| separator = ','; |
| } |
| if (separator == ',') { |
| o << ')'; |
| } |
| separator = '['; |
| for (const auto &css : cosubscript_) { |
| EmitVar(o << separator, css); |
| separator = ','; |
| } |
| if (stat_) { |
| EmitVar(o << separator, stat_, "STAT="); |
| separator = ','; |
| } |
| if (team_) { |
| EmitVar( |
| o << separator, team_, teamIsTeamNumber_ ? "TEAM_NUMBER=" : "TEAM="); |
| } |
| return o << ']'; |
| } |
| |
| llvm::raw_ostream &DataRef::AsFortran(llvm::raw_ostream &o) const { |
| return EmitVar(o, u); |
| } |
| |
| llvm::raw_ostream &Substring::AsFortran(llvm::raw_ostream &o) const { |
| EmitVar(o, parent_) << '('; |
| EmitVar(o, lower_) << ':'; |
| return EmitVar(o, upper_) << ')'; |
| } |
| |
| llvm::raw_ostream &ComplexPart::AsFortran(llvm::raw_ostream &o) const { |
| return complex_.AsFortran(o) << '%' << EnumToString(part_); |
| } |
| |
| llvm::raw_ostream &ProcedureDesignator::AsFortran(llvm::raw_ostream &o) const { |
| return EmitVar(o, u); |
| } |
| |
| template <typename T> |
| llvm::raw_ostream &Designator<T>::AsFortran(llvm::raw_ostream &o) const { |
| std::visit(common::visitors{ |
| [&](SymbolRef symbol) { EmitVar(o, symbol); }, |
| [&](const auto &x) { x.AsFortran(o); }, |
| }, |
| u); |
| return o; |
| } |
| |
| llvm::raw_ostream &DescriptorInquiry::AsFortran(llvm::raw_ostream &o) const { |
| switch (field_) { |
| case Field::LowerBound: |
| o << "lbound("; |
| break; |
| case Field::Extent: |
| o << "size("; |
| break; |
| case Field::Stride: |
| o << "%STRIDE("; |
| break; |
| case Field::Rank: |
| o << "rank("; |
| break; |
| case Field::Len: |
| break; |
| } |
| base_.AsFortran(o); |
| if (field_ == Field::Len) { |
| return o << "%len"; |
| } else { |
| if (field_ != Field::Rank && dimension_ >= 0) { |
| o << ",dim=" << (dimension_ + 1); |
| } |
| return o << ')'; |
| } |
| } |
| |
| llvm::raw_ostream &Assignment::AsFortran(llvm::raw_ostream &o) const { |
| std::visit( |
| common::visitors{ |
| [&](const Assignment::Intrinsic &) { |
| rhs.AsFortran(lhs.AsFortran(o) << '='); |
| }, |
| [&](const ProcedureRef &proc) { proc.AsFortran(o << "CALL "); }, |
| [&](const BoundsSpec &bounds) { |
| lhs.AsFortran(o); |
| if (!bounds.empty()) { |
| char sep{'('}; |
| for (const auto &bound : bounds) { |
| bound.AsFortran(o << sep) << ':'; |
| sep = ','; |
| } |
| o << ')'; |
| } |
| rhs.AsFortran(o << " => "); |
| }, |
| [&](const BoundsRemapping &bounds) { |
| lhs.AsFortran(o); |
| if (!bounds.empty()) { |
| char sep{'('}; |
| for (const auto &bound : bounds) { |
| bound.first.AsFortran(o << sep) << ':'; |
| bound.second.AsFortran(o); |
| sep = ','; |
| } |
| o << ')'; |
| } |
| rhs.AsFortran(o << " => "); |
| }, |
| }, |
| u); |
| return o; |
| } |
| |
| INSTANTIATE_CONSTANT_TEMPLATES |
| INSTANTIATE_EXPRESSION_TEMPLATES |
| INSTANTIATE_VARIABLE_TEMPLATES |
| } // namespace Fortran::evaluate |