// Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved. // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. // You may obtain a copy of the License at // // http://www.apache.org/licenses/LICENSE-2.0 // // Unless required by applicable law or agreed to in writing, software // distributed under the License is distributed on an "AS IS" BASIS, // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. // See the License for the specific language governing permissions and // limitations under the License. // 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 "parse-tree-visitor.h" #include "parse-tree.h" #include "../common/Fortran.h" #include "../common/idioms.h" #include "../common/indirection.h" #include #include #include #include namespace Fortran::parser { class UnparseVisitor { public: UnparseVisitor(std::ostream &out, int indentationAmount, Encoding encoding, bool capitalize, bool backslashEscapes, preStatementType *preStatement) : out_{out}, indentationAmount_{indentationAmount}, encoding_{encoding}, capitalizeKeywords_{capitalize}, backslashEscapes_{backslashEscapes}, preStatement_{preStatement} {} // In nearly all cases, this code avoids defining Boolean-valued Pre() // callbacks for the parse tree walking framework in favor of two void // functions, Before() and Unparse(), which imply true and false return // values for Pre() respectively. template void Before(const T &) {} template double Unparse(const T &); // not void, never used template bool Pre(const T &x) { if constexpr (std::is_void_v) { // There is a local definition of Unparse() for this type. It // overrides the parse tree walker's default Walk() over the descendents. Before(x); Unparse(x); Post(x); return false; // Walk() does not visit descendents } else { Before(x); return true; // there's no Unparse() defined here, Walk() the descendents } } template void Post(const T &) {} // Emit simple types as-is. void Unparse(const std::string &x) { Put(x); } void Unparse(int x) { Put(std::to_string(x)); } void Unparse(unsigned int x) { Put(std::to_string(x)); } void Unparse(long x) { Put(std::to_string(x)); } void Unparse(unsigned long x) { Put(std::to_string(x)); } void Unparse(long long x) { Put(std::to_string(x)); } void Unparse(unsigned long long x) { Put(std::to_string(x)); } void Unparse(char x) { Put(x); } // Statement labels and ends of lines template void Before(const Statement &x) { if (preStatement_) { (*preStatement_)(x.source, out_, indent_); } Walk(x.label, " "); } template void Post(const Statement &) { 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 Unparse(const Program &x) { // R501 Walk("", x.v, "\n"); // put blank lines between ProgramUnits } void Unparse(const Name &x) { // R603 Put(x.ToString()); } void Unparse(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: Put('.'), Word(DefinedOperator::EnumToString(x)), Put('.'); } } void Post(const Star &) { Put('*'); } // R701 &c. void Post(const TypeParamValue::Deferred &) { Put(':'); } // R701 void Unparse(const DeclarationTypeSpec::Type &x) { // R703 Word("TYPE("), Walk(x.derived), Put(')'); } void Unparse(const DeclarationTypeSpec::Class &x) { Word("CLASS("), Walk(x.derived), Put(')'); } void Post(const DeclarationTypeSpec::ClassStar &) { Word("CLASS(*)"); } void Post(const DeclarationTypeSpec::TypeStar &) { Word("TYPE(*)"); } void Unparse(const DeclarationTypeSpec::Record &x) { Word("RECORD/"), Walk(x.v), Put('/'); } void Before(const IntrinsicTypeSpec::Real &x) { // R704 Word("REAL"); } void Before(const IntrinsicTypeSpec::Complex &x) { Word("COMPLEX"); } void Post(const IntrinsicTypeSpec::DoublePrecision &) { Word("DOUBLE PRECISION"); } void Before(const IntrinsicTypeSpec::Character &x) { Word("CHARACTER"); } void Before(const IntrinsicTypeSpec::Logical &x) { Word("LOGICAL"); } void Post(const IntrinsicTypeSpec::DoubleComplex &) { Word("DOUBLE COMPLEX"); } void Before(const IntrinsicTypeSpec::NCharacter &x) { Word("NCHARACTER"); } void Before(const IntegerTypeSpec &x) { // R705 Word("INTEGER"); } void Unparse(const KindSelector &x) { // R706 std::visit( common::visitors{ [&](const ScalarIntConstantExpr &y) { Put('('), Word("KIND="), Walk(y), Put(')'); }, [&](const KindSelector::StarSize &y) { Put('*'), Walk(y.v); }, }, x.u); } void Unparse(const SignedIntLiteralConstant &x) { // R707 Walk(std::get(x.t)); Walk("_", std::get>(x.t)); } void Unparse(const IntLiteralConstant &x) { // R708 Walk(std::get(x.t)); Walk("_", std::get>(x.t)); } void Unparse(const Sign &x) { // R712 Put(x == Sign::Negative ? '-' : '+'); } void Unparse(const RealLiteralConstant &x) { // R714, R715 Put(x.real.source.ToString()), Walk("_", x.kind); } void Unparse(const ComplexLiteralConstant &x) { // R718 - R720 Put('('), Walk(x.t, ","), Put(')'); } void Unparse(const CharSelector::LengthAndKind &x) { // R721 Put('('), Word("KIND="), Walk(x.kind); Walk(", LEN=", x.length), Put(')'); } void Unparse(const LengthSelector &x) { // R722 std::visit( common::visitors{ [&](const TypeParamValue &y) { Put('('), Word("LEN="), Walk(y), Put(')'); }, [&](const CharLength &y) { Put('*'), Walk(y); }, }, x.u); } void Unparse(const CharLength &x) { // R723 std::visit( common::visitors{ [&](const TypeParamValue &y) { Put('('), Walk(y), Put(')'); }, [&](const std::int64_t &y) { Walk(y); }, }, x.u); } void Unparse(const CharLiteralConstant &x) { // R724 if (const auto &k{std::get>(x.t)}) { if (std::holds_alternative(k->u)) { Word("NC"); } else { Walk(*k), Put('_'); } } Put(QuoteCharacterLiteral( std::get(x.t), true, backslashEscapes_)); } void Before(const HollerithLiteralConstant &x) { std::optional chars{CountCharacters(x.v.data(), x.v.size(), encoding_ == Encoding::EUC_JP ? EUC_JPCharacterBytes : UTF8CharacterBytes)}; if (chars.has_value()) { Unparse(*chars); } else { Unparse(x.v.size()); } Put('H'); } void Unparse(const LogicalLiteralConstant &x) { // R725 Put(std::get(x.t) ? ".TRUE." : ".FALSE."); Walk("_", std::get>(x.t)); } void Unparse(const DerivedTypeStmt &x) { // R727 Word("TYPE"), Walk(", ", std::get>(x.t), ", "); Put(" :: "), Walk(std::get(x.t)); Walk("(", std::get>(x.t), ", ", ")"); Indent(); } void Unparse(const Abstract &x) { // R728, &c. Word("ABSTRACT"); } void Post(const TypeAttrSpec::BindC &) { Word("BIND(C)"); } void Unparse(const TypeAttrSpec::Extends &x) { Word("EXTENDS("), Walk(x.v), Put(')'); } void Unparse(const EndTypeStmt &x) { // R730 Outdent(), Word("END TYPE"), Walk(" ", x.v); } void Unparse(const SequenceStmt &x) { // R731 Word("SEQUENCE"); } void Unparse(const TypeParamDefStmt &x) { // R732 Walk(std::get(x.t)); Put(", "), Walk(std::get(x.t)); Put(" :: "), Walk(std::get>(x.t), ", "); } void Unparse(const TypeParamDecl &x) { // R733 Walk(std::get(x.t)); Walk("=", std::get>(x.t)); } void Unparse(const DataComponentDefStmt &x) { // R737 const auto &dts{std::get(x.t)}; const auto &attrs{std::get>(x.t)}; const auto &decls{std::get>(x.t)}; Walk(dts), Walk(", ", attrs, ", "); if (!attrs.empty() || (!std::holds_alternative(dts.u) && std::none_of( decls.begin(), decls.end(), [](const ComponentDecl &d) { const auto &init{ std::get>(d.t)}; return init.has_value() && std::holds_alternative< std::list>>( init->u); }))) { Put(" ::"); } Put(' '), Walk(decls, ", "); } void Unparse(const Allocatable &x) { // R738 Word("ALLOCATABLE"); } void Unparse(const Pointer &x) { Word("POINTER"); } void Unparse(const Contiguous &x) { Word("CONTIGUOUS"); } void Before(const ComponentAttrSpec &x) { std::visit( common::visitors{ [&](const CoarraySpec &) { Word("CODIMENSION["); }, [&](const ComponentArraySpec &) { Word("DIMENSION("); }, [](const auto &) {}, }, x.u); } void Post(const ComponentAttrSpec &x) { std::visit( common::visitors{ [&](const CoarraySpec &) { Put(']'); }, [&](const ComponentArraySpec &) { Put(')'); }, [](const auto &) {}, }, x.u); } void Unparse(const ComponentDecl &x) { // R739 Walk(std::get(x.t)); Walk("(", std::get>(x.t), ")"); Walk("[", std::get>(x.t), "]"); Walk("*", std::get>(x.t)); Walk(std::get>(x.t)); } void Unparse(const ComponentArraySpec &x) { // R740 std::visit( common::visitors{ [&](const std::list &y) { Walk(y, ","); }, [&](const DeferredShapeSpecList &y) { Walk(y); }, }, x.u); } void Unparse(const ProcComponentDefStmt &x) { // R741 Word("PROCEDURE("); Walk(std::get>(x.t)), Put(')'); Walk(", ", std::get>(x.t), ", "); Put(" :: "), Walk(std::get>(x.t), ", "); } void Unparse(const NoPass &x) { // R742 Word("NOPASS"); } void Unparse(const Pass &x) { Word("PASS"), Walk("(", x.v, ")"); } void Unparse(const Initialization &x) { // R743 & R805 std::visit( common::visitors{ [&](const ConstantExpr &y) { Put(" = "), Walk(y); }, [&](const NullInit &y) { Put(" => "), Walk(y); }, [&](const InitialDataTarget &y) { Put(" => "), Walk(y); }, [&](const std::list> &y) { Walk("/", y, ", ", "/"); }, }, x.u); } void Unparse(const PrivateStmt &x) { // R745 Word("PRIVATE"); } void Unparse(const TypeBoundProcedureStmt::WithoutInterface &x) { // R749 Word("PROCEDURE"), Walk(", ", x.attributes, ", "); Put(" :: "), Walk(x.declarations, ", "); } void Unparse(const TypeBoundProcedureStmt::WithInterface &x) { Word("PROCEDURE("), Walk(x.interfaceName), Put("), "); Walk(x.attributes); Put(" :: "), Walk(x.bindingNames, ", "); } void Unparse(const TypeBoundProcDecl &x) { // R750 Walk(std::get(x.t)); Walk(" => ", std::get>(x.t)); } void Unparse(const TypeBoundGenericStmt &x) { // R751 Word("GENERIC"), Walk(", ", std::get>(x.t)); Put(" :: "), Walk(std::get>(x.t)); Put(" => "), Walk(std::get>(x.t), ", "); } void Post(const BindAttr::Deferred &) { Word("DEFERRED"); } // R752 void Post(const BindAttr::Non_Overridable &) { Word("NON_OVERRIDABLE"); } void Unparse(const FinalProcedureStmt &x) { // R753 Word("FINAL :: "), Walk(x.v, ", "); } void Unparse(const DerivedTypeSpec &x) { // R754 Walk(std::get(x.t)); Walk("(", std::get>(x.t), ",", ")"); } void Unparse(const TypeParamSpec &x) { // R755 Walk(std::get>(x.t), "="); Walk(std::get(x.t)); } void Unparse(const StructureConstructor &x) { // R756 Walk(std::get(x.t)); Put('('), Walk(std::get>(x.t), ", "), Put(')'); } void Unparse(const ComponentSpec &x) { // R757 Walk(std::get>(x.t), "="); Walk(std::get(x.t)); } void Unparse(const EnumDefStmt &) { // R760 Word("ENUM, BIND(C)"), Indent(); } void Unparse(const EnumeratorDefStmt &x) { // R761 Word("ENUMERATOR :: "), Walk(x.v, ", "); } void Unparse(const Enumerator &x) { // R762 Walk(std::get(x.t)); Walk(" = ", std::get>(x.t)); } void Post(const EndEnumStmt &) { // R763 Outdent(), Word("END ENUM"); } void Unparse(const BOZLiteralConstant &x) { // R764 - R767 Put(x.v); } void Unparse(const AcValue::Triplet &x) { // R773 Walk(std::get<0>(x.t)), Put(':'), Walk(std::get<1>(x.t)); Walk(":", std::get>(x.t)); } void Unparse(const ArrayConstructor &x) { // R769 Put('['), Walk(x.v), Put(']'); } void Unparse(const AcSpec &x) { // R770 Walk(x.type, "::"), Walk(x.values, ", "); } template void Unparse(const LoopBounds &x) { Walk(x.name), Put('='), Walk(x.lower), Put(','), Walk(x.upper); Walk(",", x.step); } void Unparse(const AcImpliedDo &x) { // R774 Put('('), Walk(std::get>(x.t), ", "); Put(", "), Walk(std::get(x.t)), Put(')'); } void Unparse(const AcImpliedDoControl &x) { // R775 Walk(std::get>(x.t), "::"); Walk(std::get>(x.t)); } void Unparse(const TypeDeclarationStmt &x) { // R801 const auto &dts{std::get(x.t)}; const auto &attrs{std::get>(x.t)}; const auto &decls{std::get>(x.t)}; Walk(dts), Walk(", ", attrs, ", "); static const auto isInitializerOldStyle{[](const Initialization &i) { return std::holds_alternative< std::list>>(i.u); }}; static const auto hasAssignmentInitializer{[](const EntityDecl &d) { // Does a declaration have a new-style =x initializer? const auto &init{std::get>(d.t)}; return init.has_value() && !isInitializerOldStyle(*init); }}; static const auto hasSlashDelimitedInitializer{[](const EntityDecl &d) { // Does a declaration have an old-style /x/ initializer? const auto &init{std::get>(d.t)}; return init.has_value() && isInitializerOldStyle(*init); }}; const auto useDoubledColons{[&]() { bool isRecord{std::holds_alternative(dts.u)}; if (!attrs.empty()) { // Attributes after the type require :: before the entities. CHECK(!isRecord); return true; } if (std::any_of(decls.begin(), decls.end(), hasAssignmentInitializer)) { // Always use :: with new style standard initializers (=x), // since the standard requires them to appear (even in free form, // where mandatory spaces already disambiguate INTEGER J=666). CHECK(!isRecord); return true; } if (isRecord) { // Never put :: in a legacy extension RECORD// statement. return false; } // The :: is optional for this declaration. Avoid usage that can // crash the pgf90 compiler. if (std::any_of( decls.begin(), decls.end(), hasSlashDelimitedInitializer)) { // Don't use :: when a declaration uses legacy DATA-statement-like // /x/ initialization. return false; } // Don't use :: with intrinsic types. Otherwise, use it. return !std::holds_alternative(dts.u); }}; if (useDoubledColons()) { Put(" ::"); } Put(' '), Walk(std::get>(x.t), ", "); } void Before(const AttrSpec &x) { // R802 std::visit( common::visitors{ [&](const CoarraySpec &y) { Word("CODIMENSION["); }, [&](const ArraySpec &y) { Word("DIMENSION("); }, [](const auto &) {}, }, x.u); } void Post(const AttrSpec &x) { std::visit( common::visitors{ [&](const CoarraySpec &y) { Put(']'); }, [&](const ArraySpec &y) { Put(')'); }, [](const auto &) {}, }, x.u); } void Unparse(const EntityDecl &x) { // R803 Walk(std::get(x.t)); Walk("(", std::get>(x.t), ")"); Walk("[", std::get>(x.t), "]"); Walk("*", std::get>(x.t)); Walk(std::get>(x.t)); } void Unparse(const NullInit &x) { // R806 Word("NULL()"); } void Unparse(const LanguageBindingSpec &x) { // R808 & R1528 Word("BIND(C"), Walk(", NAME=", x.v), Put(')'); } void Unparse(const CoarraySpec &x) { // R809 std::visit( common::visitors{ [&](const DeferredCoshapeSpecList &y) { Walk(y); }, [&](const ExplicitCoshapeSpec &y) { Walk(y); }, }, x.u); } void Unparse(const DeferredCoshapeSpecList &x) { // R810 for (auto j{x.v}; j > 0; --j) { Put(':'); if (j > 1) { Put(','); } } } void Unparse(const ExplicitCoshapeSpec &x) { // R811 Walk(std::get>(x.t), ",", ","); Walk(std::get>(x.t), ":"), Put('*'); } void Unparse(const ExplicitShapeSpec &x) { // R812 - R813 & R816 - R818 Walk(std::get>(x.t), ":"); Walk(std::get(x.t)); } void Unparse(const ArraySpec &x) { // R815 std::visit( common::visitors{ [&](const std::list &y) { Walk(y, ","); }, [&](const std::list &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); } void Post(const AssumedShapeSpec &) { Put(':'); } // R819 void Unparse(const DeferredShapeSpecList &x) { // R820 for (auto j{x.v}; j > 0; --j) { Put(':'); if (j > 1) { Put(','); } } } void Unparse(const AssumedImpliedSpec &x) { // R821 Walk(x.v, ":"); Put('*'); } void Unparse(const AssumedSizeSpec &x) { // R822 Walk(std::get>(x.t), ",", ","); Walk(std::get(x.t)); } void Unparse(const ImpliedShapeSpec &x) { // R823 Walk(x.v, ","); } void Post(const AssumedRankSpec &) { Put(".."); } // R825 void Post(const Asynchronous &) { Word("ASYNCHRONOUS"); } void Post(const External &) { Word("EXTERNAL"); } void Post(const Intrinsic &) { Word("INTRINSIC"); } void Post(const Optional &) { Word("OPTIONAL"); } void Post(const Parameter &) { Word("PARAMETER"); } void Post(const Protected &) { Word("PROTECTED"); } void Post(const Save &) { Word("SAVE"); } void Post(const Target &) { Word("TARGET"); } void Post(const Value &) { Word("VALUE"); } void Post(const Volatile &) { Word("VOLATILE"); } void Unparse(const IntentSpec &x) { // R826 Word("INTENT("), Walk(x.v), Put(")"); } void Unparse(const AccessStmt &x) { // R827 Walk(std::get(x.t)); Walk(" :: ", std::get>(x.t), ", "); } void Unparse(const AllocatableStmt &x) { // R829 Word("ALLOCATABLE :: "), Walk(x.v, ", "); } void Unparse(const ObjectDecl &x) { // R830 & R860 Walk(std::get(x.t)); Walk("(", std::get>(x.t), ")"); Walk("[", std::get>(x.t), "]"); } void Unparse(const AsynchronousStmt &x) { // R831 Word("ASYNCHRONOUS :: "), Walk(x.v, ", "); } void Unparse(const BindStmt &x) { // R832 Walk(x.t, " :: "); } void Unparse(const BindEntity &x) { // R833 bool isCommon{std::get(x.t) == BindEntity::Kind::Common}; const char *slash{isCommon ? "/" : ""}; Put(slash), Walk(std::get(x.t)), Put(slash); } void Unparse(const CodimensionStmt &x) { // R834 Word("CODIMENSION :: "), Walk(x.v, ", "); } void Unparse(const CodimensionDecl &x) { // R835 Walk(std::get(x.t)); Put('['), Walk(std::get(x.t)), Put(']'); } void Unparse(const ContiguousStmt &x) { // R836 Word("CONTIGUOUS :: "), Walk(x.v, ", "); } void Unparse(const DataStmt &x) { // R837 Word("DATA "), Walk(x.v, ", "); } void Unparse(const DataStmtSet &x) { // R838 Walk(std::get>(x.t), ", "); Put('/'), Walk(std::get>(x.t), ", "), Put('/'); } void Unparse(const DataImpliedDo &x) { // R840, R842 Put('('), Walk(std::get>(x.t), ", "), Put(','); Walk(std::get>(x.t), "::"); Walk(std::get>(x.t)), Put(')'); } void Unparse(const DataStmtValue &x) { // R843 Walk(std::get>(x.t), "*"); Walk(std::get(x.t)); } void Unparse(const DimensionStmt &x) { // R848 Word("DIMENSION :: "), Walk(x.v, ", "); } void Unparse(const DimensionStmt::Declaration &x) { Walk(std::get(x.t)); Put('('), Walk(std::get(x.t)), Put(')'); } void Unparse(const IntentStmt &x) { // R849 Walk(x.t, " :: "); } void Unparse(const OptionalStmt &x) { // R850 Word("OPTIONAL :: "), Walk(x.v, ", "); } void Unparse(const ParameterStmt &x) { // R851 Word("PARAMETER("), Walk(x.v, ", "), Put(')'); } void Unparse(const NamedConstantDef &x) { // R852 Walk(x.t, "="); } void Unparse(const PointerStmt &x) { // R853 Word("POINTER :: "), Walk(x.v, ", "); } void Unparse(const PointerDecl &x) { // R854 Walk(std::get(x.t)); Walk("(", std::get>(x.t), ")"); } void Unparse(const ProtectedStmt &x) { // R855 Word("PROTECTED :: "), Walk(x.v, ", "); } void Unparse(const SaveStmt &x) { // R856 Word("SAVE"), Walk(" :: ", x.v, ", "); } void Unparse(const SavedEntity &x) { // R857, R858 bool isCommon{ std::get(x.t) == SavedEntity::Kind::Common}; const char *slash{isCommon ? "/" : ""}; Put(slash), Walk(std::get(x.t)), Put(slash); } void Unparse(const TargetStmt &x) { // R859 Word("TARGET :: "), Walk(x.v, ", "); } void Unparse(const ValueStmt &x) { // R861 Word("VALUE :: "), Walk(x.v, ", "); } void Unparse(const VolatileStmt &x) { // R862 Word("VOLATILE :: "), Walk(x.v, ", "); } void Unparse(const ImplicitStmt &x) { // R863 Word("IMPLICIT "); std::visit( common::visitors{ [&](const std::list &y) { Walk(y, ", "); }, [&](const std::list &y) { Word("NONE"), Walk(" (", y, ", ", ")"); }, }, x.u); } void Unparse(const ImplicitSpec &x) { // R864 Walk(std::get(x.t)); Put('('), Walk(std::get>(x.t), ", "), Put(')'); } void Unparse(const LetterSpec &x) { // R865 Put(*std::get(x.t)); auto second{std::get>(x.t)}; if (second.has_value()) { Put('-'), Put(**second); } } void Unparse(const ImportStmt &x) { // R867 Word("IMPORT"); switch (x.kind) { case common::ImportKind::Default: Walk(" :: ", x.names, ", "); break; case common::ImportKind::Only: Put(", "), Word("ONLY: "); Walk(x.names, ", "); break; case common::ImportKind::None: Word(", NONE"); break; case common::ImportKind::All: Word(", ALL"); break; default: CRASH_NO_CASE; } } void Unparse(const NamelistStmt &x) { // R868 Word("NAMELIST"), Walk(x.v, ", "); } void Unparse(const NamelistStmt::Group &x) { Put('/'), Walk(std::get(x.t)), Put('/'); Walk(std::get>(x.t), ", "); } void Unparse(const EquivalenceStmt &x) { // R870, R871 Word("EQUIVALENCE"); const char *separator{" "}; for (const std::list &y : x.v) { Put(separator), Put('('), Walk(y), Put(')'); separator = ", "; } } void Unparse(const CommonStmt &x) { // R873 Word("COMMON "); Walk(x.blocks); } void Unparse(const CommonBlockObject &x) { // R874 Walk(std::get(x.t)); Walk("(", std::get>(x.t), ")"); } void Unparse(const CommonStmt::Block &x) { Walk("/", std::get>(x.t), "/"); Walk(std::get>(x.t)); } void Unparse(const Substring &x) { // R908, R909 Walk(std::get(x.t)); Put('('), Walk(std::get(x.t)), Put(')'); } void Unparse(const CharLiteralConstantSubstring &x) { Walk(std::get(x.t)); Put('('), Walk(std::get(x.t)), Put(')'); } void Unparse(const SubstringRange &x) { // R910 Walk(x.t, ":"); } void Unparse(const PartRef &x) { // R912 Walk(x.name); Walk("(", x.subscripts, ",", ")"); Walk(x.imageSelector); } void Unparse(const StructureComponent &x) { // R913 Walk(x.base); if (structureComponents_.find(x.component.source) != structureComponents_.end()) { Put('.'); } else { Put('%'); } Walk(x.component); } void Unparse(const ArrayElement &x) { // R917 Walk(x.base); Put('('), Walk(x.subscripts, ","), Put(')'); } void Unparse(const SubscriptTriplet &x) { // R921 Walk(std::get<0>(x.t)), Put(':'), Walk(std::get<1>(x.t)); Walk(":", std::get<2>(x.t)); } void Unparse(const ImageSelector &x) { // R924 Put('['), Walk(std::get>(x.t), ","); Walk(",", std::get>(x.t), ","), Put(']'); } void Before(const ImageSelectorSpec::Stat &) { // R926 Word("STAT="); } void Before(const ImageSelectorSpec::Team &) { Word("TEAM="); } void Before(const ImageSelectorSpec::Team_Number &) { Word("TEAM_NUMBER="); } void Unparse(const AllocateStmt &x) { // R927 Word("ALLOCATE("); Walk(std::get>(x.t), "::"); Walk(std::get>(x.t), ", "); Walk(", ", std::get>(x.t), ", "), Put(')'); } void Before(const AllocOpt &x) { // R928, R931 std::visit( common::visitors{ [&](const AllocOpt::Mold &) { Word("MOLD="); }, [&](const AllocOpt::Source &) { Word("SOURCE="); }, [](const StatOrErrmsg &) {}, }, x.u); } void Unparse(const Allocation &x) { // R932 Walk(std::get(x.t)); Walk("(", std::get>(x.t), ",", ")"); Walk("[", std::get>(x.t), "]"); } void Unparse(const AllocateShapeSpec &x) { // R934 & R938 Walk(std::get>(x.t), ":"); Walk(std::get(x.t)); } void Unparse(const AllocateCoarraySpec &x) { // R937 Walk(std::get>(x.t), ",", ","); Walk(std::get>(x.t), ":"), Put('*'); } void Unparse(const NullifyStmt &x) { // R939 Word("NULLIFY("), Walk(x.v, ", "), Put(')'); } void Unparse(const DeallocateStmt &x) { // R941 Word("DEALLOCATE("); Walk(std::get>(x.t), ", "); Walk(", ", std::get>(x.t), ", "), Put(')'); } void Before(const StatOrErrmsg &x) { // R942 & R1165 std::visit( common::visitors{ [&](const StatVariable &) { Word("STAT="); }, [&](const MsgVariable &) { Word("ERRMSG="); }, }, x.u); } // R1001 - R1022 void Unparse(const Expr::Parentheses &x) { Put('('), Walk(x.v), Put(')'); } void Before(const Expr::UnaryPlus &x) { Put("+"); } void Before(const Expr::Negate &x) { Put("-"); } void Before(const Expr::NOT &x) { Word(".NOT."); } void Unparse(const Expr::PercentLoc &x) { Word("%LOC("), Walk(x.v), Put(')'); } void Unparse(const Expr::Power &x) { Walk(x.t, "**"); } void Unparse(const Expr::Multiply &x) { Walk(x.t, "*"); } void Unparse(const Expr::Divide &x) { Walk(x.t, "/"); } void Unparse(const Expr::Add &x) { Walk(x.t, "+"); } void Unparse(const Expr::Subtract &x) { Walk(x.t, "-"); } void Unparse(const Expr::Concat &x) { Walk(x.t, "//"); } void Unparse(const Expr::LT &x) { Walk(x.t, "<"); } void Unparse(const Expr::LE &x) { Walk(x.t, "<="); } void Unparse(const Expr::EQ &x) { Walk(x.t, "=="); } void Unparse(const Expr::NE &x) { Walk(x.t, "/="); } void Unparse(const Expr::GE &x) { Walk(x.t, ">="); } void Unparse(const Expr::GT &x) { Walk(x.t, ">"); } void Unparse(const Expr::AND &x) { Walk(x.t, ".AND."); } void Unparse(const Expr::OR &x) { Walk(x.t, ".OR."); } void Unparse(const Expr::EQV &x) { Walk(x.t, ".EQV."); } void Unparse(const Expr::NEQV &x) { Walk(x.t, ".NEQV."); } void Unparse(const Expr::XOR &x) { Walk(x.t, ".XOR."); } void Unparse(const Expr::ComplexConstructor &x) { Put('('), Walk(x.t, ","), Put(')'); } void Unparse(const Expr::DefinedBinary &x) { Walk(std::get<1>(x.t)); // left Walk(std::get(x.t)); Walk(std::get<2>(x.t)); // right } void Unparse(const DefinedOpName &x) { // R1003, R1023, R1414, & R1415 Walk(x.v); } void Unparse(const AssignmentStmt &x) { // R1032 Walk(x.t, " = "); } void Unparse(const PointerAssignmentStmt &x) { // R1033, R1034, R1038 Walk(std::get(x.t)); std::visit( common::visitors{ [&](const std::list &y) { Put('('), Walk(y), Put(')'); }, [&](const std::list &y) { Walk("(", y, ", ", ")"); }, }, std::get(x.t).u); Put(" => "), Walk(std::get(x.t)); } void Post(const BoundsSpec &) { // R1035 Put(':'); } void Unparse(const BoundsRemapping &x) { // R1036 Walk(x.t, ":"); } void Unparse(const WhereStmt &x) { // R1041, R1045, R1046 Word("WHERE ("), Walk(x.t, ") "); } void Unparse(const WhereConstructStmt &x) { // R1043 Walk(std::get>(x.t), ": "); Word("WHERE ("), Walk(std::get(x.t)), Put(')'); Indent(); } void Unparse(const MaskedElsewhereStmt &x) { // R1047 Outdent(); Word("ELSEWHERE ("), Walk(std::get(x.t)), Put(')'); Walk(" ", std::get>(x.t)); Indent(); } void Unparse(const ElsewhereStmt &x) { // R1048 Outdent(), Word("ELSEWHERE"), Walk(" ", x.v), Indent(); } void Unparse(const EndWhereStmt &x) { // R1049 Outdent(), Word("END WHERE"), Walk(" ", x.v); } void Unparse(const ForallConstructStmt &x) { // R1051 Walk(std::get>(x.t), ": "); Word("FORALL"), Walk(std::get>(x.t)); Indent(); } void Unparse(const EndForallStmt &x) { // R1054 Outdent(), Word("END FORALL"), Walk(" ", x.v); } void Before(const ForallStmt &) { // R1055 Word("FORALL"); } void Unparse(const AssociateStmt &x) { // R1103 Walk(std::get>(x.t), ": "); Word("ASSOCIATE ("); Walk(std::get>(x.t), ", "), Put(')'), Indent(); } void Unparse(const Association &x) { // R1104 Walk(x.t, " => "); } void Unparse(const EndAssociateStmt &x) { // R1106 Outdent(), Word("END ASSOCIATE"), Walk(" ", x.v); } void Unparse(const BlockStmt &x) { // R1108 Walk(x.v, ": "), Word("BLOCK"), Indent(); } void Unparse(const EndBlockStmt &x) { // R1110 Outdent(), Word("END BLOCK"), Walk(" ", x.v); } void Unparse(const ChangeTeamStmt &x) { // R1112 Walk(std::get>(x.t), ": "); Word("CHANGE TEAM ("), Walk(std::get(x.t)); Walk(", ", std::get>(x.t), ", "); Walk(", ", std::get>(x.t), ", "), Put(')'); Indent(); } void Unparse(const CoarrayAssociation &x) { // R1113 Walk(x.t, " => "); } void Unparse(const EndChangeTeamStmt &x) { // R1114 Outdent(), Word("END TEAM ("); Walk(std::get>(x.t), ", "); Put(')'), Walk(" ", std::get>(x.t)); } void Unparse(const CriticalStmt &x) { // R1117 Walk(std::get>(x.t), ": "); Word("CRITICAL ("), Walk(std::get>(x.t), ", "); Put(')'), Indent(); } void Unparse(const EndCriticalStmt &x) { // R1118 Outdent(), Word("END CRITICAL"), Walk(" ", x.v); } void Unparse(const DoConstruct &x) { // R1119, R1120 Walk(std::get>(x.t)); Indent(), Walk(std::get(x.t), ""), Outdent(); Walk(std::get>(x.t)); } void Unparse(const LabelDoStmt &x) { // R1121 Walk(std::get>(x.t), ": "); Word("DO "), Walk(std::get &x, const char *suffix = "") { if (x.has_value()) { Word(prefix), Walk(*x), Word(suffix); } } template void Walk(const std::optional &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 void Walk(const char *prefix, const std::list &list, const char *comma = ", ", const char *suffix = "") { if (!list.empty()) { const char *str{prefix}; for (const auto &x : list) { Word(str), Walk(x); str = comma; } Word(suffix); } } template void Walk(const std::list &list, const char *comma = ", ", const char *suffix = "") { return Walk("", list, comma, suffix); } // Traverse a std::tuple<>, with an optional separator. template void WalkTupleElements(const T &tuple, const char *separator) { if constexpr (J < std::tuple_size_v) { if (J > 0) { Word(separator); } Walk(std::get(tuple)); WalkTupleElements(tuple, separator); } } template void Walk(const std::tuple &tuple, const char *separator = "") { WalkTupleElements(tuple, separator); } void EndSubprogram(const char *kind, const std::optional &name) { Outdent(), Word("END "), Word(kind), Walk(" ", name); structureComponents_.clear(); } std::ostream &out_; int indent_{0}; const int indentationAmount_{1}; int column_{1}; const int maxColumns_{80}; std::set structureComponents_; Encoding encoding_{Encoding::UTF8}; bool capitalizeKeywords_{true}; bool openmpDirective_{false}; bool backslashEscapes_{false}; preStatementType *preStatement_{nullptr}; }; void UnparseVisitor::Put(char ch) { int sav = indent_; if (openmpDirective_) { indent_ = 0; } 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_ << ' '; } if (openmpDirective_) { out_ << "!$OMP&"; column_ = 8; } else { out_ << '&'; column_ = indent_ + 3; } } out_ << ch; if (openmpDirective_) { indent_ = sav; } } 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::PutKeywordLetter(char ch) { if (capitalizeKeywords_) { Put(ToUpperCaseLetter(ch)); } else { Put(ToLowerCaseLetter(ch)); } } void UnparseVisitor::Word(const char *str) { for (; *str != '\0'; ++str) { PutKeywordLetter(*str); } } void UnparseVisitor::Word(const std::string &str) { Word(str.c_str()); } void Unparse(std::ostream &out, const Program &program, Encoding encoding, bool capitalizeKeywords, bool backslashEscapes, preStatementType *preStatement) { UnparseVisitor visitor{ out, 1, encoding, capitalizeKeywords, backslashEscapes, preStatement}; Walk(program, visitor); visitor.Done(); } }