llvm/flang/lib/parser/unparse.cc
peter klausler 79d044e9b5 [flang] Take flang-compiler/f18#2 on unparsing, now using the new parse tree walker.
Clean out old data structure formatter.

Create stand-alone Parsing class to compose parts of the parser together.

Hello, world!

Better error recovery on command line errors.

Fix bugs from initial run at f77_correct.

Allow parentheses on PROGRAM statement.

Fix Hollerith scanning.

Remove REDIMENSION with good error recovery.

Fix new "spaces" parser, clean up calls to it.

Fix bugs exposed by in38.f90.

Escaped \a is not special to pgf90; get slashes around STRUCTURE name right.

Better multi-byte source encoding support in Hollerith.

Reformat C++.

More work on multi-byte source encoding.

Pass 219 tests in f77_correct, with good excuses for the rest.

Original-commit: flang-compiler/f18@8a1a0aa2dc
Reviewed-on: https://github.com/flang-compiler/f18/pull/25
Tree-same-pre-rewrite: false
2018-03-13 16:32:09 -07:00

2059 lines
64 KiB
C++

// Generates Fortran from the content of a parse tree, using the
// traversal templates in parse-tree-visitor.h.
#include "unparse.h"
#include "characters.h"
#include "idioms.h"
#include "indirection.h"
#include "parse-tree-visitor.h"
#include "parse-tree.h"
#include <algorithm>
namespace Fortran {
namespace parser {
class UnparseVisitor {
public:
UnparseVisitor(std::ostream &out, int indentationAmount, Encoding encoding)
: out_{out}, indentationAmount_{indentationAmount}, encoding_{encoding} {}
// Default actions: just traverse the children
template<typename T> bool Pre(const T &x) { return true; }
template<typename T> void Post(const T &) {}
// Emit simple types as-is.
bool Pre(const std::string &x) {
Put(x);
return false;
}
bool Pre(int x) {
Put(std::to_string(x));
return false;
}
bool Pre(std::uint64_t x) {
Put(std::to_string(x));
return false;
}
bool Pre(std::int64_t x) {
Put(std::to_string(x));
return false;
}
bool Pre(char x) {
Put(x);
return false;
}
// Statement labels and ends of lines
template<typename T> bool Pre(const Statement<T> &x) {
Walk(x.label, " ");
return true;
}
template<typename T> void Post(const Statement<T> &) { Put('\n'); }
// The special-case formatting functions for these productions are
// ordered to correspond roughly to their order of appearance in
// the Fortran 2018 standard (and parse-tree.h).
void Post(const ProgramUnit &x) { // R502, R503
out_ << '\n'; // blank line after each ProgramUnit
}
bool Pre(const DefinedOperator::IntrinsicOperator &x) { // R608
switch (x) {
case DefinedOperator::IntrinsicOperator::Power: Put("**"); break;
case DefinedOperator::IntrinsicOperator::Multiply: Put('*'); break;
case DefinedOperator::IntrinsicOperator::Divide: Put('/'); break;
case DefinedOperator::IntrinsicOperator::Add: Put('+'); break;
case DefinedOperator::IntrinsicOperator::Subtract: Put('-'); break;
case DefinedOperator::IntrinsicOperator::Concat: Put("//"); break;
case DefinedOperator::IntrinsicOperator::LT: Put('<'); break;
case DefinedOperator::IntrinsicOperator::LE: Put("<="); break;
case DefinedOperator::IntrinsicOperator::EQ: Put("=="); break;
case DefinedOperator::IntrinsicOperator::NE: Put("/="); break;
case DefinedOperator::IntrinsicOperator::GE: Put(">="); break;
case DefinedOperator::IntrinsicOperator::GT: Put('>'); break;
default:
PutEnum(static_cast<int>(x), DefinedOperator::IntrinsicOperatorAsString);
}
return false;
}
void Post(const Star &) { Put('*'); } // R701 &c.
void Post(const TypeParamValue::Deferred &) { Put(':'); } // R701
bool Pre(const DeclarationTypeSpec::Type &x) { // R703
Put("TYPE("), Walk(x.derived), Put(')');
return false;
}
bool Pre(const DeclarationTypeSpec::Class &x) {
Put("CLASS("), Walk(x.derived), Put(')');
return false;
}
void Post(const DeclarationTypeSpec::ClassStar &) { Put("CLASS(*)"); }
void Post(const DeclarationTypeSpec::TypeStar &) { Put("TYPE(*)"); }
bool Pre(const DeclarationTypeSpec::Record &x) {
Put("RECORD /"), Walk(x.v), Put('/');
return false;
}
bool Pre(const IntrinsicTypeSpec::Real &x) { // R704
Put("REAL");
return true;
}
bool Pre(const IntrinsicTypeSpec::Complex &x) {
Put("COMPLEX");
return true;
}
void Post(const IntrinsicTypeSpec::DoublePrecision &) {
Put("DOUBLE PRECISION");
}
bool Pre(const IntrinsicTypeSpec::Character &x) {
Put("CHARACTER");
return true;
}
bool Pre(const IntrinsicTypeSpec::Logical &x) {
Put("LOGICAL");
return true;
}
void Post(const IntrinsicTypeSpec::DoubleComplex &) { Put("DOUBLE COMPLEX"); }
bool Pre(const IntrinsicTypeSpec::NCharacter &x) {
Put("NCHARACTER");
return true;
}
bool Pre(const IntegerTypeSpec &x) { // R705
Put("INTEGER");
return true;
}
bool Pre(const KindSelector &x) { // R706
std::visit(
visitors{[&](const ScalarIntConstantExpr &y) {
Put("(KIND="), Walk(y), Put(')');
},
[&](const KindSelector::StarSize &y) { Put('*'), Walk(y.v); }},
x.u);
return false;
}
bool Pre(const SignedIntLiteralConstant &x) { // R707
Walk(std::get<std::int64_t>(x.t));
Walk("_", std::get<std::optional<KindParam>>(x.t));
return false;
}
bool Pre(const IntLiteralConstant &x) { // R708
Walk(std::get<std::uint64_t>(x.t));
Walk("_", std::get<std::optional<KindParam>>(x.t));
return false;
}
bool Pre(const Sign &x) { // R712
Put(x == Sign::Negative ? '-' : '+');
return false;
}
bool Pre(const RealLiteralConstant &x) { // R714, R715
Put(x.intPart), Put('.'), Put(x.fraction), Walk(x.exponent);
Walk("_", x.kind);
return false;
}
bool Pre(const ComplexLiteralConstant &x) { // R718 - R720
Put('('), Walk(x.t, ","), Put(')');
return false;
}
bool Pre(const CharSelector::LengthAndKind &x) { // R721
Put("(KIND="), Walk(x.kind), Walk(", LEN=", x.length), Put(')');
return false;
}
bool Pre(const LengthSelector &x) { // R722
std::visit(visitors{[&](const TypeParamValue &y) {
Put("(LEN="), Walk(y), Put(')');
},
[&](const CharLength &y) { Put('*'), Walk(y); }},
x.u);
return false;
}
bool Pre(const CharLength &x) { // R723
std::visit(
visitors{[&](const TypeParamValue &y) { Put('('), Walk(y), Put(')'); },
[&](const std::int64_t &y) { Walk(y); }},
x.u);
return false;
}
bool Pre(const CharLiteralConstant &x) { // R724
if (const auto &k = std::get<std::optional<KindParam>>(x.t)) {
if (std::holds_alternative<KindParam::Kanji>(k->u)) {
Put("NC");
} else {
Walk(*k), Put('_');
}
}
PutQuoted(std::get<std::string>(x.t));
return false;
}
bool Pre(const HollerithLiteralConstant &x) {
std::optional<size_t> chars{CountCharacters(x.v.data(), x.v.size(),
encoding_ == Encoding::EUC_JP ? EUC_JPCharacterBytes
: UTF8CharacterBytes)};
if (chars.has_value()) {
Pre(*chars);
} else {
Pre(x.v.size());
}
Put('H');
return true;
}
bool Pre(const LogicalLiteralConstant &x) { // R725
Put(x.v ? ".TRUE." : ".FALSE.");
return false;
}
bool Pre(const DerivedTypeStmt &x) { // R727
Put("TYPE"), Walk(", ", std::get<std::list<TypeAttrSpec>>(x.t), ", ");
Put(" :: "), Put(std::get<Name>(x.t));
Walk("(", std::get<std::list<Name>>(x.t), ", ", ")");
Indent();
return false;
}
bool Pre(const Abstract &x) { // R728, &c.
Put("ABSTRACT");
return false;
}
bool Pre(const TypeAttrSpec::BindC &x) {
Put("BIND(C)");
return false;
}
bool Pre(const TypeAttrSpec::Extends &x) {
Put("EXTENDS("), Walk(x.v), Put(')');
return false;
}
void Post(const EndTypeStmt &) { // R730
Outdent();
Put("END TYPE");
}
bool Pre(const SequenceStmt &x) { // R731
Put("SEQUENCE");
return false;
}
bool Pre(const TypeParamDefStmt &x) { // R732
Walk(std::get<IntegerTypeSpec>(x.t));
Put(", "), Walk(std::get<TypeParamDefStmt::KindOrLen>(x.t));
Put(" :: "), Walk(std::get<std::list<TypeParamDecl>>(x.t), ", ");
return false;
}
bool Pre(const TypeParamDecl &x) { // R733
Put(std::get<Name>(x.t));
Walk("=", std::get<std::optional<ScalarIntConstantExpr>>(x.t));
return false;
}
bool Pre(const DataComponentDefStmt &x) { // R737
const auto &dts = std::get<DeclarationTypeSpec>(x.t);
const auto &attrs = std::get<std::list<ComponentAttrSpec>>(x.t);
const auto &decls = std::get<std::list<ComponentDecl>>(x.t);
Walk(dts), Walk(", ", attrs, ", ");
if (!attrs.empty() ||
(!std::holds_alternative<DeclarationTypeSpec::Record>(dts.u) &&
std::none_of(
decls.begin(), decls.end(), [](const ComponentDecl &d) {
const auto &init =
std::get<std::optional<Initialization>>(d.t);
return init.has_value() &&
std::holds_alternative<
std::list<Indirection<DataStmtValue>>>(init->u);
}))) {
Put(" ::");
}
Put(' '), Walk(decls, ", ");
return false;
}
bool Pre(const Allocatable &x) { // R738
Put("ALLOCATABLE");
return false;
}
bool Pre(const Pointer &x) {
Put("POINTER");
return false;
}
bool Pre(const Contiguous &x) {
Put("CONTIGUOUS");
return false;
}
bool Pre(const ComponentAttrSpec &x) {
std::visit(visitors{[&](const CoarraySpec &) { Put("CODIMENSION["); },
[&](const ComponentArraySpec &) { Put("DIMENSION("); },
[&](const auto &) {}},
x.u);
return true;
}
void Post(const ComponentAttrSpec &x) {
std::visit(visitors{[&](const CoarraySpec &) { Put(']'); },
[&](const ComponentArraySpec &) { Put(')'); },
[&](const auto &) {}},
x.u);
}
bool Pre(const ComponentDecl &x) { // R739
Walk(std::get<ObjectName>(x.t));
Walk("(", std::get<std::optional<ComponentArraySpec>>(x.t), ")");
Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]");
Walk("*", std::get<std::optional<CharLength>>(x.t));
Walk(std::get<std::optional<Initialization>>(x.t));
return false;
}
bool Pre(const ComponentArraySpec &x) { // R740
std::visit(
visitors{[&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
[&](const DeferredShapeSpecList &y) { Walk(y); }},
x.u);
return false;
}
bool Pre(const ProcComponentDefStmt &x) { // R741
Put("PROCEDURE(");
Walk(std::get<std::optional<ProcInterface>>(x.t)), Put(')');
Walk(", ", std::get<std::list<ProcComponentAttrSpec>>(x.t), ", ");
Put(" :: "), Walk(std::get<std::list<ProcDecl>>(x.t), ", ");
return false;
}
bool Pre(const NoPass &x) { // R742
Put("NOPASS");
return false;
}
bool Pre(const Pass &x) {
Put("PASS"), Walk("(", x.v, ")");
return false;
}
bool Pre(const Initialization &x) { // R743 & R805
std::visit(visitors{[&](const ConstantExpr &y) { Put(" = "), Walk(y); },
[&](const NullInit &y) { Put(" => "), Walk(y); },
[&](const InitialDataTarget &y) { Put(" => "), Walk(y); },
[&](const std::list<Indirection<DataStmtValue>> &y) {
Walk("/", y, ", ", "/");
}},
x.u);
return false;
}
bool Pre(const PrivateStmt &x) { // R745
Put("PRIVATE");
return false;
}
bool Pre(const TypeBoundProcedureStmt::WithoutInterface &x) { // R749
Put("PROCEDURE"), Walk(", ", x.attributes, ", ");
Put(" :: "), Walk(x.declarations);
return false;
}
bool Pre(const TypeBoundProcedureStmt::WithInterface &x) {
Put("PROCEDURE("), Walk(x.interfaceName), Put("), ");
Walk(x.attributes);
Put(" :: "), Walk(x.bindingNames);
return false;
}
bool Pre(const TypeBoundProcDecl &x) { // R750
Walk(std::get<Name>(x.t));
Walk(" => ", std::get<std::optional<Name>>(x.t));
return false;
}
bool Pre(const TypeBoundGenericStmt &x) { // R751
Put("GENERIC"), Walk(", ", std::get<std::optional<AccessSpec>>(x.t));
Put(" :: "), Walk(std::get<Indirection<GenericSpec>>(x.t));
Put(" => "), Walk(std::get<std::list<Name>>(x.t), ", ");
return false;
}
void Post(const BindAttr::Deferred &) { Put("DEFERRED"); } // R752
void Post(const BindAttr::Non_Overridable &) { Put("NON_OVERRIDABLE"); }
void Post(const FinalProcedureStmt &) { Put("FINAL :: "); } // R753
bool Pre(const DerivedTypeSpec &x) { // R754
Walk(std::get<Name>(x.t));
Walk("(", std::get<std::list<TypeParamSpec>>(x.t), ",", ")");
return false;
}
bool Pre(const TypeParamSpec &x) { // R755
Walk(std::get<std::optional<Keyword>>(x.t), "=");
Walk(std::get<TypeParamValue>(x.t));
return false;
}
bool Pre(const StructureConstructor &x) { // R756
Walk(std::get<DerivedTypeSpec>(x.t));
Put('('), Walk(std::get<std::list<ComponentSpec>>(x.t), ", "), Put(')');
return false;
}
bool Pre(const ComponentSpec &x) { // R757
Walk(std::get<std::optional<Keyword>>(x.t), "=");
Walk(std::get<ComponentDataSource>(x.t));
return false;
}
bool Pre(const EnumDefStmt &) { // R760
Put("ENUM, BIND(C)");
Indent();
return false;
}
bool Pre(const EnumeratorDefStmt &) { // R761
Put("ENUMERATOR :: ");
return true;
}
bool Pre(const Enumerator &x) { // R762
Walk(std::get<NamedConstant>(x.t));
Walk(" = ", std::get<std::optional<ScalarIntConstantExpr>>(x.t));
return false;
}
void Post(const EndEnumStmt &) { // R763
Outdent();
Put("END ENUM");
}
bool Pre(const BOZLiteralConstant &x) { // R764 - R767
Put("Z'");
out_ << std::hex << x.v << std::dec << '\'';
return false;
}
bool Pre(const AcValue::Triplet &x) { // R773
Walk(std::get<0>(x.t)), Put(':'), Walk(std::get<1>(x.t));
Walk(":", std::get<std::optional<ScalarIntExpr>>(x.t));
return false;
}
bool Pre(const ArrayConstructor &x) { // R769
Put('['), Walk(x.v), Put(']');
return false;
}
bool Pre(const AcSpec &x) { // R770
Walk(x.type, "::"), Walk(x.values, ", ");
return false;
}
template<typename A> bool Pre(const LoopBounds<A> &x) {
Walk(x.name), Put('='), Walk(x.lower), Put(','), Walk(x.upper);
Walk(",", x.step);
return false;
}
bool Pre(const AcImpliedDoControl &x) { // R775
Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::");
Walk(std::get<LoopBounds<ScalarIntExpr>>(x.t));
return false;
}
bool Pre(const TypeDeclarationStmt &x) { // R801
const auto &dts = std::get<DeclarationTypeSpec>(x.t);
const auto &attrs = std::get<std::list<AttrSpec>>(x.t);
const auto &decls = std::get<std::list<EntityDecl>>(x.t);
Walk(dts), Walk(", ", attrs, ", ");
if (!attrs.empty() ||
(!std::holds_alternative<DeclarationTypeSpec::Record>(dts.u) &&
std::none_of(decls.begin(), decls.end(), [](const EntityDecl &d) {
const auto &init = std::get<std::optional<Initialization>>(d.t);
return init.has_value() &&
std::holds_alternative<std::list<Indirection<DataStmtValue>>>(
init->u);
}))) {
Put(" ::");
}
Put(' '), Walk(std::get<std::list<EntityDecl>>(x.t), ", ");
return false;
}
bool Pre(const EntityDecl &x) { // R803
Walk(std::get<ObjectName>(x.t));
Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")");
Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]");
Walk("*", std::get<std::optional<CharLength>>(x.t));
Walk(std::get<std::optional<Initialization>>(x.t));
return false;
}
bool Pre(const NullInit &x) { // R806
Put("NULL()");
return false;
}
bool Pre(const LanguageBindingSpec &x) { // R808 & R1528
Put("BIND(C"), Walk(", NAME=", x.v), Put(')');
return false;
}
bool Pre(const CoarraySpec &x) { // R809
std::visit(visitors{[&](const DeferredCoshapeSpecList &y) { Walk(y); },
[&](const ExplicitCoshapeSpec &y) { Walk(y); }},
x.u);
return false;
}
bool Post(const DeferredCoshapeSpecList &x) { // R810
for (auto j = x.v; j > 0; --j) {
Put(':');
if (j > 1) {
Put(',');
}
}
return false;
}
bool Pre(const ExplicitCoshapeSpec &x) { // R811
Walk(std::get<std::list<ExplicitShapeSpec>>(x.t), ",", ",");
Walk(std::get<std::optional<SpecificationExpr>>(x.t), ":"), Put('*');
return false;
}
bool Pre(const ExplicitShapeSpec &x) { // R812 - R813 & R816 - R818
Walk(std::get<std::optional<SpecificationExpr>>(x.t), ":");
Walk(std::get<SpecificationExpr>(x.t));
return false;
}
bool Pre(const ArraySpec &x) { // R815
std::visit(
visitors{[&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
[&](const std::list<AssumedShapeSpec> &y) { Walk(y, ","); },
[&](const DeferredShapeSpecList &y) { Walk(y); },
[&](const AssumedSizeSpec &y) { Walk(y); },
[&](const ImpliedShapeSpec &y) { Walk(y); },
[&](const AssumedRankSpec &y) { Walk(y); }},
x.u);
return false;
}
void Post(const AssumedShapeSpec &) { Put(':'); } // R819
bool Post(const DeferredShapeSpecList &x) { // R820
for (auto j = x.v; j > 0; --j) {
Put(':');
if (j > 1) {
Put(',');
}
}
return false;
}
bool Pre(const AssumedImpliedSpec &x) { // R821
Walk(x.v, ":");
Put('*');
return false;
}
bool Pre(const AssumedSizeSpec &x) { // R822
Walk(std::get<std::list<ExplicitShapeSpec>>(x.t), ",", ",");
Walk(std::get<AssumedImpliedSpec>(x.t));
return false;
}
bool Pre(const ImpliedShapeSpec &x) { // R823
Walk(x.v, ",");
return false;
}
void Post(const AssumedRankSpec &) { Put(".."); } // R825
void Post(const Asynchronous &) { Put("ASYNCHRONOUS"); }
void Post(const External &) { Put("EXTERNAL"); }
void Post(const Intrinsic &) { Put("INTRINSIC"); }
void Post(const Optional &) { Put("OPTIONAL"); }
void Post(const Parameter &) { Put("PARAMETER"); }
void Post(const Protected &) { Put("PROTECTED"); }
void Post(const Save &) { Put("SAVE"); }
void Post(const Target &) { Put("TARGET"); }
void Post(const Value &) { Put("VALUE"); }
void Post(const Volatile &) { Put("VOLATILE"); }
bool Pre(const IntentSpec &x) { // R826
Put("INTENT("), Walk(x.v), Put(")");
return false;
}
bool Pre(const AccessStmt &x) { // R827
Walk(std::get<AccessSpec>(x.t));
Walk(" :: ", std::get<std::list<AccessId>>(x.t), ", ");
return false;
}
bool Pre(const AllocatableStmt &x) { // R829
Put("ALLOCATABLE :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const ObjectDecl &x) { // R830 & R860
Walk(std::get<ObjectName>(x.t));
Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")");
Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]");
return false;
}
bool Pre(const AsynchronousStmt &x) { // R831
Put("ASYNCHRONOUS :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const BindStmt &x) { // R832
Walk(x.t, " :: ");
return false;
}
bool Pre(const BindEntity &x) { // R833
bool isCommon{std::get<BindEntity::Kind>(x.t) == BindEntity::Kind::Common};
const char *slash{isCommon ? "/" : ""};
Put(slash), Walk(std::get<Name>(x.t)), Put(slash);
return false;
}
bool Pre(const CodimensionStmt &x) { // R834
Put("CODIMENSION :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const CodimensionDecl &x) { // R835
Walk(std::get<Name>(x.t));
Put('['), Walk(std::get<CoarraySpec>(x.t)), Put(']');
return false;
}
bool Pre(const ContiguousStmt &x) { // R836
Put("CONTIGUOUS :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const DataStmt &) { // R837
Put("DATA ");
return true;
}
bool Pre(const DataStmtSet &x) { // R838
Walk(std::get<std::list<DataStmtObject>>(x.t), ", ");
Put('/'), Walk(std::get<std::list<DataStmtValue>>(x.t), ", "), Put('/');
return false;
}
bool Pre(const DataImpliedDo &x) { // R840, R842
Put("("), Walk(std::get<std::list<DataIDoObject>>(x.t), ", "), Put(',');
Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::");
Walk(std::get<LoopBounds<ScalarIntConstantExpr>>(x.t)), Put(')');
return false;
}
bool Pre(const DataStmtValue &x) { // R843
Walk(std::get<std::optional<DataStmtRepeat>>(x.t), "*");
Walk(std::get<DataStmtConstant>(x.t));
return false;
}
bool Pre(const DimensionStmt &x) { // R848
Put("DIMENSION :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const DimensionStmt::Declaration &x) {
Walk(std::get<Name>(x.t));
Put('('), Walk(std::get<ArraySpec>(x.t)), Put(')');
return false;
}
bool Pre(const IntentStmt &x) { // R849
Walk(x.t, " :: ");
return false;
}
bool Pre(const OptionalStmt &x) { // R850
Put("OPTIONAL :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const ParameterStmt &x) { // R851
Put("PARAMETER("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const NamedConstantDef &x) { // R852
Walk(x.t, "=");
return false;
}
bool Pre(const PointerStmt &x) { // R853
Put("POINTER :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const ProtectedStmt &x) { // R855
Put("PROTECTED :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const SaveStmt &x) { // R856
Put("SAVE"), Walk(" :: ", x.v, ", ");
return false;
}
bool Pre(const SavedEntity &x) { // R857, R858
bool isCommon{
std::get<SavedEntity::Kind>(x.t) == SavedEntity::Kind::Common};
const char *slash{isCommon ? "/" : ""};
Put(slash), Walk(std::get<Name>(x.t)), Put(slash);
return false;
}
bool Pre(const TargetStmt &x) { // R859
Put("TARGET :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const ValueStmt &x) { // R861
Put("VALUE :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const VolatileStmt &x) { // R862
Put("VOLATILE :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const ImplicitStmt &x) { // R863
Put("IMPLICIT ");
std::visit(
visitors{[&](const std::list<ImplicitSpec> &y) { Walk(y, ", "); },
[&](const std::list<ImplicitStmt::ImplicitNoneNameSpec> &y) {
Put("NONE"), Walk(" (", y, ", ", ")");
}},
x.u);
return false;
}
bool Pre(const ImplicitSpec &x) { // R864
Walk(std::get<DeclarationTypeSpec>(x.t));
Put('('), Walk(std::get<std::list<LetterSpec>>(x.t), ", "), Put(')');
return false;
}
bool Pre(const LetterSpec &x) { // R865
Put(std::get<char>(x.t)), Walk("-", std::get<std::optional<char>>(x.t));
return false;
}
bool Pre(const ImportStmt &x) { // R867
Put("IMPORT");
switch (x.kind) {
case ImportStmt::Kind::Default:
Put(" :: ");
Walk(x.names);
break;
case ImportStmt::Kind::Only:
Put(", ONLY: ");
Walk(x.names);
break;
case ImportStmt::Kind::None: Put(", NONE"); break;
case ImportStmt::Kind::All: Put(", ALL"); break;
default: CRASH_NO_CASE;
}
return false;
}
bool Pre(const NamelistStmt &x) { // R868
Put("NAMELIST"), Walk(x.v, ", ");
return false;
}
bool Pre(const NamelistStmt::Group &x) {
Put('/'), Put(std::get<Name>(x.t)), Put('/');
Walk(std::get<std::list<Name>>(x.t), ", ");
return false;
}
bool Pre(const EquivalenceStmt &x) { // R870, R871
Put("EQUIVALENCE");
const char *separator{" "};
for (const std::list<EquivalenceObject> &y : x.v) {
Put(separator), Put('('), Walk(y), Put(')');
separator = ", ";
}
return false;
}
bool Pre(const CommonStmt &x) { // R873
Put("COMMON ");
Walk("/", std::get<std::optional<std::optional<Name>>>(x.t), "/");
Walk(std::get<std::list<CommonBlockObject>>(x.t), ", ");
Walk(", ", std::get<std::list<CommonStmt::Block>>(x.t), ", ");
return false;
}
bool Pre(const CommonBlockObject &x) { // R874
Walk(std::get<Name>(x.t));
Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")");
return false;
}
bool Pre(const CommonStmt::Block &x) {
Walk("/", std::get<std::optional<Name>>(x.t), "/");
Walk(std::get<std::list<CommonBlockObject>>(x.t));
return false;
}
bool Pre(const Substring &x) { // R908, R909
Walk(std::get<DataReference>(x.t));
Put('('), Walk(std::get<SubstringRange>(x.t)), Put(')');
return false;
}
bool Pre(const CharLiteralConstantSubstring &x) {
Walk(std::get<CharLiteralConstant>(x.t));
Put('('), Walk(std::get<SubstringRange>(x.t)), Put(')');
return false;
}
bool Pre(const SubstringRange &x) { // R910
Walk(x.t, ":");
return false;
}
bool Pre(const PartRef &x) { // R912
Walk(x.name);
Walk("(", x.subscripts, ",", ")");
Walk(x.imageSelector);
return false;
}
bool Pre(const StructureComponent &x) { // R913
Walk(x.base), Put(percentOrDot_), Walk(x.component);
return false;
}
bool Pre(const ArrayElement &x) { // R917
Walk(x.base);
Put('('), Walk(x.subscripts, ","), Put(')');
return false;
}
bool Pre(const SubscriptTriplet &x) { // R921
Walk(std::get<0>(x.t)), Put(':'), Walk(std::get<1>(x.t));
Walk(":", std::get<2>(x.t));
return false;
}
bool Pre(const ImageSelector &x) { // R924
Put('['), Walk(std::get<std::list<Cosubscript>>(x.t), ",");
Walk(",", std::get<std::list<ImageSelectorSpec>>(x.t), ","), Put(']');
return false;
}
bool Pre(const ImageSelectorSpec::Stat &) {
Put("STAT=");
return true;
}
bool Pre(const ImageSelectorSpec::Team &) {
Put("TEAM=");
return true;
}
bool Pre(const ImageSelectorSpec::Team_Number &) {
Put("TEAM_NUMBER=");
return true;
}
bool Pre(const AllocateStmt &x) { // R927
Put("ALLOCATE("), Walk(std::get<std::optional<TypeSpec>>(x.t), "::");
Walk(std::get<std::list<Allocation>>(x.t), ", ");
Walk(", ", std::get<std::list<AllocOpt>>(x.t), ", "), Put(')');
return false;
}
bool Pre(const AllocOpt &x) { // R928, R931
std::visit(visitors{[&](const AllocOpt::Mold &) { Put("MOLD="); },
[&](const AllocOpt::Source &) { Put("SOURCE="); },
[&](const StatOrErrmsg &y) {}},
x.u);
return true;
}
bool Pre(const Allocation &x) { // R932
Walk(std::get<AllocateObject>(x.t));
Walk("(", std::get<std::list<AllocateShapeSpec>>(x.t), ",", ")");
Walk("[", std::get<std::optional<AllocateCoarraySpec>>(x.t), "]");
return false;
}
bool Pre(const AllocateShapeSpec &x) { // R934 & R938
Walk(std::get<std::optional<BoundExpr>>(x.t), ":");
Walk(std::get<BoundExpr>(x.t));
return false;
}
bool Pre(const AllocateCoarraySpec &x) { // R937
Walk(std::get<std::list<AllocateCoshapeSpec>>(x.t), ",", ",");
Walk(std::get<std::optional<BoundExpr>>(x.t), ":"), Put('*');
return false;
}
bool Pre(const NullifyStmt &x) { // R939
Put("NULLIFY("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const DeallocateStmt &x) { // R941
Put("DEALLOCATE("), Walk(std::get<std::list<AllocateObject>>(x.t), ", ");
Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
return false;
}
bool Pre(const StatOrErrmsg &x) { // R942 & R1165
std::visit(visitors{[&](const StatVariable &) { Put("STAT="); },
[&](const MsgVariable &) { Put("ERRMSG="); }},
x.u);
return true;
}
// R1001 - R1022
bool Pre(const Expr::Parentheses &x) {
Put('('), Walk(x.v), Put(')');
return false;
}
bool Pre(const Expr::UnaryPlus &x) {
Put("+");
return true;
}
bool Pre(const Expr::Negate &x) {
Put("-");
return true;
}
bool Pre(const Expr::NOT &x) {
Put(".NOT.");
return true;
}
bool Pre(const Expr::PercentLoc &x) {
Put("%LOC("), Walk(x.v), Put(')');
return false;
}
bool Pre(const Expr::DefinedUnary &x) {
Put('.'), Walk(x.t, ". ");
return false;
}
bool Pre(const Expr::Power &x) {
Walk(x.t, "**");
return false;
}
bool Pre(const Expr::Multiply &x) {
Walk(x.t, "*");
return false;
}
bool Pre(const Expr::Divide &x) {
Walk(x.t, "/");
return false;
}
bool Pre(const Expr::Add &x) {
Walk(x.t, "+");
return false;
}
bool Pre(const Expr::Subtract &x) {
Walk(x.t, "-");
return false;
}
bool Pre(const Expr::Concat &x) {
Walk(x.t, "//");
return false;
}
bool Pre(const Expr::LT &x) {
Walk(x.t, "<");
return false;
}
bool Pre(const Expr::LE &x) {
Walk(x.t, "<=");
return false;
}
bool Pre(const Expr::EQ &x) {
Walk(x.t, "==");
return false;
}
bool Pre(const Expr::NE &x) {
Walk(x.t, "/=");
return false;
}
bool Pre(const Expr::GE &x) {
Walk(x.t, ">=");
return false;
}
bool Pre(const Expr::GT &x) {
Walk(x.t, ">");
return false;
}
bool Pre(const Expr::AND &x) {
Walk(x.t, ".AND.");
return false;
}
bool Pre(const Expr::OR &x) {
Walk(x.t, ".OR.");
return false;
}
bool Pre(const Expr::EQV &x) {
Walk(x.t, ".EQV.");
return false;
}
bool Pre(const Expr::NEQV &x) {
Walk(x.t, ".NEQV.");
return false;
}
bool Pre(const Expr::ComplexConstructor &x) {
Put('('), Walk(x.t, ","), Put(')');
return false;
}
bool Pre(const Expr::DefinedBinary &x) {
Walk(std::get<1>(x.t)); // left
Walk(std::get<DefinedOpName>(x.t));
Walk(std::get<2>(x.t)); // right
return false;
}
bool Pre(const DefinedOpName &x) { // R1003, R1023, R1414, & R1415
Put('.'), Put(x.v), Put('.');
return false;
}
bool Pre(const AssignmentStmt &x) { // R1032
Walk(x.t, " = ");
return false;
}
bool Pre(const PointerAssignmentStmt &x) { // R1033, R1034, R1038
Walk(std::get<Variable>(x.t));
std::visit(
visitors{[&](const std::list<BoundsRemapping> &y) {
Put('('), Walk(y), Put(')');
},
[&](const std::list<BoundsSpec> &y) { Walk("(", y, ", ", ")"); }},
std::get<PointerAssignmentStmt::Bounds>(x.t).u);
Put(" => "), Walk(std::get<Expr>(x.t));
return false;
}
void Post(const BoundsSpec &) { // R1035
Put(':');
}
bool Pre(const BoundsRemapping &x) { // R1036
Walk(x.t, ":");
return false;
}
bool Pre(const ProcComponentRef &x) { // R1039
Walk(std::get<Scalar<Variable>>(x.t)), Put(percentOrDot_);
Walk(std::get<Name>(x.t));
return false;
}
bool Pre(const WhereStmt &x) { // R1041, R1045, R1046
Put("WHERE ("), Walk(x.t, ") ");
return false;
}
bool Pre(const WhereConstructStmt &x) { // R1043
Walk(std::get<std::optional<Name>>(x.t), ": ");
Put("WHERE ("), Walk(std::get<LogicalExpr>(x.t)), Put(')');
Indent();
return false;
}
bool Pre(const MaskedElsewhereStmt &x) { // R1047
Outdent();
Put("ELSEWHERE ("), Walk(std::get<LogicalExpr>(x.t)), Put(')');
Walk(" ", std::get<std::optional<Name>>(x.t));
Indent();
return false;
}
bool Pre(const ElsewhereStmt &x) { // R1048
Outdent(), Put("ELSEWHERE"), Walk(" ", x.v), Indent();
return false;
}
bool Pre(const EndWhereStmt &x) { // R1049
Outdent(), Put("END WHERE"), Walk(" ", x.v);
return false;
}
bool Pre(const ForallConstructStmt &x) { // R1051
Walk(std::get<std::optional<Name>>(x.t), ": ");
Put("FORALL"), Walk(std::get<Indirection<ConcurrentHeader>>(x.t));
Indent();
return false;
}
bool Pre(const EndForallStmt &x) { // R1054
Outdent(), Put("END FORALL"), Walk(" ", x.v);
return false;
}
bool Pre(const ForallStmt &) { // R1055
Put("FORALL");
return true;
}
bool Pre(const AssociateStmt &x) { // R1103
Walk(std::get<std::optional<Name>>(x.t), ": ");
Put("ASSOCIATE ("), Walk(std::get<std::list<Association>>(x.t), ", ");
Put(')'), Indent();
return false;
}
bool Pre(const Association &x) { // R1104
Walk(x.t, " => ");
return false;
}
bool Pre(const EndAssociateStmt &x) { // R1106
Outdent(), Put("END ASSOCIATE"), Walk(" ", x.v);
return false;
}
bool Pre(const BlockStmt &x) { // R1108
Walk(x.v, ": "), Put("BLOCK"), Indent();
return false;
}
bool Pre(const EndBlockStmt &x) { // R1110
Outdent(), Put("END BLOCK"), Walk(" ", x.v);
return false;
}
bool Pre(const ChangeTeamStmt &x) { // R1112
Walk(std::get<std::optional<Name>>(x.t), ": ");
Put("CHANGE TEAM ("), Walk(std::get<TeamVariable>(x.t));
Walk(", ", std::get<std::list<CoarrayAssociation>>(x.t), ", ");
Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
Indent();
return false;
}
bool Pre(const CoarrayAssociation &x) { // R1113
Walk(x.t, " => ");
return false;
}
bool Pre(const EndChangeTeamStmt &x) { // R1114
Outdent(), Put("END TEAM (");
Walk(std::get<std::list<StatOrErrmsg>>(x.t), ", ");
Put(')'), Walk(" ", std::get<std::optional<Name>>(x.t));
return false;
}
bool Pre(const CriticalStmt &x) { // R1117
Walk(std::get<std::optional<Name>>(x.t), ": ");
Put("CRITICAL ("), Walk(std::get<std::list<StatOrErrmsg>>(x.t), ", ");
Put(')'), Indent();
return false;
}
bool Pre(const EndCriticalStmt &x) { // R1118
Outdent(), Put("END CRITICAL"), Walk(" ", x.v);
return false;
}
bool Pre(const DoConstruct &x) { // R1119, R1120
Walk(std::get<Statement<NonLabelDoStmt>>(x.t));
Indent(), Walk(std::get<Block>(x.t), ""), Outdent();
Walk(std::get<Statement<EndDoStmt>>(x.t));
return false;
}
bool Pre(const LabelDoStmt &x) { // R1121
Walk(std::get<std::optional<Name>>(x.t), ": ");
Put("DO "), Walk(std::get<Label>(x.t));
Walk(" ", std::get<std::optional<LoopControl>>(x.t));
return false;
}
bool Pre(const NonLabelDoStmt &x) { // R1122
Walk(std::get<std::optional<Name>>(x.t), ": ");
Put("DO "), Walk(std::get<std::optional<LoopControl>>(x.t));
return false;
}
bool Pre(const LoopControl &x) { // R1123
std::visit(visitors{[&](const ScalarLogicalExpr &y) {
Put("WHILE ("), Walk(y), Put(')');
},
[&](const auto &y) { Walk(y); }},
x.u);
return false;
}
bool Pre(const ConcurrentHeader &x) { // R1125
Put('('), Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::");
Walk(std::get<std::list<ConcurrentControl>>(x.t), ", ");
Walk(", ", std::get<std::optional<ScalarLogicalExpr>>(x.t)), Put(')');
return false;
}
bool Pre(const ConcurrentControl &x) { // R1126 - R1128
Walk(std::get<Name>(x.t)), Put('='), Walk(std::get<1>(x.t));
Put(':'), Walk(std::get<2>(x.t));
Walk(":", std::get<std::optional<ScalarIntExpr>>(x.t));
return false;
}
bool Pre(const LoopControl::Concurrent &x) { // R1129
Put("CONCURRENT");
return true;
}
bool Pre(const LocalitySpec::Local &x) {
Put("LOCAL("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const LocalitySpec::LocalInit &x) {
Put("LOCAL INIT("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const LocalitySpec::Shared &x) {
Put("SHARED("), Walk(x.v, ", "), Put(')');
return false;
}
void Post(const LocalitySpec::DefaultNone &x) { Put("DEFAULT(NONE)"); }
bool Pre(const EndDoStmt &x) { // R1132
Put("END DO"), Walk(" ", x.v);
return false;
}
bool Pre(const CycleStmt &x) { // R1133
Put("CYCLE"), Walk(" ", x.v);
return false;
}
bool Pre(const IfThenStmt &x) { // R1135
Walk(std::get<std::optional<Name>>(x.t), ": ");
Put("IF ("), Walk(std::get<ScalarLogicalExpr>(x.t)), Put(") THEN");
Indent();
return false;
}
bool Pre(const ElseIfStmt &x) { // R1136
Outdent(), Put("ELSE IF ("), Walk(std::get<ScalarLogicalExpr>(x.t));
Put(") THEN"), Walk(" ", std::get<std::optional<Name>>(x.t)), Indent();
return false;
}
bool Pre(const ElseStmt &x) { // R1137
Outdent(), Put("ELSE"), Walk(" ", x.v), Indent();
return false;
}
bool Pre(const EndIfStmt &x) { // R1138
Outdent(), Put("END IF"), Walk(" ", x.v);
return false;
}
bool Pre(const IfStmt &x) { // R1139
Put("IF ("), Walk(x.t, ") ");
return false;
}
bool Pre(const SelectCaseStmt &x) { // R1141, R1144
Walk(std::get<std::optional<Name>>(x.t), ": ");
Put("SELECT CASE ("), Walk(std::get<Scalar<Expr>>(x.t)), Put(')'), Indent();
return false;
}
bool Pre(const CaseStmt &x) { // R1142
Outdent(), Put("CASE "), Walk(std::get<CaseSelector>(x.t));
Walk(" ", std::get<std::optional<Name>>(x.t)), Indent();
return false;
}
bool Pre(const EndSelectStmt &x) { // R1143 & R1151 & R1155
Outdent(), Put("END SELECT"), Walk(" ", x.v);
return false;
}
bool Pre(const CaseSelector &x) { // R1145
std::visit(visitors{[&](const std::list<CaseValueRange> &y) {
Put('('), Walk(y), Put(')');
},
[&](const Default &) { Put("DEFAULT"); }},
x.u);
return false;
}
bool Pre(const CaseValueRange::Range &x) { // R1146
Walk(x.lower), Put(':'), Walk(x.upper);
return false;
}
bool Pre(const SelectRankStmt &x) { // R1149
Walk(std::get<0>(x.t), ": ");
Put("SELECT RANK ("), Walk(std::get<1>(x.t), " => ");
Walk(std::get<Selector>(x.t)), Put(')'), Indent();
return false;
}
bool Pre(const SelectRankCaseStmt &x) { // R1150
Outdent(), Put("RANK ");
std::visit(visitors{[&](const ScalarIntConstantExpr &y) {
Put('('), Walk(y), Put(')');
},
[&](const Star &) { Put("(*)"); },
[&](const Default &) { Put("DEFAULT"); }},
std::get<SelectRankCaseStmt::Rank>(x.t).u);
Walk(" ", std::get<std::optional<Name>>(x.t)), Indent();
return false;
}
bool Pre(const SelectTypeStmt &x) { // R1153
Walk(std::get<0>(x.t), ": ");
Put("SELECT TYPE ("), Walk(std::get<1>(x.t), " => ");
Walk(std::get<Selector>(x.t)), Put(')'), Indent();
return false;
}
bool Pre(const TypeGuardStmt &x) { // R1154
Outdent(), Walk(std::get<TypeGuardStmt::Guard>(x.t));
Walk(" ", std::get<std::optional<Name>>(x.t)), Indent();
return false;
}
bool Pre(const TypeGuardStmt::Guard &x) {
std::visit(visitors{[&](const TypeSpec &y) {
Put("TYPE IS ("), Walk(y), Put(')');
},
[&](const DerivedTypeSpec &y) {
Put("CLASS IS ("), Walk(y), Put(')');
},
[&](const Default &) { Put("CLASS DEFAULT"); }},
x.u);
return false;
}
bool Pre(const ExitStmt &x) { // R1156
Put("EXIT"), Walk(" ", x.v);
return false;
}
bool Pre(const GotoStmt &x) { // R1157
Put("GO TO ");
return true;
}
bool Pre(const ComputedGotoStmt &x) { // R1158
Put("GO TO ("), Walk(x.t, "), ");
return false;
}
bool Pre(const ContinueStmt &x) { // R1159
Put("CONTINUE");
return false;
}
bool Pre(const StopStmt &x) { // R1160, R1161
if (std::get<StopStmt::Kind>(x.t) == StopStmt::Kind::ErrorStop) {
Put("ERROR ");
}
Put("STOP"), Walk(" ", std::get<std::optional<StopCode>>(x.t));
Walk(", QUIET=", std::get<std::optional<ScalarLogicalExpr>>(x.t));
return false;
}
bool Pre(const FailImageStmt &x) { // R1163
Put("FAIL IMAGE");
return false;
}
bool Pre(const SyncAllStmt &x) { // R1164
Put("SYNC ALL ("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const SyncImagesStmt &x) { // R1166
Put("SYNC IMAGES ("), Walk(std::get<SyncImagesStmt::ImageSet>(x.t));
Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
return false;
}
bool Pre(const SyncMemoryStmt &x) { // R1168
Put("SYNC MEMORY ("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const SyncTeamStmt &x) { // R1169
Put("SYNC TEAM ("), Walk(std::get<TeamVariable>(x.t));
Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
return false;
}
bool Pre(const EventPostStmt &x) { // R1170
Put("EVENT POST ("), Walk(std::get<EventVariable>(x.t));
Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
return false;
}
bool Pre(const EventWaitStmt::EventWaitSpec &x) { // R1173, R1174
std::visit(
visitors{[&](const ScalarIntExpr &x) { Put("UNTIL_COUNT="), Walk(x); },
[&](const StatOrErrmsg &y) {}},
x.u);
return true;
}
bool Pre(const EventWaitStmt &x) { // R1170
Put("EVENT WAIT ("), Walk(std::get<EventVariable>(x.t));
Walk(", ", std::get<std::list<EventWaitStmt::EventWaitSpec>>(x.t), ", ");
Put(')');
return false;
}
bool Pre(const FormTeamStmt &x) { // R1175
Put("FORM TEAM ("), Walk(std::get<ScalarIntExpr>(x.t));
Put(','), Walk(std::get<TeamVariable>(x.t));
Walk(", ", std::get<std::list<FormTeamStmt::FormTeamSpec>>(x.t), ", ");
Put(')');
return false;
}
bool Pre(const FormTeamStmt::FormTeamSpec &x) { // R1176, R1177
std::visit(
visitors{[&](const ScalarIntExpr &x) { Put("NEW_INDEX="), Walk(x); },
[&](const StatOrErrmsg &y) {}},
x.u);
return true;
}
bool Pre(const LockStmt &x) { // R1178
Put("LOCK ("), Walk(std::get<LockVariable>(x.t));
Walk(", ", std::get<std::list<LockStmt::LockStat>>(x.t), ", ");
Put(')');
return false;
}
bool Pre(const LockStmt::LockStat &x) { // R1179
std::visit(visitors{[&](const ScalarLogicalVariable &x) {
Put("ACQUIRED_LOCK="), Walk(x);
},
[&](const StatOrErrmsg &y) {}},
x.u);
return true;
}
bool Pre(const UnlockStmt &x) { // R1180
Put("UNLOCK ("), Walk(std::get<LockVariable>(x.t));
Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", ");
Put(')');
return false;
}
bool Pre(const OpenStmt &x) { // R1204
Put("OPEN ("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const ConnectSpec &x) { // R1205
return std::visit(visitors{[&](const FileUnitNumber &) {
Put("UNIT=");
return true;
},
[&](const FileNameExpr &) {
Put("FILE=");
return true;
},
[&](const ConnectSpec::CharExpr &y) {
Walk(y.t, "=");
return false;
},
[&](const MsgVariable &) {
Put("IOMSG=");
return true;
},
[&](const StatVariable &) {
Put("IOSTAT=");
return true;
},
[&](const ConnectSpec::Recl &) {
Put("RECL=");
return true;
},
[&](const ConnectSpec::Newunit &) {
Put("NEWUNIT=");
return true;
},
[&](const ErrLabel &) {
Put("ERR=");
return true;
},
[&](const StatusExpr &) {
Put("STATUS=");
return true;
}},
x.u);
}
bool Pre(const CloseStmt &x) { // R1208
Put("CLOSE ("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const CloseStmt::CloseSpec &x) { // R1209
std::visit(visitors{[&](const FileUnitNumber &) { Put("UNIT="); },
[&](const StatVariable &) { Put("IOSTAT="); },
[&](const MsgVariable &) { Put("IOMSG="); },
[&](const ErrLabel &) { Put("ERR="); },
[&](const StatusExpr &) { Put("STATUS="); }},
x.u);
return true;
}
bool Pre(const ReadStmt &x) { // R1210
Put("READ ");
if (x.iounit) {
Put('('), Walk(x.iounit);
if (x.format) {
Put(", "), Walk(x.format);
}
Put(')');
} else if (x.format) {
Walk(x.format);
if (!x.items.empty()) {
Put(", ");
}
} else {
Put('('), Walk(x.controls), Put(')');
}
Walk(" ", x.items, ", ");
return false;
}
bool Pre(const WriteStmt &x) { // R1211
Put("WRITE (");
if (x.iounit) {
Walk(x.iounit);
if (x.format) {
Put(", "), Walk(x.format);
}
Walk(", ", x.controls);
} else {
Walk(x.controls);
}
Put(')'), Walk(" ", x.items, ", ");
return false;
}
bool Pre(const PrintStmt &x) { // R1212
Put("PRINT "), Walk(std::get<Format>(x.t));
Walk(", ", std::get<std::list<OutputItem>>(x.t), ", ");
return false;
}
bool Pre(const IoControlSpec &x) { // R1213
return std::visit(visitors{[&](const IoUnit &) {
Put("UNIT=");
return true;
},
[&](const Format &) {
Put("FMT=");
return true;
},
[&](const Name &) {
Put("NML=");
return true;
},
[&](const IoControlSpec::CharExpr &y) {
Walk(y.t, "=");
return false;
},
[&](const IoControlSpec::Asynchronous &) {
Put("ASYNCHRONOUS=");
return true;
},
[&](const EndLabel &) {
Put("END=");
return true;
},
[&](const EorLabel &) {
Put("EOR=");
return true;
},
[&](const ErrLabel &) {
Put("ERR=");
return true;
},
[&](const IdVariable &) {
Put("ID=");
return true;
},
[&](const MsgVariable &) {
Put("IOMSG=");
return true;
},
[&](const StatVariable &) {
Put("IOSTAT=");
return true;
},
[&](const IoControlSpec::Pos &) {
Put("POS=");
return true;
},
[&](const IoControlSpec::Rec &) {
Put("REC=");
return true;
},
[&](const IoControlSpec::Size &) {
Put("SIZE=");
return true;
}},
x.u);
}
bool Pre(const InputImpliedDo &x) { // R1218
Put('('), Walk(std::get<std::list<InputItem>>(x.t), ", "), Put(", ");
Walk(std::get<IoImpliedDoControl>(x.t)), Put(')');
return false;
}
bool Pre(const OutputImpliedDo &x) { // R1219
Put('('), Walk(std::get<std::list<OutputItem>>(x.t), ", "), Put(", ");
Walk(std::get<IoImpliedDoControl>(x.t)), Put(')');
return false;
}
bool Pre(const WaitStmt &x) { // R1222
Put("WAIT ("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const WaitSpec &x) { // R1223
std::visit(visitors{[&](const FileUnitNumber &) { Put("UNIT="); },
[&](const EndLabel &) { Put("END="); },
[&](const EorLabel &) { Put("EOR="); },
[&](const ErrLabel &) { Put("ERR="); },
[&](const IdExpr &) { Put("ID="); },
[&](const MsgVariable &) { Put("IOMSG="); },
[&](const StatVariable &) { Put("IOSTAT="); }},
x.u);
return true;
}
bool Pre(const BackspaceStmt &x) { // R1224
Put("BACKSPACE ("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const EndfileStmt &x) { // R1225
Put("ENDFILE ("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const RewindStmt &x) { // R1226
Put("REWIND ("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const FlushStmt &x) { // R1228
Put("FLUSH ("), Walk(x.v, ", "), Put(')');
return false;
}
bool Pre(const InquireStmt &x) { // R1230
Put("INQUIRE (");
std::visit(
visitors{[&](const InquireStmt::Iolength &y) {
Put("IOLENGTH="), Walk(y.t, ") ");
},
[&](const std::list<InquireSpec> &y) { Walk(y, ", "), Put(')'); }},
x.u);
return false;
}
bool Pre(const InquireSpec &x) { // R1231
return std::visit(visitors{[&](const FileUnitNumber &) {
Put("UNIT=");
return true;
},
[&](const FileNameExpr &) {
Put("FILE=");
return true;
},
[&](const InquireSpec::CharVar &y) {
Walk(y.t, "=");
return false;
},
[&](const InquireSpec::IntVar &y) {
Walk(y.t, "=");
return false;
},
[&](const InquireSpec::LogVar &y) {
Walk(y.t, "=");
return false;
},
[&](const IdExpr &) {
Put("ID=");
return true;
},
[&](const ErrLabel &) {
Put("ERR=");
return true;
}},
x.u);
}
bool Pre(const FormatStmt &) { // R1301
Put("FORMAT");
return true;
}
bool Pre(const format::FormatSpecification &x) { // R1302, R1303, R1305
Put('('), Walk("", x.items, ",", x.unlimitedItems.empty() ? "" : ",");
Walk("*(", x.unlimitedItems, ",", ")"), Put(')');
return false;
}
bool Pre(const format::FormatItem &x) { // R1304, R1306, R1321
if (x.repeatCount.has_value()) {
Walk(*x.repeatCount);
}
std::visit(visitors{[&](const std::string &y) { PutQuoted(y); },
[&](const std::list<format::FormatItem> &y) {
Walk("(", y, ",", ")");
},
[&](const auto &y) { Walk(y); }},
x.u);
return false;
}
bool Pre(const format::IntrinsicTypeDataEditDesc &x) { // R1307(1/2) - R1311
switch (x.kind) {
#define FMT(x) \
case format::IntrinsicTypeDataEditDesc::Kind::x: Put(#x); break
FMT(I);
FMT(B);
FMT(O);
FMT(Z);
FMT(F);
FMT(E);
FMT(EN);
FMT(ES);
FMT(EX);
FMT(G);
FMT(L);
FMT(A);
FMT(D);
#undef FMT
default: CRASH_NO_CASE;
}
Walk(x.width), Walk(".", x.digits), Walk("E", x.exponentWidth);
return false;
}
bool Pre(const format::DerivedTypeDataEditDesc &x) { // R1307(2/2), R1312
Put("DT");
if (!x.type.empty()) {
Put('"'), Put(x.type), Put('"');
}
Walk("(", x.parameters, ",", ")");
return false;
}
bool Pre(const format::ControlEditDesc &x) { // R1313, R1315-R1320
switch (x.kind) {
case format::ControlEditDesc::Kind::T:
Put('T');
Walk(x.count);
break;
case format::ControlEditDesc::Kind::TL:
Put("TL");
Walk(x.count);
break;
case format::ControlEditDesc::Kind::TR:
Put("TR");
Walk(x.count);
break;
case format::ControlEditDesc::Kind::X:
if (x.count != 1) {
Walk(x.count);
}
Put('X');
break;
case format::ControlEditDesc::Kind::Slash:
if (x.count != 1) {
Walk(x.count);
}
Put('/');
break;
case format::ControlEditDesc::Kind::Colon: Put(':'); break;
case format::ControlEditDesc::Kind::P:
Walk(x.count);
Put('P');
break;
#define FMT(x) \
case format::ControlEditDesc::Kind::x: Put(#x); break
FMT(SS);
FMT(SP);
FMT(S);
FMT(BN);
FMT(BZ);
FMT(RU);
FMT(RD);
FMT(RZ);
FMT(RN);
FMT(RC);
FMT(RP);
FMT(DC);
FMT(DP);
#undef FMT
default: CRASH_NO_CASE;
}
return false;
}
bool Pre(const MainProgram &x) { // R1401
if (!std::get<std::optional<Statement<ProgramStmt>>>(x.t)) {
Indent();
}
return true;
}
bool Pre(const ProgramStmt &x) { // R1402
Put("PROGRAM "), Indent();
return true;
}
bool Pre(const EndProgramStmt &x) { // R1403
Outdent(), Put("END PROGRAM"), Walk(" ", x.v);
return true;
}
bool Pre(const ModuleStmt &) { // R1405
Put("MODULE "), Indent();
return true;
}
bool Pre(const EndModuleStmt &) { // R1406
Outdent(), Put("END MODULE");
return true;
}
bool Pre(const UseStmt &x) { // R1409
Put("USE"), Walk(", ", x.nature), Put(" :: "), Walk(x.moduleName);
std::visit(
visitors{[&](const std::list<Rename> &y) { Walk(", ", y, ", "); },
[&](const std::list<Only> &y) { Walk(", ONLY: ", y, ", "); }},
x.u);
return false;
}
bool Pre(const Rename &x) { // R1411
std::visit(visitors{[&](const Rename::Names &y) { Walk(y.t, " => "); },
[&](const Rename::Operators &y) {
Put('.'), Walk(y.t, ". => ."), Put('.');
}},
x.u);
return false;
}
bool Pre(const SubmoduleStmt &x) { // R1417
Put("SUBMODULE "), Indent();
return true;
}
bool Pre(const ParentIdentifier &x) { // R1418
Walk(std::get<Name>(x.t)), Walk(":", std::get<std::optional<Name>>(x.t));
return false;
}
bool Pre(const EndSubmoduleStmt &) { // R1419
Outdent(), Put("END SUBMODULE");
return true;
}
bool Pre(const BlockDataStmt &x) { // R1421
Put("BLOCK DATA"), Walk(" ", x.v), Indent();
return false;
}
bool Pre(const EndBlockDataStmt &x) { // R1422
Outdent(), Put("END BLOCK DATA"), Walk(" ", x.v);
return false;
}
bool Pre(const InterfaceStmt &x) { // R1503
std::visit(visitors{[&](const std::optional<GenericSpec> &y) {
Put("INTERFACE"), Walk(" ", y);
},
[&](const Abstract &) { Put("ABSTRACT INTERFACE"); }},
x.u);
Indent();
return false;
}
bool Pre(const EndInterfaceStmt &x) { // R1504
Outdent(), Put("END INTERFACE"), Walk(" ", x.v);
return false;
}
bool Pre(const ProcedureStmt &x) { // R1506
if (std::get<ProcedureStmt::Kind>(x.t) ==
ProcedureStmt::Kind::ModuleProcedure) {
Put("MODULE ");
}
Put("PROCEDURE :: ");
Walk(std::get<std::list<Name>>(x.t), ", ");
return false;
}
bool Pre(const GenericSpec &x) { // R1508, R1509
std::visit(visitors{[&](const GenericSpec::Assignment &) {
Put("ASSIGNMENT (=)");
},
[&](const GenericSpec::ReadFormatted &) {
Put("READ (FORMATTED)");
},
[&](const GenericSpec::ReadUnformatted &) {
Put("READ (UNFORMATTED)");
},
[&](const GenericSpec::WriteFormatted &) {
Put("WRITE (FORMATTED)");
},
[&](const GenericSpec::WriteUnformatted &) {
Put("WRITE (UNFORMATTED)");
},
[&](const auto &y) {}},
x.u);
return true;
}
bool Pre(const GenericStmt &x) { // R1510
Put("GENERIC"), Walk(", ", std::get<std::optional<AccessSpec>>(x.t));
Put(" :: "), Walk(std::get<GenericSpec>(x.t)), Put(" => ");
Walk(std::get<std::list<Name>>(x.t), ", ");
return false;
}
bool Pre(const ExternalStmt &x) { // R1511
Put("EXTERNAL :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const ProcedureDeclarationStmt &x) { // R1512
Put("PROCEDURE ("), Walk(std::get<std::optional<ProcInterface>>(x.t));
Put(')'), Walk(", ", std::get<std::list<ProcAttrSpec>>(x.t), ", ");
Put(" :: "), Walk(std::get<std::list<ProcDecl>>(x.t), ", ");
return false;
}
bool Pre(const ProcDecl &x) { // R1515
Walk(std::get<Name>(x.t));
Walk(" => ", std::get<std::optional<ProcPointerInit>>(x.t));
return false;
}
bool Pre(const IntrinsicStmt &x) { // R1519
Put("INTRINSIC :: "), Walk(x.v, ", ");
return false;
}
bool Pre(const FunctionReference &x) { // R1520
Walk(std::get<ProcedureDesignator>(x.v.t));
Put('('), Walk(std::get<std::list<ActualArgSpec>>(x.v.t), ", "), Put(')');
return false;
}
bool Pre(const CallStmt &x) { // R1521
Put("CALL "), Walk(std::get<ProcedureDesignator>(x.v.t));
Walk(" (", std::get<std::list<ActualArgSpec>>(x.v.t), ", ", ")");
return false;
}
bool Pre(const ActualArgSpec &x) { // R1523
Walk(std::get<std::optional<Keyword>>(x.t), "=");
Walk(std::get<ActualArg>(x.t));
return false;
}
bool Pre(const ActualArg::PercentRef &x) { // R1524
Put("%REF("), Walk(x.v), Put(')');
return false;
}
bool Pre(const ActualArg::PercentVal &x) {
Put("%VAL("), Walk(x.v), Put(')');
return false;
}
bool Pre(const AltReturnSpec &) { // R1525
Put("*");
return true;
}
bool Pre(const FunctionStmt &x) { // R1530
Walk("", std::get<std::list<PrefixSpec>>(x.t), " ", " ");
Put("FUNCTION "), Walk(std::get<Name>(x.t)), Put(" (");
Walk(std::get<std::list<Name>>(x.t), ", "), Put(')');
Walk(" ", std::get<std::optional<Suffix>>(x.t)), Indent();
return false;
}
bool Pre(const Suffix &x) { // R1532
if (x.resultName) {
Put("RESULT ("), Walk(x.resultName), Put(')');
Walk(" ", x.binding);
} else {
Walk(x.binding);
}
return false;
}
bool Pre(const EndFunctionStmt &x) { // R1533
Outdent(), Put("END FUNCTION"), Walk(" ", x.v);
return false;
}
bool Pre(const SubroutineStmt &x) { // R1535
Walk("", std::get<std::list<PrefixSpec>>(x.t), " ", " ");
Put("SUBROUTINE "), Walk(std::get<Name>(x.t));
Walk(" (", std::get<std::list<DummyArg>>(x.t), ", ", ")");
Walk(" ", std::get<std::optional<LanguageBindingSpec>>(x.t));
Indent();
return false;
}
bool Pre(const EndSubroutineStmt &x) { // R1537
Outdent(), Put("END SUBROUTINE"), Walk(" ", x.v);
return false;
}
bool Pre(const MpSubprogramStmt &) { // R1539
Put("MODULE PROCEDURE "), Indent();
return true;
}
bool Pre(const EndMpSubprogramStmt &x) { // R1540
Outdent(), Put("END PROCEDURE"), Walk(" ", x.v);
return false;
}
bool Pre(const EntryStmt &x) { // R1541
Put("ENTRY "), Walk(std::get<Name>(x.t));
Walk(" (", std::get<std::list<DummyArg>>(x.t), ", ", ")");
Walk(" ", std::get<std::optional<Suffix>>(x.t));
return false;
}
bool Pre(const ReturnStmt &x) { // R1542
Put("RETURN"), Walk(" ", x.v);
return false;
}
bool Pre(const ContainsStmt &x) { // R1543
Outdent();
Put("CONTAINS");
Indent();
return false;
}
bool Pre(const StmtFunctionStmt &x) { // R1544
Walk(std::get<Name>(x.t)), Put('(');
Walk(std::get<std::list<Name>>(x.t), ", "), Put(") = ");
Walk(std::get<Scalar<Expr>>(x.t));
return false;
}
// Extensions and deprecated constructs
bool Pre(const BasedPointerStmt &x) {
Put("POINTER ("), Walk(std::get<0>(x.t)), Put(", "), Walk(std::get<1>(x.t));
Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"), Put(')');
return false;
}
bool Pre(const StructureStmt &x) {
Put("STRUCTURE ");
if (std::get<bool>(x.t)) { // slashes around name
Put('/'), Walk(std::get<Name>(x.t)), Put('/');
Walk(" ", std::get<std::list<EntityDecl>>(x.t), ", ");
} else {
CHECK(std::get<std::list<EntityDecl>>(x.t).empty());
Walk(std::get<Name>(x.t));
}
Indent();
percentOrDot_ = '.'; // TODO: this is so lame
return false;
}
void Post(const Union::UnionStmt &) { Put("UNION"), Indent(); }
void Post(const Union::EndUnionStmt &) { Outdent(), Put("END UNION"); }
void Post(const Map::MapStmt &) { Put("MAP"), Indent(); }
void Post(const Map::EndMapStmt &) { Outdent(), Put("END MAP"); }
void Post(const StructureDef::EndStructureStmt &) {
Outdent(), Put("END STRUCTURE");
}
bool Pre(const OldParameterStmt &x) {
Put("PARAMETER "), Walk(x.v, ", ");
return false;
}
bool Pre(const ArithmeticIfStmt &x) {
Put("IF ("), Walk(std::get<Expr>(x.t)), Put(") ");
Walk(std::get<1>(x.t)), Put(", ");
Walk(std::get<2>(x.t)), Put(", ");
Walk(std::get<3>(x.t));
return false;
}
bool Pre(const AssignStmt &x) {
Put("ASSIGN "), Walk(std::get<Label>(x.t));
Put(" TO "), Walk(std::get<Name>(x.t));
return false;
}
bool Pre(const AssignedGotoStmt &x) {
Put("GO TO "), Walk(std::get<Name>(x.t));
Walk(", (", std::get<std::list<Label>>(x.t), ", ", ")");
return false;
}
bool Pre(const PauseStmt &x) {
Put("PAUSE"), Walk(" ", x.v);
return false;
}
#define WALK_NESTED_ENUM(ENUMTYPE) \
bool Pre(const ENUMTYPE &x) { \
PutEnum(static_cast<int>(x), ENUMTYPE##AsString); \
return false; \
}
WALK_NESTED_ENUM(AccessSpec::Kind) // R807
WALK_NESTED_ENUM(TypeParamDefStmt::KindOrLen) // R734
WALK_NESTED_ENUM(IntentSpec::Intent) // R826
WALK_NESTED_ENUM(ImplicitStmt::ImplicitNoneNameSpec) // R866
WALK_NESTED_ENUM(ConnectSpec::CharExpr::Kind) // R1205
WALK_NESTED_ENUM(IoControlSpec::CharExpr::Kind)
WALK_NESTED_ENUM(InquireSpec::CharVar::Kind)
WALK_NESTED_ENUM(InquireSpec::IntVar::Kind)
WALK_NESTED_ENUM(InquireSpec::LogVar::Kind)
WALK_NESTED_ENUM(ProcedureStmt::Kind) // R1506
WALK_NESTED_ENUM(UseStmt::ModuleNature) // R1410
#undef WALK_NESTED_ENUM
void Done() const { CHECK(indent_ == 0); }
private:
void Put(char);
void Put(const char *);
void Put(const std::string &);
void PutUpperCase(const std::string &);
void PutQuoted(const std::string &);
void PutEnum(int, const char *);
void Indent() { indent_ += indentationAmount_; }
void Outdent() {
CHECK(indent_ >= indentationAmount_);
indent_ -= indentationAmount_;
}
// Call back to the traversal framework.
template<typename T> void Walk(const T &x) {
Fortran::parser::Walk(x, *this);
}
// Traverse a std::optional<> value. Emit a prefix and/or a suffix string
// only when it contains a value.
template<typename A>
void Walk(
const char *prefix, const std::optional<A> &x, const char *suffix = "") {
if (x.has_value()) {
Put(prefix), Walk(*x), Put(suffix);
}
}
template<typename A>
void Walk(const std::optional<A> &x, const char *suffix = "") {
return Walk("", x, suffix);
}
// Traverse a std::list<>. Separate the elements with an optional string.
// Emit a prefix and/or a suffix string only when the list is not empty.
template<typename A>
void Walk(const char *prefix, const std::list<A> &list,
const char *comma = ", ", const char *suffix = "") {
if (!list.empty()) {
const char *str{prefix};
for (const auto &x : list) {
Put(str), Walk(x);
str = comma;
}
Put(suffix);
}
}
template<typename A>
void Walk(const std::list<A> &list, const char *comma = ", ",
const char *suffix = "") {
return Walk("", list, comma, suffix);
}
// Traverse a std::tuple<>, with an optional separator.
template<size_t J = 0, typename T>
void WalkTupleElements(const T &tuple, const char *separator) {
if constexpr (J < std::tuple_size_v<T>) {
if (J > 0) {
Put(separator);
}
Walk(std::get<J>(tuple));
WalkTupleElements<J + 1>(tuple, separator);
}
}
template<typename... A>
void Walk(const std::tuple<A...> &tuple, const char *separator = "") {
WalkTupleElements(tuple, separator);
}
std::ostream &out_;
int indent_{0};
const int indentationAmount_{1};
int column_{1};
const int maxColumns_{80};
char percentOrDot_{'%'};
Encoding encoding_{Encoding::UTF8};
};
void UnparseVisitor::Put(char ch) {
if (column_ <= 1) {
if (ch == '\n') {
return;
}
for (int j{0}; j < indent_; ++j) {
out_ << ' ';
}
column_ = indent_ + 2;
} else if (ch == '\n') {
column_ = 1;
} else if (++column_ >= maxColumns_) {
out_ << "&\n";
for (int j{0}; j < indent_; ++j) {
out_ << ' ';
}
out_ << '&';
column_ = indent_ + 3;
}
out_ << ch;
}
void UnparseVisitor::Put(const char *str) {
for (; *str != '\0'; ++str) {
Put(*str);
}
}
void UnparseVisitor::Put(const std::string &str) {
for (char ch : str) {
Put(ch);
}
}
void UnparseVisitor::PutUpperCase(const std::string &str) {
for (char ch : str) {
Put(ToUpperCaseLetter(ch));
}
}
void UnparseVisitor::PutQuoted(const std::string &str) {
Put('"');
const auto emit = [&](char ch) { Put(ch); };
for (char ch : str) {
EmitQuotedChar(ch, emit, emit);
}
Put('"');
}
void UnparseVisitor::PutEnum(int n, const char *enumNames) {
const char *p{enumNames};
for (; n > 0; --n, ++p) {
for (; *p && *p != ','; ++p) {
}
}
while (*p == ' ') {
++p;
}
CHECK(*p != '\0');
for (; *p && *p != ' ' && *p != ','; ++p) {
Put(ToUpperCaseLetter(*p));
}
}
void Unparse(std::ostream &out, const Program &program, Encoding encoding) {
UnparseVisitor visitor{out, 1, encoding};
Walk(program, visitor);
visitor.Done();
}
} // namespace parser
} // namespace Fortran