ae0d1d2e5c
Internal subprograms have explicit interfaces. If an internal subprogram has an alternate return, we check its explicit interface. But we were not putting the label values of alternate returns into the actual argument. I fixed this by changing the definition of actual arguments to be able to contain a common::Label and putting the label for an alternate return into the actual argument. I also verified that we were already doing all of the semantic checking required for alternate returns and removed a "TODO" for this. I also added the test altreturn06.f90. Differential Revision: https://reviews.llvm.org/D94017
788 lines
22 KiB
C++
788 lines
22 KiB
C++
//===-- 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 (charLength_) {
|
|
std::string result{"CHARACTER(KIND="s + std::to_string(kind_) + ",LEN="};
|
|
if (charLength_->isAssumed()) {
|
|
result += '*';
|
|
} else if (charLength_->isDeferred()) {
|
|
result += ':';
|
|
} else if (const auto &length{charLength_->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_) {
|
|
return base_->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 (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
|