From 79d044e9b55d0f45329f6502ab11b41459b7aa91 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Wed, 28 Feb 2018 16:56:10 -0800 Subject: [PATCH] [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@8a1a0aa2dc5b4ba3fba2116d278affb51857ffb7 Reviewed-on: https://github.com/flang-compiler/f18/pull/25 Tree-same-pre-rewrite: false --- flang/lib/parser/CMakeLists.txt | 5 +- flang/lib/parser/basic-parsers.h | 33 +- flang/lib/parser/characters.cc | 70 + flang/lib/parser/characters.h | 63 +- flang/lib/parser/grammar.h | 132 +- flang/lib/parser/idioms.cc | 4 - flang/lib/parser/idioms.h | 47 - flang/lib/parser/indirection.h | 6 - flang/lib/parser/message.cc | 5 +- flang/lib/parser/message.h | 2 +- flang/lib/parser/parse-state.h | 38 +- flang/lib/parser/parse-tree-visitor.h | 1 + flang/lib/parser/parse-tree.cc | 735 -------- flang/lib/parser/parse-tree.h | 121 +- flang/lib/parser/parsing.cc | 84 + flang/lib/parser/parsing.h | 56 + flang/lib/parser/prescan.cc | 144 +- flang/lib/parser/prescan.h | 10 +- flang/lib/parser/provenance.cc | 13 +- flang/lib/parser/provenance.h | 1 + flang/lib/parser/token-parsers.h | 97 +- flang/lib/parser/token-sequence.cc | 12 +- flang/lib/parser/token-sequence.h | 2 +- flang/lib/parser/unparse.cc | 2255 +++++++++++++++++++++---- flang/lib/parser/unparse.h | 4 +- flang/lib/semantics/make-types.cc | 9 +- flang/tools/f18/CMakeLists.txt | 4 +- flang/tools/f18/f18.cc | 386 +++-- 28 files changed, 2816 insertions(+), 1523 deletions(-) create mode 100644 flang/lib/parser/characters.cc create mode 100644 flang/lib/parser/parsing.cc create mode 100644 flang/lib/parser/parsing.h diff --git a/flang/lib/parser/CMakeLists.txt b/flang/lib/parser/CMakeLists.txt index a5d8bfd4ba64..93c54cde6e67 100644 --- a/flang/lib/parser/CMakeLists.txt +++ b/flang/lib/parser/CMakeLists.txt @@ -1,9 +1,10 @@ - -add_library( FlangParser +add_library(FortranParser char-buffer.cc + characters.cc idioms.cc message.cc parse-tree.cc + parsing.cc preprocessor.cc prescan.cc provenance.cc diff --git a/flang/lib/parser/basic-parsers.h b/flang/lib/parser/basic-parsers.h index 5a97d62236bd..7125f52c0312 100644 --- a/flang/lib/parser/basic-parsers.h +++ b/flang/lib/parser/basic-parsers.h @@ -137,7 +137,10 @@ public: Messages messages{std::move(*state->messages())}; ParseState forked{*state}; state->messages()->swap(messages); - return parser_.Parse(&forked); + if (parser_.Parse(&forked).has_value()) { + return {Success{}}; + } + return {}; } private: @@ -242,6 +245,9 @@ public: state->messages()->swap(messages); return ax; } +#if 0 // needed below if "tied" messages are to be saved + auto start = backtrack.GetLocation(); +#endif ParseState paState{std::move(*state)}; state->swap(backtrack); state->set_context(context); @@ -253,11 +259,22 @@ public: } // Both alternatives failed. Retain the state (and messages) from the // alternative parse that went the furthest. - if (state->GetLocation() <= paState.GetLocation()) { + auto paEnd = paState.GetLocation(); + auto pbEnd = state->GetLocation(); + if (paEnd > pbEnd) { messages.Annex(paState.messages()); state->swap(paState); - } else { + } else if (paEnd < pbEnd) { messages.Annex(state->messages()); + } else { + // It's a tie. + messages.Annex(paState.messages()); +#if 0 + if (paEnd > start) { + // Both parsers consumed text; retain messages from both. + messages.Annex(state->messages()); + } +#endif } state->messages()->swap(messages); return {}; @@ -1196,8 +1213,8 @@ constexpr struct NextCharParser { } nextChar; // If a is a parser for nonstandard usage, extension(a) is a parser that -// is disabled if strict standard compliance is enforced, and enabled with -// a warning if such a warning is enabled. +// is disabled in strict conformance mode and otherwise sets a violation flag +// and may emit a warning message, if those are enabled. template class NonstandardParser { public: using resultType = typename PA::resultType; @@ -1210,6 +1227,7 @@ public: auto at = state->GetLocation(); auto result = parser_.Parse(state); if (result) { + state->set_anyConformanceViolation(); if (state->warnOnNonstandardUsage()) { state->PutMessage(at, "nonstandard usage"_en_US); } @@ -1226,8 +1244,8 @@ template inline constexpr auto extension(const PA &parser) { } // If a is a parser for deprecated usage, deprecated(a) is a parser that -// is disabled if strict standard compliance is enforced, and enabled with -// a warning if such a warning is enabled. +// is disabled if strict standard compliance is enforced,and otherwise +// sets of violation flag and may emit a warning. template class DeprecatedParser { public: using resultType = typename PA::resultType; @@ -1240,6 +1258,7 @@ public: auto at = state->GetLocation(); auto result = parser_.Parse(state); if (result) { + state->set_anyConformanceViolation(); if (state->warnOnDeprecatedUsage()) { state->PutMessage(at, "deprecated usage"_en_US); } diff --git a/flang/lib/parser/characters.cc b/flang/lib/parser/characters.cc new file mode 100644 index 000000000000..7d0dbd1429c6 --- /dev/null +++ b/flang/lib/parser/characters.cc @@ -0,0 +1,70 @@ +#include "characters.h" + +namespace Fortran { +namespace parser { + +std::optional UTF8CharacterBytes(const char *p) { + if ((*p & 0x80) == 0) { + return 1; + } + if ((*p & 0xf8) == 0xf0) { + if ((p[1] & 0xc0) == 0x80 && (p[2] & 0xc0) == 0x80 && + (p[3] & 0xc0) == 0x80) { + return {4}; + } + } else if ((*p & 0xf0) == 0xe0) { + if ((p[1] & 0xc0) == 0x80 && (p[2] & 0xc0) == 0x80) { + return {3}; + } + } else if ((*p & 0xe0) == 0xc0) { + if ((p[1] & 0xc0) == 0x80) { + return {2}; + } + } + return {}; +} + +std::optional EUC_JPCharacterBytes(const char *p) { + int b1 = *p & 0xff; + if (b1 <= 0x7f) { + return {1}; + } + if (b1 >= 0xa1 && b1 <= 0xfe) { + int b2 = p[1] & 0xff; + if (b2 >= 0xa1 && b2 <= 0xfe) { + // JIS X 0208 (code set 1) + return {2}; + } + } else if (b1 == 0x8e) { + int b2 = p[1] & 0xff; + if (b2 >= 0xa1 && b2 <= 0xdf) { + // upper half JIS 0201 (half-width kana, code set 2) + return {2}; + } + } else if (b1 == 0x8f) { + int b2 = p[1] & 0xff; + int b3 = p[2] & 0xff; + if (b2 >= 0xa1 && b2 <= 0xfe && b3 >= 0xa1 && b3 <= 0xfe) { + // JIS X 0212 (code set 3) + return {3}; + } + } + return {}; +} + +std::optional CountCharacters( + const char *p, size_t bytes, std::optional (*cbf)(const char *)) { + size_t chars{0}; + const char *limit{p + bytes}; + while (p < limit) { + ++chars; + if (std::optional cb{cbf(p)}) { + p += *cb; + } else { + return {}; + } + } + return {chars}; +} +} // namespace parser +} // namespace Fortran diff --git a/flang/lib/parser/characters.h b/flang/lib/parser/characters.h index 7684e3d281c5..4e1e1d0bdf8a 100644 --- a/flang/lib/parser/characters.h +++ b/flang/lib/parser/characters.h @@ -11,6 +11,8 @@ namespace Fortran { namespace parser { +enum class Encoding { UTF8, EUC_JP }; + static constexpr bool IsUpperCaseLetter(char ch) { if constexpr ('A' == static_cast(0xc1)) { // EBCDIC @@ -60,10 +62,6 @@ static constexpr char ToLowerCaseLetter(char &&ch) { return IsUpperCaseLetter(ch) ? ch - 'A' + 'a' : ch; } -static constexpr bool IsSameApartFromCase(char x, char y) { - return ToLowerCaseLetter(x) == ToLowerCaseLetter(y); -} - static inline std::string ToLowerCaseLetters(const std::string &str) { std::string lowered{str}; for (char &ch : lowered) { @@ -72,6 +70,26 @@ static inline std::string ToLowerCaseLetters(const std::string &str) { return lowered; } +static constexpr char ToUpperCaseLetter(char ch) { + return IsLowerCaseLetter(ch) ? ch - 'a' + 'A' : ch; +} + +static constexpr char ToUpperCaseLetter(char &&ch) { + return IsLowerCaseLetter(ch) ? ch - 'a' + 'A' : ch; +} + +static inline std::string ToUpperCaseLetters(const std::string &str) { + std::string raised{str}; + for (char &ch : raised) { + ch = ToUpperCaseLetter(ch); + } + return raised; +} + +static constexpr bool IsSameApartFromCase(char x, char y) { + return ToLowerCaseLetter(x) == ToLowerCaseLetter(y); +} + static constexpr char DecimalDigitValue(char ch) { return ch - '0'; } static constexpr char HexadecimalDigitValue(char ch) { @@ -82,7 +100,7 @@ static constexpr char HexadecimalDigitValue(char ch) { static constexpr std::optional BackslashEscapeValue(char ch) { switch (ch) { - case 'a': return {'\a'}; + // case 'a': return {'\a'}; pgf90 doesn't know about \a case 'b': return {'\b'}; case 'f': return {'\f'}; case 'n': return {'\n'}; @@ -98,7 +116,7 @@ static constexpr std::optional BackslashEscapeValue(char ch) { static constexpr std::optional BackslashEscapeChar(char ch) { switch (ch) { - case '\a': return {'a'}; + // case '\a': return {'a'}; pgf90 doesn't know about \a case '\b': return {'b'}; case '\f': return {'f'}; case '\n': return {'n'}; @@ -111,6 +129,39 @@ static constexpr std::optional BackslashEscapeChar(char ch) { default: return {}; } } + +template +void EmitQuotedChar(char ch, const NORMAL &emit, const INSERTED &insert, + bool doubleDoubleQuotes = true, bool doubleBackslash = true) { + if (ch == '"') { + if (doubleDoubleQuotes) { + insert('"'); + } + emit('"'); + } else if (ch == '\\') { + if (doubleBackslash) { + insert('\\'); + } + emit('\\'); + } else if (ch < ' ') { + insert('\\'); + if (std::optional escape{BackslashEscapeChar(ch)}) { + emit(*escape); + } else { + // octal escape sequence + insert('0' + ((ch >> 6) & 3)); + insert('0' + ((ch >> 3) & 7)); + insert('0' + (ch & 7)); + } + } else { + emit(ch); + } +} + +std::optional UTF8CharacterBytes(const char *); +std::optional EUC_JPCharacterBytes(const char *); +std::optional CountCharacters( + const char *, size_t bytes, std::optional (*)(const char *)); } // namespace parser } // namespace Fortran #endif // FORTRAN_PARSER_CHARACTERS_H_ diff --git a/flang/lib/parser/grammar.h b/flang/lib/parser/grammar.h index 54d83853f26d..8fa2cf02317f 100644 --- a/flang/lib/parser/grammar.h +++ b/flang/lib/parser/grammar.h @@ -97,6 +97,7 @@ constexpr Parser intentSpec; // R826 constexpr Parser dataStmt; // R837 constexpr Parser dataImpliedDo; // R840 constexpr Parser parameterStmt; // R851 +constexpr Parser oldParameterStmt; constexpr Parser designator; // R901 constexpr Parser variable; // R902 constexpr Parser substring; // R908 @@ -192,18 +193,22 @@ template inline constexpr auto statement(const PA &p) { return unterminatedStatement(p) / endOfStmt; } +constexpr auto ignoredStatementPrefix = skipMany("\n"_tok) >> + maybe(label) >> spaces; + // Error recovery within statements: skip to the end of the line, // but not over an END or CONTAINS statement. -constexpr auto skipToEndOfLine = SkipTo<'\n'>{} >> construct{}; +constexpr auto errorRecovery = construct{}; +constexpr auto skipToEndOfLine = SkipTo<'\n'>{} >> errorRecovery; constexpr auto stmtErrorRecovery = !"END"_tok >> !"CONTAINS"_tok >> skipToEndOfLine; // Error recovery across statements: skip the line, unless it looks // like it might end the containing construct. -constexpr auto errorRecoveryStart = skipMany("\n"_tok) >> maybe(label); -constexpr auto skipBadLine = SkipPast<'\n'>{} >> construct{}; +constexpr auto errorRecoveryStart = ignoredStatementPrefix; +constexpr auto skipBadLine = SkipPast<'\n'>{} >> errorRecovery; constexpr auto executionPartErrorRecovery = errorRecoveryStart >> !"END"_tok >> - !"ELSE"_tok >> !"CONTAINS"_tok >> !"CASE"_tok >> !"TYPE IS"_tok >> + !"CONTAINS"_tok >> !"ELSE"_tok >> !"CASE"_tok >> !"TYPE IS"_tok >> !"CLASS"_tok >> !"RANK"_tok >> skipBadLine; // R507 declaration-construct -> @@ -229,6 +234,8 @@ TYPE_CONTEXT_PARSER("specification construct"_en_US, construct{}(indirect(interfaceBlock)) || construct{}( statement(indirect(parameterStmt))) || + construct{}( + statement(indirect(oldParameterStmt))) || construct{}( statement(indirect(Parser{}))) || construct{}( @@ -383,11 +390,12 @@ struct StartNewSubprogram { } } startNewSubprogram; -TYPE_PARSER(construct{}( - // statements consume only trailing noise; consume leading noise here. - skipMany("\n"_tok) >> - some(startNewSubprogram >> Parser{} / endOfLine) / - consumedAllInput)) +TYPE_PARSER( + construct{}( + // statements consume only trailing noise; consume leading noise here. + skipMany("\n"_tok) >> + some(startNewSubprogram >> Parser{} / endOfLine)) / + consumedAllInput) // R502 program-unit -> // main-program | external-subprogram | module | submodule | block-data @@ -419,6 +427,7 @@ TYPE_CONTEXT_PARSER("implicit part"_en_US, TYPE_PARSER(construct{}( statement(indirect(Parser{}))) || construct{}(statement(indirect(parameterStmt))) || + construct{}(statement(indirect(oldParameterStmt))) || construct{}(statement(indirect(formatStmt))) || construct{}(statement(indirect(entryStmt)))) @@ -484,7 +493,6 @@ constexpr auto actionStmt = construct{}( construct{}(indirect(Parser{})) || construct{}(indirect(Parser{})) || construct{}(indirect(forallStmt)) || - construct{}(indirect(Parser{})) || construct{}(indirect(Parser{})) || construct{}(indirect(Parser{})) || construct{}(indirect(Parser{})) || @@ -552,6 +560,15 @@ constexpr auto executableConstruct = // R510 execution-part-construct -> // executable-construct | format-stmt | entry-stmt | data-stmt // Extension (PGI/Intel): also accept NAMELIST in execution part +constexpr auto obsoleteExecutionPartConstruct = recovery( + ignoredStatementPrefix >> + fail( + "obsolete legacy extension is not supported"_en_US), + construct{}( + statement("REDIMENSION" >> name >> + parenthesized(nonemptyList(Parser{})) >> ok) >> + errorRecovery)); + TYPE_CONTEXT_PARSER("execution part construct"_en_US, recovery(construct{}(executableConstruct) || construct{}( @@ -561,7 +578,8 @@ TYPE_CONTEXT_PARSER("execution part construct"_en_US, construct{}( statement(indirect(dataStmt))) || extension(construct{}( - statement(indirect(Parser{})))), + statement(indirect(Parser{}))) || + obsoleteExecutionPartConstruct), construct{}(executionPartErrorRecovery))) // R509 execution-part -> executable-construct [execution-part-construct]... @@ -691,17 +709,11 @@ TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US, TYPE_PARSER(construct{}("INTEGER" >> maybe(kindSelector))) // R706 kind-selector -> ( [KIND =] scalar-int-constant-expr ) -// Extension: -// kind-selector -> * digit-string -constexpr auto extStarKindExpr = extension("*"_tok >> - (scalar(integer( - constant(indirect(construct{}(construct{}( - construct{}(spaces >> digitString, - construct>{}))))))))); - +// Legacy extension: kind-selector -> * digit-string TYPE_PARSER(construct{}( - parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr) || - extStarKindExpr)) + parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) || + extension(construct{}( + construct{}("*" >> digitString)))) // R707 signed-int-literal-constant -> [sign] int-literal-constant static inline std::int64_t negate(std::uint64_t &&n) { @@ -875,9 +887,9 @@ TYPE_CONTEXT_PARSER("derived type definition"_en_US, // TYPE [[, type-attr-spec-list] ::] type-name [( // type-param-name-list )] TYPE_CONTEXT_PARSER("TYPE statement"_en_US, - "TYPE" >> construct{}( - optionalBeforeColons(nonemptyList(Parser{})), - name, defaulted(parenthesized(nonemptyList(name))))) + construct{}( + "TYPE" >> optionalBeforeColons(nonemptyList(Parser{})), + name, defaulted(parenthesized(nonemptyList(name))))) // R728 type-attr-spec -> // ABSTRACT | access-spec | BIND(C) | EXTENDS ( parent-type-name ) @@ -1305,8 +1317,8 @@ TYPE_PARSER(construct{}( languageBindingSpec / maybe("::"_tok), nonemptyList(Parser{}))) // R833 bind-entity -> entity-name | / common-block-name / -TYPE_PARSER(construct{}(name, pure(false)) || - "/" >> construct{}(name, pure(true /*COMMON*/)) / "/") +TYPE_PARSER(construct{}(pure(BindEntity::Kind::Object), name) || + "/" >> construct{}(pure(BindEntity::Kind::Common), name) / "/") // R834 codimension-stmt -> CODIMENSION [::] codimension-decl-list TYPE_PARSER("CODIMENSION" >> maybe("::"_tok) >> @@ -1396,12 +1408,13 @@ TYPE_PARSER("OPTIONAL" >> maybe("::"_tok) >> construct{}(nonemptyList(name))) // R851 parameter-stmt -> PARAMETER ( named-constant-def-list ) -// Legacy extension: omitted parentheses +// Legacy extension: omitted parentheses, no implicit typing from names TYPE_CONTEXT_PARSER("PARAMETER statement"_en_US, - "PARAMETER" >> - construct{}( - parenthesized(nonemptyList(Parser{})) || - extension(nonemptyList(Parser{})))) + construct{}( + "PARAMETER" >> parenthesized(nonemptyList(Parser{})))) +TYPE_CONTEXT_PARSER("old style PARAMETER statement"_en_US, + extension(construct{}( + "PARAMETER" >> nonemptyList(Parser{})))) // R852 named-constant-def -> named-constant = constant-expr TYPE_PARSER(construct{}(namedConstant, "=" >> constantExpr)) @@ -1425,8 +1438,10 @@ TYPE_PARSER("SAVE" >> construct{}(defaulted(maybe("::"_tok) >> // R857 saved-entity -> object-name | proc-pointer-name | / common-block-name / // R858 proc-pointer-name -> name -TYPE_PARSER(construct{}(name, pure(false)) || - "/" >> construct{}(name, pure(true /*COMMON*/)) / "/") +// TODO: Distinguish Kind::ProcPointer and Kind::Object +TYPE_PARSER(construct{}(pure(SavedEntity::Kind::Object), name) || + "/" >> + construct{}(pure(SavedEntity::Kind::Common), name) / "/") // R859 target-stmt -> TARGET [::] target-decl-list TYPE_PARSER("TARGET" >> maybe("::"_tok) >> @@ -2871,25 +2886,30 @@ TYPE_PARSER(maybe("UNIT ="_tok) >> construct{}(fileUnitNumber) || "IOMSG =" >> construct{}(msgVariable) || "IOSTAT =" >> construct{}(statVariable)) +template std::list singletonList(A &&x) { + std::list result; + result.push_front(std::move(x)); + return result; +} +constexpr auto bareUnitNumberAsList = + applyFunction(singletonList, + construct{}(fileUnitNumber)); +constexpr auto positionOrFlushSpecList = + parenthesized(nonemptyList(positionOrFlushSpec)) || bareUnitNumberAsList; + // R1224 backspace-stmt -> // BACKSPACE file-unit-number | BACKSPACE ( position-spec-list ) TYPE_CONTEXT_PARSER("BACKSPACE statement"_en_US, - "BACKSPACE" >> (construct{}(fileUnitNumber) || - construct{}( - parenthesized(nonemptyList(positionOrFlushSpec))))) + construct{}("BACKSPACE" >> positionOrFlushSpecList)) // R1225 endfile-stmt -> // ENDFILE file-unit-number | ENDFILE ( position-spec-list ) TYPE_CONTEXT_PARSER("ENDFILE statement"_en_US, - "ENDFILE" >> (construct{}(fileUnitNumber) || - construct{}( - parenthesized(nonemptyList(positionOrFlushSpec))))) + construct{}("ENDFILE" >> positionOrFlushSpecList)) // R1226 rewind-stmt -> REWIND file-unit-number | REWIND ( position-spec-list ) TYPE_CONTEXT_PARSER("REWIND statement"_en_US, - "REWIND" >> (construct{}(fileUnitNumber) || - construct{}( - parenthesized(nonemptyList(positionOrFlushSpec))))) + construct{}("REWIND" >> positionOrFlushSpecList)) // R1227 position-spec -> // [UNIT =] file-unit-number | IOMSG = iomsg-variable | @@ -2905,9 +2925,7 @@ TYPE_PARSER( // R1228 flush-stmt -> FLUSH file-unit-number | FLUSH ( flush-spec-list ) TYPE_CONTEXT_PARSER("FLUSH statement"_en_US, - "FLUSH" >> (construct{}(fileUnitNumber) || - construct{}( - parenthesized(nonemptyList(positionOrFlushSpec))))) + construct{}("FLUSH" >> positionOrFlushSpecList)) // R1231 inquire-spec -> // [UNIT =] file-unit-number | FILE = file-name-expr | @@ -3229,8 +3247,10 @@ TYPE_CONTEXT_PARSER("main program"_en_US, unterminatedStatement(endProgramStmt))) // R1402 program-stmt -> PROGRAM program-name -TYPE_CONTEXT_PARSER( - "PROGRAM statement"_en_US, construct{}("PROGRAM" >> name)) +// PGI allows empty parentheses after the name. +TYPE_CONTEXT_PARSER("PROGRAM statement"_en_US, + construct{}( + "PROGRAM" >> name / maybe(extension(parenthesized(ok))))) // R1403 end-program-stmt -> END [PROGRAM [program-name]] TYPE_CONTEXT_PARSER("END PROGRAM statement"_en_US, @@ -3616,18 +3636,14 @@ TYPE_PARSER(construct{}( name, parenthesized(optionalList(name)), "=" >> scalar(expr))) // Extension and deprecated statements -TYPE_PARSER(extension( - "POINTER" >> parenthesized(construct{}(objectName / ",", - objectName, maybe(Parser{}))))) +TYPE_PARSER( + extension(construct{}("POINTER (" >> objectName / ",", + objectName, maybe(Parser{}) / ")"))) -TYPE_PARSER(extension("REDIMENSION" >> - construct{}( - objectName, parenthesized(nonemptyList(Parser{}))))) - -TYPE_PARSER("STRUCTURE /" >> - construct{}(name / "/", optionalList(entityDecl)) || - "STRUCTURE" >> - construct{}(name, defaulted(cut >> many(entityDecl)))) +TYPE_PARSER(construct{}("STRUCTURE /" >> name / "/", pure(true), + optionalList(entityDecl)) || + construct{}( + "STRUCTURE" >> name, pure(false), defaulted(cut >> many(entityDecl)))) TYPE_PARSER( construct{}(statement(Parser{})) || diff --git a/flang/lib/parser/idioms.cc b/flang/lib/parser/idioms.cc index 7ffa1524ea5f..4600ee196244 100644 --- a/flang/lib/parser/idioms.cc +++ b/flang/lib/parser/idioms.cc @@ -15,9 +15,5 @@ namespace parser { fputc('\n', stderr); std::abort(); } - -std::ostream &operator<<(std::ostream &o, const std::monostate &) { - return o << "(empty variant)"; -} } // namespace parser } // namespace Fortran diff --git a/flang/lib/parser/idioms.h b/flang/lib/parser/idioms.h index b0d9bb2df3d8..04fa18ec028f 100644 --- a/flang/lib/parser/idioms.h +++ b/flang/lib/parser/idioms.h @@ -17,7 +17,6 @@ #include #include -#include #include #include #include @@ -58,8 +57,6 @@ template visitors(LAMBDAS... x)->visitors; template bool operator!(const std::optional &x) { return !x.has_value(); } -} // namespace parser -} // namespace Fortran // For switch statements without default: labels. #define CRASH_NO_CASE \ @@ -105,50 +102,6 @@ template struct BadType : std::false_type {}; } \ } \ template constexpr bool T { class_trait_ns_##T::trait_value() } - -// Formatting -// TODO: remove when unparser is up and running -namespace Fortran { -namespace parser { -template -std::ostream &operator<<(std::ostream &o, const std::optional &x) { - if (x.has_value()) { - return o << x.value(); - } - return o << "()"; -} - -template -std::ostream &operator<<(std::ostream &o, const std::list &xs) { - if (xs.empty()) { - return o << "[]"; - } - char marker{'['}; - for (const auto &x : xs) { - o << marker << x; - marker = ' '; - } - return o << ']'; -} - -template -std::ostream &formatTuple(std::ostream &o, const T &x) { - if constexpr (J < std::tuple_size_v) { - return formatTuple(o << std::get(x), x); - } - return o; -} - -template -std::ostream &operator<<(std::ostream &o, const std::tuple &xs) { - return formatTuple<0>(o << '{', xs) << '}'; -} - -template -std::ostream &operator<<(std::ostream &o, const std::variant &x) { - return std::visit( - [&o](const auto &y) -> std::ostream & { return o << y; }, x); -} } // namespace parser } // namespace Fortran #endif // FORTRAN_PARSER_IDIOMS_H_ diff --git a/flang/lib/parser/indirection.h b/flang/lib/parser/indirection.h index 17c465447d21..548021cd14cf 100644 --- a/flang/lib/parser/indirection.h +++ b/flang/lib/parser/indirection.h @@ -7,7 +7,6 @@ // Intended to be as invisible as possible. #include "idioms.h" -#include #include namespace Fortran { @@ -51,11 +50,6 @@ public: private: A *p_{nullptr}; }; - -template -std::ostream &operator<<(std::ostream &o, const Indirection &x) { - return o << *x; -} } // namespace parser } // namespace Fortran #endif // FORTRAN_PARSER_INDIRECTION_H_ diff --git a/flang/lib/parser/message.cc b/flang/lib/parser/message.cc index e3d49271099d..85c629fd177c 100644 --- a/flang/lib/parser/message.cc +++ b/flang/lib/parser/message.cc @@ -73,8 +73,11 @@ Provenance Message::Emit( return provenance_; } -void Messages::Emit(std::ostream &o) const { +void Messages::Emit(std::ostream &o, const char *prefix) const { for (const auto &msg : messages_) { + if (prefix) { + o << prefix; + } if (msg.context()) { o << "In the context "; } diff --git a/flang/lib/parser/message.h b/flang/lib/parser/message.h index aa28151ba65e..b58664530338 100644 --- a/flang/lib/parser/message.h +++ b/flang/lib/parser/message.h @@ -153,7 +153,7 @@ public: } } - void Emit(std::ostream &) const; + void Emit(std::ostream &, const char *prefix = nullptr) const; private: const AllSources &allSources_; diff --git a/flang/lib/parser/parse-state.h b/flang/lib/parser/parse-state.h index a6a1e408ff87..abed10390966 100644 --- a/flang/lib/parser/parse-state.h +++ b/flang/lib/parser/parse-state.h @@ -7,6 +7,7 @@ // attempts. Must be efficient to duplicate and assign for backtracking // and recovery during parsing! +#include "characters.h" #include "idioms.h" #include "message.h" #include "provenance.h" @@ -31,19 +32,21 @@ public: : cooked_{that.cooked_}, p_{that.p_}, limit_{that.limit_}, column_{that.column_}, messages_{*that.cooked_.allSources()}, userState_{that.userState_}, inFixedForm_{that.inFixedForm_}, - strictConformance_{that.strictConformance_}, + encoding_{that.encoding_}, strictConformance_{that.strictConformance_}, warnOnNonstandardUsage_{that.warnOnNonstandardUsage_}, warnOnDeprecatedUsage_{that.warnOnDeprecatedUsage_}, - anyErrorRecovery_{that.anyErrorRecovery_} {} + anyErrorRecovery_{that.anyErrorRecovery_}, + anyConformanceViolation_{that.anyConformanceViolation_} {} ParseState(ParseState &&that) : cooked_{that.cooked_}, p_{that.p_}, limit_{that.limit_}, column_{that.column_}, messages_{std::move(that.messages_)}, context_{std::move(that.context_)}, userState_{that.userState_}, - inFixedForm_{that.inFixedForm_}, + inFixedForm_{that.inFixedForm_}, encoding_{that.encoding_}, strictConformance_{that.strictConformance_}, warnOnNonstandardUsage_{that.warnOnNonstandardUsage_}, warnOnDeprecatedUsage_{that.warnOnDeprecatedUsage_}, - anyErrorRecovery_{that.anyErrorRecovery_} {} + anyErrorRecovery_{that.anyErrorRecovery_}, + anyConformanceViolation_{that.anyConformanceViolation_} {} ParseState &operator=(ParseState &&that) { swap(that); return *this; @@ -64,6 +67,9 @@ public: bool anyErrorRecovery() const { return anyErrorRecovery_; } void set_anyErrorRecovery() { anyErrorRecovery_ = true; } + bool anyConformanceViolation() const { return anyConformanceViolation_; } + void set_anyConformanceViolation() { anyConformanceViolation_ = true; } + UserState *userState() const { return userState_; } void set_userState(UserState *u) { userState_ = u; } @@ -97,6 +103,12 @@ public: return *this; } + Encoding encoding() const { return encoding_; } + ParseState &set_encoding(Encoding encoding) { + encoding_ = encoding; + return *this; + } + const char *GetLocation() const { return p_; } Provenance GetProvenance(const char *at) const { return cooked_.GetProvenance(at).start(); @@ -142,16 +154,20 @@ public: bool IsAtEnd() const { return p_ >= limit_; } + char UncheckedAdvance() { + ++column_; + char ch{*p_++}; + if (ch == '\n') { + column_ = 1; + } + return ch; + } + std::optional GetNextChar() { if (p_ >= limit_) { return {}; } - char ch{*p_++}; - ++column_; - if (ch == '\n') { - column_ = 1; - } - return {ch}; + return {UncheckedAdvance()}; } std::optional PeekAtNextChar() { @@ -174,10 +190,12 @@ private: UserState *userState_{nullptr}; bool inFixedForm_{false}; + Encoding encoding_{Encoding::UTF8}; bool strictConformance_{false}; bool warnOnNonstandardUsage_{false}; bool warnOnDeprecatedUsage_{false}; bool anyErrorRecovery_{false}; + bool anyConformanceViolation_{false}; // NOTE: Any additions or modifications to these data members must also be // reflected in the copy and move constructors defined at the top of this // class definition! diff --git a/flang/lib/parser/parse-tree-visitor.h b/flang/lib/parser/parse-tree-visitor.h index 56d7af4d1300..d89dc961d98a 100644 --- a/flang/lib/parser/parse-tree-visitor.h +++ b/flang/lib/parser/parse-tree-visitor.h @@ -124,6 +124,7 @@ void Walk(const DefaultChar &x, V &visitor) { template void Walk(const Statement &x, V &visitor) { if (visitor.Pre(x)) { + // N.B. the label is not traversed Walk(x.statement, visitor); visitor.Post(x); } diff --git a/flang/lib/parser/parse-tree.cc b/flang/lib/parser/parse-tree.cc index 3d17ac868377..cf98176a6a56 100644 --- a/flang/lib/parser/parse-tree.cc +++ b/flang/lib/parser/parse-tree.cc @@ -6,566 +6,6 @@ namespace Fortran { namespace parser { -#define UNION_FORMATTER(TYPE) \ - std::ostream &operator<<(std::ostream &o, const TYPE &x) { \ - return o << "(" #TYPE " " << x.u << ')'; \ - } - -UNION_FORMATTER(ProgramUnit) // R502 -UNION_FORMATTER(ImplicitPartStmt) // R506 -UNION_FORMATTER(DeclarationConstruct) // R507 -UNION_FORMATTER(SpecificationConstruct) // R508 -UNION_FORMATTER(ExecutionPartConstruct) // R510 -UNION_FORMATTER(InternalSubprogram) // R512 -UNION_FORMATTER(OtherSpecificationStmt) // R513 -UNION_FORMATTER(ExecutableConstruct) // R514 -UNION_FORMATTER(ActionStmt) // R515 -UNION_FORMATTER(ConstantValue) // R604 -UNION_FORMATTER(LiteralConstant) // R605 -UNION_FORMATTER(DefinedOperator) // R609 -UNION_FORMATTER(TypeParamValue) // R701 -UNION_FORMATTER(TypeSpec) // R702 -UNION_FORMATTER(DeclarationTypeSpec) // R703 -UNION_FORMATTER(IntrinsicTypeSpec) // R704 -UNION_FORMATTER(KindParam) // R709 -UNION_FORMATTER(CharSelector) // R721 -UNION_FORMATTER(ComplexPart) // R718 & R719 -UNION_FORMATTER(LengthSelector) // R722 -UNION_FORMATTER(CharLength) // R723 -UNION_FORMATTER(TypeAttrSpec) // R728 -UNION_FORMATTER(PrivateOrSequence) // R729 -UNION_FORMATTER(ComponentDefStmt) // R736 -UNION_FORMATTER(ComponentAttrSpec) // R738 -UNION_FORMATTER(ComponentArraySpec) // R740 -UNION_FORMATTER(ProcComponentAttrSpec) // R742 -UNION_FORMATTER(Initialization) // R743 & R805 -UNION_FORMATTER(TypeBoundProcBinding) // R748 -UNION_FORMATTER(TypeBoundProcedureStmt) // R749 -UNION_FORMATTER(BindAttr) // R752 -UNION_FORMATTER(AcValue) // R773 -UNION_FORMATTER(AttrSpec) // R802 -UNION_FORMATTER(CoarraySpec) // R809 -UNION_FORMATTER(ArraySpec) // R815 -UNION_FORMATTER(AccessId) // R828 -UNION_FORMATTER(DataStmtObject) // R839 -UNION_FORMATTER(DataIDoObject) // R841 -UNION_FORMATTER(DataStmtRepeat) // R844 -UNION_FORMATTER(DataStmtConstant) // R845 -UNION_FORMATTER(Designator) // R901 -UNION_FORMATTER(Variable) // R902 -UNION_FORMATTER(DataReference) // R911 -UNION_FORMATTER(SectionSubscript) // R920 -UNION_FORMATTER(ImageSelectorSpec) // R926 -UNION_FORMATTER(StatOrErrmsg) // R928, R942 & R1165 -UNION_FORMATTER(AllocOpt) // R928 -UNION_FORMATTER(AllocateObject) // R933 -UNION_FORMATTER(PointerObject) // R940 -UNION_FORMATTER(Expr) // R1001 -UNION_FORMATTER(PointerAssignmentStmt::Bounds) // R1033 -UNION_FORMATTER(WhereBodyConstruct) // R1044 -UNION_FORMATTER(ForallBodyConstruct) // R1052 -UNION_FORMATTER(ForallAssignmentStmt) // R1053 -UNION_FORMATTER(Selector) // R1105 -UNION_FORMATTER(LoopControl) // R1123 -UNION_FORMATTER(LocalitySpec) // R1130 -UNION_FORMATTER(CaseSelector) // R1145 -UNION_FORMATTER(CaseValueRange) // R1146 -UNION_FORMATTER(SelectRankCaseStmt::Rank) // R1150 -UNION_FORMATTER(TypeGuardStmt::Guard) // R1154 -UNION_FORMATTER(StopCode) // R1162 -UNION_FORMATTER(SyncImagesStmt::ImageSet) // R1167 -UNION_FORMATTER(EventWaitStmt::EventWaitSpec) // R1173 -UNION_FORMATTER(FormTeamStmt::FormTeamSpec) // R1177 -UNION_FORMATTER(LockStmt::LockStat) // R1179 -UNION_FORMATTER(IoUnit) // R1201, R1203 -UNION_FORMATTER(ConnectSpec) // R1205 -UNION_FORMATTER(CloseStmt::CloseSpec) // R1209 -UNION_FORMATTER(IoControlSpec) // R1213 -UNION_FORMATTER(Format) // R1215 -UNION_FORMATTER(InputItem) // R1216 -UNION_FORMATTER(OutputItem) // R1217 -UNION_FORMATTER(WaitSpec) // R1223 -UNION_FORMATTER(BackspaceStmt) // R1224 -UNION_FORMATTER(EndfileStmt) // R1225 -UNION_FORMATTER(RewindStmt) // R1226 -UNION_FORMATTER(PositionOrFlushSpec) // R1227 & R1229 -UNION_FORMATTER(FlushStmt) // R1228 -UNION_FORMATTER(InquireStmt) // R1230 -UNION_FORMATTER(InquireSpec) // R1231 -UNION_FORMATTER(ModuleSubprogram) // R1408 -UNION_FORMATTER(Rename) // R1411 -UNION_FORMATTER(Only) // R1412 -UNION_FORMATTER(InterfaceSpecification) // R1502 -UNION_FORMATTER(InterfaceStmt) // R1503 -UNION_FORMATTER(InterfaceBody) // R1505 -UNION_FORMATTER(GenericSpec) // R1508 -UNION_FORMATTER(ProcInterface) // R1513 -UNION_FORMATTER(ProcAttrSpec) // R1514 -UNION_FORMATTER(ProcPointerInit) // R1517 -UNION_FORMATTER(ProcedureDesignator) // R1522 -UNION_FORMATTER(ActualArg) // R1524 -UNION_FORMATTER(PrefixSpec) // R1527 -UNION_FORMATTER(DummyArg) // R1536 -UNION_FORMATTER(StructureField) // legacy extension - -#undef UNION_FORMATTER - -#define TUPLE_FORMATTER(TYPE) \ - std::ostream &operator<<(std::ostream &o, const TYPE &x) { \ - return o << "(" #TYPE " " << x.t << ')'; \ - } - -TUPLE_FORMATTER(SpecificationPart) // R504 -TUPLE_FORMATTER(InternalSubprogramPart) // R511 -TUPLE_FORMATTER(SignedIntLiteralConstant) // R707 -TUPLE_FORMATTER(IntLiteralConstant) // R708 -TUPLE_FORMATTER(SignedRealLiteralConstant) // R713 -TUPLE_FORMATTER(ExponentPart) // R717 -TUPLE_FORMATTER(ComplexLiteralConstant) // R718 -TUPLE_FORMATTER(SignedComplexLiteralConstant) // R718 -TUPLE_FORMATTER(CharLiteralConstant) // R724 -TUPLE_FORMATTER(DerivedTypeDef) // R726, R735 -TUPLE_FORMATTER(DerivedTypeStmt) // R727 -TUPLE_FORMATTER(TypeParamDefStmt) // R732 -TUPLE_FORMATTER(TypeParamDecl) // R733 -TUPLE_FORMATTER(DataComponentDefStmt) // R737 -TUPLE_FORMATTER(ComponentDecl) // R739 -TUPLE_FORMATTER(ProcComponentDefStmt) // R741 -TUPLE_FORMATTER(TypeBoundProcedurePart) // R746 -TUPLE_FORMATTER(TypeBoundProcDecl) // R750 -TUPLE_FORMATTER(TypeBoundGenericStmt) // R751 -TUPLE_FORMATTER(DerivedTypeSpec) // R754 -TUPLE_FORMATTER(TypeParamSpec) // R755 -TUPLE_FORMATTER(EnumDef) // R759 -TUPLE_FORMATTER(StructureConstructor) // R756 -TUPLE_FORMATTER(ComponentSpec) // R757 -TUPLE_FORMATTER(Enumerator) // R762 -TUPLE_FORMATTER(AcValue::Triplet) // R773 -TUPLE_FORMATTER(AcImpliedDo) // R774 -TUPLE_FORMATTER(AcImpliedDoControl) // R775 -TUPLE_FORMATTER(TypeDeclarationStmt) // R801 -TUPLE_FORMATTER(EntityDecl) // R803 -TUPLE_FORMATTER(ExplicitCoshapeSpec) // R811 -TUPLE_FORMATTER(ExplicitShapeSpec) // R816 -TUPLE_FORMATTER(AssumedSizeSpec) // R822 -TUPLE_FORMATTER(AccessStmt) // R827 -TUPLE_FORMATTER(ObjectDecl) // R830 & R860 -TUPLE_FORMATTER(BindStmt) // R832 -TUPLE_FORMATTER(BindEntity) // R833 -TUPLE_FORMATTER(CodimensionDecl) // R835 -TUPLE_FORMATTER(DataStmtSet) // R838 -TUPLE_FORMATTER(DataImpliedDo) // R840 -TUPLE_FORMATTER(DataStmtValue) // R843 -TUPLE_FORMATTER(DimensionStmt::Declaration) // R848 -TUPLE_FORMATTER(IntentStmt) // R849 -TUPLE_FORMATTER(NamedConstantDef) // R852 -TUPLE_FORMATTER(PointerDecl) // R854 -TUPLE_FORMATTER(SavedEntity) // R857, R858 -TUPLE_FORMATTER(ImplicitSpec) // R864 -TUPLE_FORMATTER(LetterSpec) // R865 -TUPLE_FORMATTER(NamelistStmt::Group) // R868, R869 -TUPLE_FORMATTER(CommonStmt::Block) // R873 -TUPLE_FORMATTER(CommonStmt) // R873 -TUPLE_FORMATTER(CommonBlockObject) // R874 -TUPLE_FORMATTER(Substring) // R908, R909 -TUPLE_FORMATTER(CharLiteralConstantSubstring) -TUPLE_FORMATTER(SubstringRange) // R910 -TUPLE_FORMATTER(SubscriptTriplet) // R921 -TUPLE_FORMATTER(ImageSelector) // R924 -TUPLE_FORMATTER(AllocateStmt) // R927 -TUPLE_FORMATTER(Allocation) // R932 -TUPLE_FORMATTER(AllocateShapeSpec) // R934 -TUPLE_FORMATTER(AllocateCoarraySpec) // R937 -TUPLE_FORMATTER(DeallocateStmt) // R941 -TUPLE_FORMATTER(Expr::DefinedUnary) // R1002 -TUPLE_FORMATTER(Expr::IntrinsicBinary) -TUPLE_FORMATTER(Expr::Power) -TUPLE_FORMATTER(Expr::Multiply) -TUPLE_FORMATTER(Expr::Divide) -TUPLE_FORMATTER(Expr::Add) -TUPLE_FORMATTER(Expr::Subtract) -TUPLE_FORMATTER(Expr::Concat) -TUPLE_FORMATTER(Expr::LT) -TUPLE_FORMATTER(Expr::LE) -TUPLE_FORMATTER(Expr::EQ) -TUPLE_FORMATTER(Expr::NE) -TUPLE_FORMATTER(Expr::GE) -TUPLE_FORMATTER(Expr::GT) -TUPLE_FORMATTER(Expr::AND) -TUPLE_FORMATTER(Expr::OR) -TUPLE_FORMATTER(Expr::EQV) -TUPLE_FORMATTER(Expr::NEQV) -TUPLE_FORMATTER(Expr::ComplexConstructor) -TUPLE_FORMATTER(Expr::DefinedBinary) // R1022 -TUPLE_FORMATTER(AssignmentStmt) // R1032 -TUPLE_FORMATTER(PointerAssignmentStmt) // R1033 -TUPLE_FORMATTER(BoundsRemapping) // R1036 -TUPLE_FORMATTER(ProcComponentRef) // R1039 -TUPLE_FORMATTER(WhereStmt) // R1041, R1045, R1046 -TUPLE_FORMATTER(WhereConstruct) // R1042 -TUPLE_FORMATTER(WhereConstruct::MaskedElsewhere) // R1042 -TUPLE_FORMATTER(WhereConstruct::Elsewhere) // R1042 -TUPLE_FORMATTER(WhereConstructStmt) // R1043, R1046 -TUPLE_FORMATTER(MaskedElsewhereStmt) // R1047 -TUPLE_FORMATTER(ForallConstruct) // R1050 -TUPLE_FORMATTER(ForallConstructStmt) // R1051 -TUPLE_FORMATTER(ForallStmt) // R1055 -TUPLE_FORMATTER(AssociateConstruct) // R1102 -TUPLE_FORMATTER(AssociateStmt) // R1103 -TUPLE_FORMATTER(Association) // R1104 -TUPLE_FORMATTER(BlockConstruct) // R1107 -TUPLE_FORMATTER(ChangeTeamConstruct) // R1111 -TUPLE_FORMATTER(ChangeTeamStmt) // R1112 -TUPLE_FORMATTER(CoarrayAssociation) // R1113 -TUPLE_FORMATTER(EndChangeTeamStmt) // R1114 -TUPLE_FORMATTER(CriticalConstruct) // R1116 -TUPLE_FORMATTER(CriticalStmt) // R1117 -TUPLE_FORMATTER(DoConstruct) // R1119 -TUPLE_FORMATTER(LabelDoStmt) // R1121 -TUPLE_FORMATTER(NonLabelDoStmt) // R1122 -TUPLE_FORMATTER(LoopControl::Concurrent) // R1123 -TUPLE_FORMATTER(ConcurrentHeader) // R1125 -TUPLE_FORMATTER(ConcurrentControl) // R1126 -TUPLE_FORMATTER(IfConstruct::ElseIfBlock) // R1134 -TUPLE_FORMATTER(IfConstruct::ElseBlock) // R1134 -TUPLE_FORMATTER(IfConstruct) // R1134 -TUPLE_FORMATTER(IfThenStmt) // R1135 -TUPLE_FORMATTER(ElseIfStmt) // R1136 -TUPLE_FORMATTER(IfStmt) // R1139 -TUPLE_FORMATTER(CaseConstruct) // R1140 -TUPLE_FORMATTER(CaseConstruct::Case) // R1140 -TUPLE_FORMATTER(SelectCaseStmt) // R1141, R1144 -TUPLE_FORMATTER(CaseStmt) // R1142 -TUPLE_FORMATTER(SelectRankConstruct) // R1148 -TUPLE_FORMATTER(SelectRankConstruct::RankCase) // R1148 -TUPLE_FORMATTER(SelectRankStmt) // R1149 -TUPLE_FORMATTER(SelectRankCaseStmt) // R1150 -TUPLE_FORMATTER(SelectTypeConstruct) // R1152 -TUPLE_FORMATTER(SelectTypeConstruct::TypeCase) // R1152 -TUPLE_FORMATTER(SelectTypeStmt) // R1153 -TUPLE_FORMATTER(TypeGuardStmt) // R1154 -TUPLE_FORMATTER(ComputedGotoStmt) // R1158 -TUPLE_FORMATTER(StopStmt) // R1160, R1161 -TUPLE_FORMATTER(SyncImagesStmt) // R1166 -TUPLE_FORMATTER(SyncTeamStmt) // R1169 -TUPLE_FORMATTER(EventPostStmt) // R1170, R1171 -TUPLE_FORMATTER(EventWaitStmt) // R1172 -TUPLE_FORMATTER(FormTeamStmt) // R1175 -TUPLE_FORMATTER(LockStmt) // R1178 -TUPLE_FORMATTER(UnlockStmt) // R1180 -TUPLE_FORMATTER(ConnectSpec::CharExpr) // R1205 -TUPLE_FORMATTER(PrintStmt) // R1212 -TUPLE_FORMATTER(IoControlSpec::CharExpr) // R1213 -TUPLE_FORMATTER(InputImpliedDo) // R1218, R1219 -TUPLE_FORMATTER(OutputImpliedDo) // R1218, R1219 -TUPLE_FORMATTER(InquireStmt::Iolength) // R1230 -TUPLE_FORMATTER(InquireSpec::CharVar) // R1231 -TUPLE_FORMATTER(InquireSpec::IntVar) // R1231 -TUPLE_FORMATTER(InquireSpec::LogVar) // R1231 -TUPLE_FORMATTER(MainProgram) // R1401 -TUPLE_FORMATTER(Module) // R1404 -TUPLE_FORMATTER(ModuleSubprogramPart) // R1407 -// TUPLE_FORMATTER(Rename::Names) // R1411 -TUPLE_FORMATTER(Rename::Operators) // R1414, R1415 -TUPLE_FORMATTER(Submodule) // R1416 -TUPLE_FORMATTER(SubmoduleStmt) // R1417 -TUPLE_FORMATTER(ParentIdentifier) // R1418 -TUPLE_FORMATTER(BlockData) // R1420 -TUPLE_FORMATTER(InterfaceBlock) // R1501 -TUPLE_FORMATTER(InterfaceBody::Function) // R1505 -TUPLE_FORMATTER(InterfaceBody::Subroutine) // R1505 -TUPLE_FORMATTER(GenericStmt) // R1510 -TUPLE_FORMATTER(ProcedureDeclarationStmt) // R1512 -TUPLE_FORMATTER(ProcDecl) // R1515 -TUPLE_FORMATTER(Call) // R1520 & R1521 -TUPLE_FORMATTER(ActualArgSpec) // R1523 -TUPLE_FORMATTER(FunctionSubprogram) // R1529 -TUPLE_FORMATTER(FunctionStmt) // R1530 -TUPLE_FORMATTER(SubroutineSubprogram) // R1534 -TUPLE_FORMATTER(SubroutineStmt) // R1535 -TUPLE_FORMATTER(SeparateModuleSubprogram) // R1538 -TUPLE_FORMATTER(EntryStmt) // R1541 -TUPLE_FORMATTER(StmtFunctionStmt) // R1544 - -// Extensions and legacies -TUPLE_FORMATTER(BasedPointerStmt) -TUPLE_FORMATTER(RedimensionStmt) -TUPLE_FORMATTER(StructureStmt) -TUPLE_FORMATTER(StructureDef) -TUPLE_FORMATTER(Union) -TUPLE_FORMATTER(Map) -TUPLE_FORMATTER(ArithmeticIfStmt) -TUPLE_FORMATTER(AssignStmt) -TUPLE_FORMATTER(AssignedGotoStmt) - -std::ostream &operator<<(std::ostream &o, const Rename::Names &x) { // R1411 - return o << "(Rename::Names " << std::get<0>(x.t) << ' ' << std::get<1>(x.t) - << ')'; -} - -#undef TUPLE_FORMATTER - -// R1302 format-specification -std::ostream &operator<<( - std::ostream &o, const format::FormatSpecification &x) { - return o << "(FormatSpecification " << x.items << ' ' << x.unlimitedItems - << ')'; -} - -#define NESTED_ENUM_FORMATTER(T) \ - NESTED_ENUM_TO_STRING(T) \ - std::ostream &operator<<(std::ostream &o, const T &x) { \ - return o << ToString(x); \ - } - -NESTED_ENUM_FORMATTER(DefinedOperator::IntrinsicOperator) // R608 -NESTED_ENUM_FORMATTER(TypeParamDefStmt::KindOrLen) // R734 -NESTED_ENUM_FORMATTER(AccessSpec::Kind) // R807 -NESTED_ENUM_FORMATTER(IntentSpec::Intent) // R826 -NESTED_ENUM_FORMATTER(ImplicitStmt::ImplicitNoneNameSpec) // R866 -NESTED_ENUM_FORMATTER(ImportStmt::Kind) // R867 -NESTED_ENUM_FORMATTER(StopStmt::Kind) // R1160, R1161 -NESTED_ENUM_FORMATTER(ConnectSpec::CharExpr::Kind) // R1205 -NESTED_ENUM_FORMATTER(IoControlSpec::CharExpr::Kind) // R1213 -NESTED_ENUM_FORMATTER(InquireSpec::CharVar::Kind) // R1231 -NESTED_ENUM_FORMATTER(InquireSpec::IntVar::Kind) // R1231 -NESTED_ENUM_FORMATTER(InquireSpec::LogVar::Kind) // R1231 -NESTED_ENUM_FORMATTER(UseStmt::ModuleNature) // R1410 -NESTED_ENUM_FORMATTER(ProcedureStmt::Kind) // R1506 - -#undef NESTED_ENUM_FORMATTER - -// Wrapper class formatting -#define WRAPPER_FORMATTER(TYPE) \ - std::ostream &operator<<(std::ostream &o, const TYPE &x) { \ - return o << "(" #TYPE " " << x.v << ')'; \ - } - -WRAPPER_FORMATTER(Program) // R501 -WRAPPER_FORMATTER(ImplicitPart) // R505 -WRAPPER_FORMATTER(NamedConstant) // R606 -WRAPPER_FORMATTER(DefinedOpName) // R1003, R1023, R1414, R1415 -WRAPPER_FORMATTER(DeclarationTypeSpec::Record) // R703 extension -WRAPPER_FORMATTER(IntrinsicTypeSpec::NCharacter) // R704 extension -WRAPPER_FORMATTER(IntegerTypeSpec) // R705 -WRAPPER_FORMATTER(KindSelector) // R706 -WRAPPER_FORMATTER(HollerithLiteralConstant) // extension -WRAPPER_FORMATTER(LogicalLiteralConstant) // R725 -WRAPPER_FORMATTER(TypeAttrSpec::Extends) // R728 -WRAPPER_FORMATTER(EndTypeStmt) // R730 -WRAPPER_FORMATTER(Pass) // R742 & R752 -WRAPPER_FORMATTER(FinalProcedureStmt) // R753 -WRAPPER_FORMATTER(ComponentDataSource) // R758 -WRAPPER_FORMATTER(EnumeratorDefStmt) // R761 -WRAPPER_FORMATTER(BOZLiteralConstant) // R764, R765, R766, R767 -WRAPPER_FORMATTER(ArrayConstructor) // R769 -WRAPPER_FORMATTER(AccessSpec) // R807 -WRAPPER_FORMATTER(LanguageBindingSpec) // R808 & R1528 -WRAPPER_FORMATTER(DeferredCoshapeSpecList) // R810 -WRAPPER_FORMATTER(AssumedShapeSpec) // R819 -WRAPPER_FORMATTER(DeferredShapeSpecList) // R820 -WRAPPER_FORMATTER(AssumedImpliedSpec) // R821 -WRAPPER_FORMATTER(ImpliedShapeSpec) // R823 & R824 -WRAPPER_FORMATTER(IntentSpec) // R826 -WRAPPER_FORMATTER(AllocatableStmt) // R829 -WRAPPER_FORMATTER(AsynchronousStmt) // R831 -WRAPPER_FORMATTER(CodimensionStmt) // R834 -WRAPPER_FORMATTER(ContiguousStmt) // R836 -WRAPPER_FORMATTER(DataStmt) // R837 -WRAPPER_FORMATTER(DimensionStmt) // R848 -WRAPPER_FORMATTER(OptionalStmt) // R850 -WRAPPER_FORMATTER(ParameterStmt) // R851 -WRAPPER_FORMATTER(PointerStmt) // R853 -WRAPPER_FORMATTER(ProtectedStmt) // R855 -WRAPPER_FORMATTER(SaveStmt) // R856 -WRAPPER_FORMATTER(TargetStmt) // R859 -WRAPPER_FORMATTER(ValueStmt) // R861 -WRAPPER_FORMATTER(VolatileStmt) // R862 -WRAPPER_FORMATTER(NamelistStmt) // R868 -WRAPPER_FORMATTER(EquivalenceStmt) // R870, R871 -WRAPPER_FORMATTER(EquivalenceObject) // R872 -WRAPPER_FORMATTER(CharVariable) // R905 -WRAPPER_FORMATTER(ComplexPartDesignator) // R915 -WRAPPER_FORMATTER(TypeParamInquiry) // R916 -WRAPPER_FORMATTER(ArraySection) // R918 -WRAPPER_FORMATTER(ImageSelectorSpec::Stat) // R926 -WRAPPER_FORMATTER(ImageSelectorSpec::Team) // R926 -WRAPPER_FORMATTER(ImageSelectorSpec::Team_Number) // R926 -WRAPPER_FORMATTER(AllocOpt::Mold) // R928 -WRAPPER_FORMATTER(AllocOpt::Source) // R928 -WRAPPER_FORMATTER(StatVariable) // R929 -WRAPPER_FORMATTER(MsgVariable) // R930 & R1207 -WRAPPER_FORMATTER(NullifyStmt) // R939 -WRAPPER_FORMATTER(Expr::Parentheses) // R1001 -WRAPPER_FORMATTER(Expr::UnaryPlus) // R1006, R1009 -WRAPPER_FORMATTER(Expr::Negate) // R1006, R1009 -WRAPPER_FORMATTER(Expr::NOT) // R1014, R1018 -WRAPPER_FORMATTER(Expr::PercentLoc) // extension -WRAPPER_FORMATTER(SpecificationExpr) // R1028 -WRAPPER_FORMATTER(BoundsSpec) // R1035 -WRAPPER_FORMATTER(ElsewhereStmt) // R1048 -WRAPPER_FORMATTER(EndWhereStmt) // R1049 -WRAPPER_FORMATTER(EndForallStmt) // R1054 -WRAPPER_FORMATTER(EndAssociateStmt) // R1106 -WRAPPER_FORMATTER(BlockStmt) // R1108 -WRAPPER_FORMATTER(BlockSpecificationPart) // R1109 -WRAPPER_FORMATTER(EndBlockStmt) // R1110 -WRAPPER_FORMATTER(EndCriticalStmt) // R1118 -WRAPPER_FORMATTER(LocalitySpec::Local) // R1130 -WRAPPER_FORMATTER(LocalitySpec::LocalInit) // R1130 -WRAPPER_FORMATTER(LocalitySpec::Shared) // R1130 -WRAPPER_FORMATTER(EndDoStmt) // R1132 -WRAPPER_FORMATTER(CycleStmt) // R1133 -WRAPPER_FORMATTER(ElseStmt) // R1137 -WRAPPER_FORMATTER(EndIfStmt) // R1138 -WRAPPER_FORMATTER(EndSelectStmt) // R1143, R1151, R1155 -WRAPPER_FORMATTER(ExitStmt) // R1156 -WRAPPER_FORMATTER(GotoStmt) // R1157 -WRAPPER_FORMATTER(SyncAllStmt) // R1164 -WRAPPER_FORMATTER(SyncMemoryStmt) // R1168 -WRAPPER_FORMATTER(FileUnitNumber) // R1202 -WRAPPER_FORMATTER(OpenStmt) // R1204 -WRAPPER_FORMATTER(StatusExpr) // R1205 & seq. -WRAPPER_FORMATTER(ErrLabel) // R1205 & seq. -WRAPPER_FORMATTER(ConnectSpec::Recl) // R1205 -WRAPPER_FORMATTER(ConnectSpec::Newunit) // R1205 -WRAPPER_FORMATTER(CloseStmt) // R1208 -WRAPPER_FORMATTER(IoControlSpec::Asynchronous) // R1213 -WRAPPER_FORMATTER(EndLabel) // R1213 & R1223 -WRAPPER_FORMATTER(EorLabel) // R1213 & R1223 -WRAPPER_FORMATTER(IoControlSpec::Pos) // R1213 -WRAPPER_FORMATTER(IoControlSpec::Rec) // R1213 -WRAPPER_FORMATTER(IoControlSpec::Size) // R1213 -WRAPPER_FORMATTER(IdVariable) // R1214 -WRAPPER_FORMATTER(WaitStmt) // R1222 -WRAPPER_FORMATTER(IdExpr) // R1223 & R1231 -WRAPPER_FORMATTER(FormatStmt) // R1301 -WRAPPER_FORMATTER(ProgramStmt) // R1402 -WRAPPER_FORMATTER(EndProgramStmt) // R1403 -WRAPPER_FORMATTER(ModuleStmt) // R1405 -WRAPPER_FORMATTER(EndModuleStmt) // R1406 -WRAPPER_FORMATTER(EndSubmoduleStmt) // R1419 -WRAPPER_FORMATTER(BlockDataStmt) // R1420 -WRAPPER_FORMATTER(EndBlockDataStmt) // R1421 -WRAPPER_FORMATTER(EndInterfaceStmt) // R1504 -WRAPPER_FORMATTER(ExternalStmt) // R1511 -WRAPPER_FORMATTER(IntrinsicStmt) // R1519 -WRAPPER_FORMATTER(FunctionReference) // R1520 -WRAPPER_FORMATTER(CallStmt) // R1521 -WRAPPER_FORMATTER(ActualArg::PercentRef) // R1524 extension -WRAPPER_FORMATTER(ActualArg::PercentVal) // R1524 extension -WRAPPER_FORMATTER(AltReturnSpec) // R1525 -WRAPPER_FORMATTER(EndFunctionStmt) // R1533 -WRAPPER_FORMATTER(EndSubroutineStmt) // R1537 -WRAPPER_FORMATTER(MpSubprogramStmt) // R1539 -WRAPPER_FORMATTER(EndMpSubprogramStmt) // R1540 -WRAPPER_FORMATTER(ReturnStmt) // R1542 -WRAPPER_FORMATTER(PauseStmt) // legacy - -#undef WRAPPER_FORMATTER - -#define EMPTY_TYPE_FORMATTER(TYPE) \ - std::ostream &operator<<(std::ostream &o, const TYPE &) { return o << #TYPE; } - -EMPTY_TYPE_FORMATTER(ErrorRecovery) -EMPTY_TYPE_FORMATTER(Star) // R701, R1215, R1536 -EMPTY_TYPE_FORMATTER(TypeParamValue::Deferred) // R701 -EMPTY_TYPE_FORMATTER(DeclarationTypeSpec::ClassStar) // R703 -EMPTY_TYPE_FORMATTER(DeclarationTypeSpec::TypeStar) // R703 -EMPTY_TYPE_FORMATTER(IntrinsicTypeSpec::DoublePrecision) // R704 -EMPTY_TYPE_FORMATTER(IntrinsicTypeSpec::DoubleComplex) // R704 extension -EMPTY_TYPE_FORMATTER(KindParam::Kanji) // R724 extension -EMPTY_TYPE_FORMATTER(Abstract) // R728 -EMPTY_TYPE_FORMATTER(TypeAttrSpec::BindC) // R728 -EMPTY_TYPE_FORMATTER(Allocatable) // R738 & R802 -EMPTY_TYPE_FORMATTER(Contiguous) // R738 & R802 -EMPTY_TYPE_FORMATTER(SequenceStmt) // R731 -EMPTY_TYPE_FORMATTER(NoPass) // R742 & R752 -EMPTY_TYPE_FORMATTER(Pointer) // R738, R742, R802, & R1514 -EMPTY_TYPE_FORMATTER(PrivateStmt) // R745, R747 -EMPTY_TYPE_FORMATTER(BindAttr::Deferred) // R752 -EMPTY_TYPE_FORMATTER(BindAttr::Non_Overridable) // R752 -EMPTY_TYPE_FORMATTER(EnumDefStmt) // R760 -EMPTY_TYPE_FORMATTER(EndEnumStmt) // R763 -EMPTY_TYPE_FORMATTER(Asynchronous) // R802 -EMPTY_TYPE_FORMATTER(External) // R802 -EMPTY_TYPE_FORMATTER(Intrinsic) // R802 -EMPTY_TYPE_FORMATTER(Optional) // R802 & R1514 -EMPTY_TYPE_FORMATTER(Parameter) // R802 -EMPTY_TYPE_FORMATTER(Protected) // R802 & R1514 -EMPTY_TYPE_FORMATTER(Save) // R802 & R1514 -EMPTY_TYPE_FORMATTER(Target) // R802 -EMPTY_TYPE_FORMATTER(Value) // R802 -EMPTY_TYPE_FORMATTER(Volatile) // R802 -EMPTY_TYPE_FORMATTER(NullInit) // R806 -EMPTY_TYPE_FORMATTER(AssumedRankSpec) // R825 -EMPTY_TYPE_FORMATTER(LocalitySpec::DefaultNone) // R1130 -EMPTY_TYPE_FORMATTER(Default) // R1145, R1150, R1154 -EMPTY_TYPE_FORMATTER(ContinueStmt) // R1159 -EMPTY_TYPE_FORMATTER(FailImageStmt) // R1163 -EMPTY_TYPE_FORMATTER(GenericSpec::Assignment) // R1508 -EMPTY_TYPE_FORMATTER(GenericSpec::ReadFormatted) // R1509 -EMPTY_TYPE_FORMATTER(GenericSpec::ReadUnformatted) // R1509 -EMPTY_TYPE_FORMATTER(GenericSpec::WriteFormatted) // R1509 -EMPTY_TYPE_FORMATTER(GenericSpec::WriteUnformatted) // R1509 -EMPTY_TYPE_FORMATTER(PrefixSpec::Elemental) // R1527 -EMPTY_TYPE_FORMATTER(PrefixSpec::Impure) // R1527 -EMPTY_TYPE_FORMATTER(PrefixSpec::Module) // R1527 -EMPTY_TYPE_FORMATTER(PrefixSpec::Non_Recursive) // R1527 -EMPTY_TYPE_FORMATTER(PrefixSpec::Pure) // R1527 -EMPTY_TYPE_FORMATTER(PrefixSpec::Recursive) // R1527 -EMPTY_TYPE_FORMATTER(ContainsStmt) // R1543 -EMPTY_TYPE_FORMATTER(StructureDef::EndStructureStmt) -EMPTY_TYPE_FORMATTER(Union::UnionStmt) -EMPTY_TYPE_FORMATTER(Union::EndUnionStmt) -EMPTY_TYPE_FORMATTER(Map::MapStmt) -EMPTY_TYPE_FORMATTER(Map::EndMapStmt) - -#undef EMPTY_TYPE_FORMATTER - -// R703 -std::ostream &operator<<(std::ostream &o, const DeclarationTypeSpec::Type &x) { - return o << "(DeclarationTypeSpec TYPE " << x.derived << ')'; -} - -std::ostream &operator<<(std::ostream &o, const DeclarationTypeSpec::Class &x) { - return o << "(DeclarationTypeSpec CLASS " << x.derived << ')'; -} - -// R704 -std::ostream &operator<<(std::ostream &o, const IntrinsicTypeSpec::Real &x) { - return o << "(Real " << x.kind << ')'; -} - -std::ostream &operator<<(std::ostream &o, const IntrinsicTypeSpec::Complex &x) { - return o << "(Complex " << x.kind << ')'; -} - -std::ostream &operator<<( - std::ostream &o, const IntrinsicTypeSpec::Character &x) { - return o << "(Character " << x.selector << ')'; -} - -std::ostream &operator<<(std::ostream &o, const IntrinsicTypeSpec::Logical &x) { - return o << "(Logical " << x.kind << ')'; -} - -// R706 -// TODO: Abstract part of this away to utility functions &/or constructors -KindSelector::KindSelector(std::uint64_t &&k) - : v{IntConstantExpr{ConstantExpr{Indirection{ - Expr{LiteralConstant{IntLiteralConstant{std::move(k)}}}}}}} {} - -// R712 sign -std::ostream &operator<<(std::ostream &o, Sign x) { - switch (x) { - case Sign::Positive: return o << "Positive"; - case Sign::Negative: return o << "Negative"; - default: CRASH_NO_CASE; - } - return o; -} - // R714 real-literal-constant // R715 significand static std::string charListToString(std::list &&cs) { @@ -593,60 +33,12 @@ RealLiteralConstant::RealLiteralConstant( : intPart{charListToString(std::move(i))}, exponent(std::move(expo)), kind(std::move(k)) {} -std::ostream &operator<<(std::ostream &o, const RealLiteralConstant &x) { - return o << "(RealLiteralConstant " << x.intPart << ' ' << x.fraction << ' ' - << x.exponent << ' ' << x.kind << ')'; -} - -// R721 char-selector -std::ostream &operator<<( - std::ostream &o, const CharSelector::LengthAndKind &x) { - return o << "(LengthAndKind " << x.length << ' ' << x.kind << ')'; -} - -// R749 type-bound-procedure-stmt -std::ostream &operator<<( - std::ostream &o, const TypeBoundProcedureStmt::WithoutInterface &x) { - return o << "(TypeBoundProcedureStmt () " << x.attributes << ' ' - << x.declarations << ')'; -} - -std::ostream &operator<<( - std::ostream &o, const TypeBoundProcedureStmt::WithInterface &x) { - return o << "(TypeBoundProcedureStmt " << x.interfaceName << ' ' - << x.attributes << ' ' << x.bindingNames << ')'; -} - -// R770 ac-spec -std::ostream &operator<<(std::ostream &o, const AcSpec &x) { - return o << "(AcSpec " << x.type << ' ' << x.values << ')'; -} - -// R863 implicit-stmt -std::ostream &operator<<(std::ostream &o, const ImplicitStmt &x) { - o << "(ImplicitStmt "; - if (std::holds_alternative>( - x.u)) { - o << "NONE "; - } - std::visit([&o](const auto &y) { o << y; }, x.u); - return o << ')'; -} - // R867 ImportStmt::ImportStmt(Kind &&k, std::list &&n) : kind{k}, names(std::move(n)) { CHECK(kind == Kind::Default || kind == Kind::Only || names.empty()); } -std::ostream &operator<<(std::ostream &o, const ImportStmt &x) { - o << "(ImportStmt "; - if (x.kind != ImportStmt::Kind::Default) { - o << x.kind; - } - return o << x.names << ')'; -} - // R901 designator bool Designator::EndsInBareName() const { return std::visit( @@ -749,28 +141,6 @@ DataReference::DataReference(std::list &&prl) } } -// R913 structure-component -> data-ref -std::ostream &operator<<(std::ostream &o, const StructureComponent &x) { - return o << "(StructureComponent " << x.base << ' ' << x.component << ')'; -} - -// R914 coindexed-named-object -> data-ref -std::ostream &operator<<(std::ostream &o, const CoindexedNamedObject &x) { - return o << "(CoindexedNamedObject " << x.base << ' ' << x.imageSelector - << ')'; -} - -// R912 part-ref -std::ostream &operator<<(std::ostream &o, const PartRef &pr) { - return o << "(PartRef " << pr.name << ' ' << pr.subscripts << ' ' - << pr.imageSelector << ')'; -} - -// R917 array-element -> data-ref -std::ostream &operator<<(std::ostream &o, const ArrayElement &x) { - return o << "(ArrayElement " << x.base << ' ' << x.subscripts << ')'; -} - // R920 section-subscript bool SectionSubscript::CanConvertToActualArgument() const { return std::visit(visitors{[](const VectorSubscript &) { return true; }, @@ -815,110 +185,5 @@ ActualArg Expr::ConvertToActualArgument() { } return {std::move(*this)}; } - -// R1146 -std::ostream &operator<<(std::ostream &o, const CaseValueRange::Range &x) { - return o << "(Range " << x.lower << ' ' << x.upper << ')'; -} - -// R1307 data-edit-desc (part 1 of 2) -std::ostream &operator<<( - std::ostream &o, const format::IntrinsicTypeDataEditDesc &x) { - o << "(IntrinsicTypeDataEditDesc "; - switch (x.kind) { - case format::IntrinsicTypeDataEditDesc::Kind::I: o << "I "; break; - case format::IntrinsicTypeDataEditDesc::Kind::B: o << "B "; break; - case format::IntrinsicTypeDataEditDesc::Kind::O: o << "O "; break; - case format::IntrinsicTypeDataEditDesc::Kind::Z: o << "Z "; break; - case format::IntrinsicTypeDataEditDesc::Kind::F: o << "F "; break; - case format::IntrinsicTypeDataEditDesc::Kind::E: o << "E "; break; - case format::IntrinsicTypeDataEditDesc::Kind::EN: o << "EN "; break; - case format::IntrinsicTypeDataEditDesc::Kind::ES: o << "ES "; break; - case format::IntrinsicTypeDataEditDesc::Kind::EX: o << "EX "; break; - case format::IntrinsicTypeDataEditDesc::Kind::G: o << "G "; break; - case format::IntrinsicTypeDataEditDesc::Kind::L: o << "L "; break; - case format::IntrinsicTypeDataEditDesc::Kind::A: o << "A "; break; - case format::IntrinsicTypeDataEditDesc::Kind::D: o << "D "; break; - default: CRASH_NO_CASE; - } - return o << x.width << ' ' << x.digits << ' ' << x.exponentWidth << ')'; -} - -// R1210 read-stmt -std::ostream &operator<<(std::ostream &o, const ReadStmt &x) { - return o << "(ReadStmt " << x.iounit << ' ' << x.format << ' ' << x.controls - << ' ' << x.items << ')'; -} - -// R1211 write-stmt -std::ostream &operator<<(std::ostream &o, const WriteStmt &x) { - return o << "(WriteStmt " << x.iounit << ' ' << x.format << ' ' << x.controls - << ' ' << x.items << ')'; -} - -// R1307 data-edit-desc (part 2 of 2) -std::ostream &operator<<( - std::ostream &o, const format::DerivedTypeDataEditDesc &x) { - return o << "(DerivedTypeDataEditDesc " << x.type << ' ' << x.parameters - << ')'; -} - -// R1313 control-edit-desc -std::ostream &operator<<(std::ostream &o, const format::ControlEditDesc &x) { - o << "(ControlEditDesc "; - switch (x.kind) { - case format::ControlEditDesc::Kind::T: o << "T "; break; - case format::ControlEditDesc::Kind::TL: o << "TL "; break; - case format::ControlEditDesc::Kind::TR: o << "TR "; break; - case format::ControlEditDesc::Kind::X: o << "X "; break; - case format::ControlEditDesc::Kind::Slash: o << "/ "; break; - case format::ControlEditDesc::Kind::Colon: o << ": "; break; - case format::ControlEditDesc::Kind::SS: o << "SS "; break; - case format::ControlEditDesc::Kind::SP: o << "SP "; break; - case format::ControlEditDesc::Kind::S: o << "S "; break; - case format::ControlEditDesc::Kind::P: o << "P "; break; - case format::ControlEditDesc::Kind::BN: o << "BN "; break; - case format::ControlEditDesc::Kind::BZ: o << "BZ "; break; - case format::ControlEditDesc::Kind::RU: o << "RU "; break; - case format::ControlEditDesc::Kind::RD: o << "RD "; break; - case format::ControlEditDesc::Kind::RN: o << "RN "; break; - case format::ControlEditDesc::Kind::RC: o << "RC "; break; - case format::ControlEditDesc::Kind::RP: o << "RP "; break; - case format::ControlEditDesc::Kind::DC: o << "DC "; break; - case format::ControlEditDesc::Kind::DP: o << "DP "; break; - default: CRASH_NO_CASE; - } - return o << x.count << ')'; -} - -// R1304 format-item -std::ostream &operator<<(std::ostream &o, const format::FormatItem &x) { - o << "(FormatItem " << x.repeatCount; - std::visit([&o](const auto &y) { o << y; }, x.u); - return o << ')'; -} - -// R1409 -std::ostream &operator<<(std::ostream &o, const UseStmt &x) { - o << "(UseStmt " << x.nature << ' ' << x.moduleName << ' '; - std::visit( - visitors{ - [&o](const std::list &y) -> void { o << "RENAME " << y; }, - [&o](const std::list &y) -> void { o << "ONLY " << y; }, - }, - x.u); - return o << ')'; -} - -// R1506 -std::ostream &operator<<(std::ostream &o, const ProcedureStmt &x) { - return o << "(ProcedureStmt " << std::get<0>(x.t) << ' ' << std::get<1>(x.t) - << ')'; -} - -// R1532 suffix -std::ostream &operator<<(std::ostream &o, const Suffix &x) { - return o << "(Suffix " << x.binding << ' ' << x.resultName << ')'; -} } // namespace parser } // namespace Fortran diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h index 2db2226f7df9..3fd31470443e 100644 --- a/flang/lib/parser/parse-tree.h +++ b/flang/lib/parser/parse-tree.h @@ -17,7 +17,6 @@ #include #include #include -#include #include #include #include @@ -40,12 +39,10 @@ CLASS_TRAIT(UnionTrait); CLASS_TRAIT(TupleTrait); // Most non-template classes in this file use these default definitions -// for their move constructor and move assignment operator=, and should -// declare an operator<< for formatting. +// for their move constructor and move assignment operator=. #define BOILERPLATE(classname) \ classname(classname &&) = default; \ classname &operator=(classname &&) = default; \ - friend std::ostream &operator<<(std::ostream &, const classname &); \ classname() = delete; \ classname(const classname &) = delete; \ classname &operator=(const classname &) = delete @@ -59,7 +56,6 @@ CLASS_TRAIT(TupleTrait); classname(classname &&) {} \ classname &operator=(const classname &) { return *this; }; \ classname &operator=(classname &&) { return *this; }; \ - friend std::ostream &operator<<(std::ostream &, const classname &); \ using EmptyTrait = std::true_type; \ } @@ -140,6 +136,7 @@ struct DimensionStmt; // R848 struct IntentStmt; // R849 struct OptionalStmt; // R850 struct ParameterStmt; // R851 +struct OldParameterStmt; struct PointerStmt; // R853 struct ProtectedStmt; // R855 struct SaveStmt; // R856 @@ -226,7 +223,6 @@ struct StmtFunctionStmt; // R1544 // Extension and deprecated statements struct BasedPointerStmt; -struct RedimensionStmt; struct StructureDef; struct ArithmeticIfStmt; struct AssignStmt; @@ -337,6 +333,7 @@ struct SpecificationConstruct { std::variant, Indirection, Statement>, Indirection, Statement>, + Statement>, Statement>, Statement, Statement>, Indirection> @@ -348,8 +345,9 @@ struct SpecificationConstruct { struct ImplicitPartStmt { UNION_CLASS_BOILERPLATE(ImplicitPartStmt); std::variant>, - Statement>, Statement>, - Statement>> + Statement>, + Statement>, + Statement>, Statement>> u; }; @@ -429,9 +427,8 @@ struct ActionStmt { Indirection, Indirection, Indirection, Indirection, Indirection, Indirection, Indirection, - Indirection, Indirection, - Indirection, Indirection, - Indirection> + Indirection, Indirection, + Indirection, Indirection> u; }; @@ -544,9 +541,12 @@ struct TypeParamValue { }; // R706 kind-selector -> ( [KIND =] scalar-int-constant-expr ) +// Legacy extension: kind-selector -> * digit-string +// TODO: These are probably not semantically identical, at least for COMPLEX. struct KindSelector { - WRAPPER_CLASS_BOILERPLATE(KindSelector, ScalarIntConstantExpr); - KindSelector(std::uint64_t &&); + UNION_CLASS_BOILERPLATE(KindSelector); + WRAPPER_CLASS(StarSize, std::uint64_t); + std::variant u; }; // R705 integer-type-spec -> INTEGER [kind-selector] @@ -748,7 +748,7 @@ struct CharLiteralConstant { std::string GetString() const { return std::get(t); } }; -// extension +// legacy extension struct HollerithLiteralConstant { WRAPPER_CLASS_BOILERPLATE(HollerithLiteralConstant, std::string); std::string GetString() const { return v; } @@ -1286,7 +1286,8 @@ WRAPPER_CLASS(AsynchronousStmt, std::list); // R833 bind-entity -> entity-name | / common-block-name / struct BindEntity { TUPLE_CLASS_BOILERPLATE(BindEntity); - std::tuple t; + DEFINE_NESTED_ENUM_CLASS(Kind, Object, Common); + std::tuple t; }; // R832 bind-stmt -> language-binding-spec [::] bind-entity-list @@ -1412,7 +1413,8 @@ WRAPPER_CLASS(ProtectedStmt, std::list); // R858 proc-pointer-name -> name struct SavedEntity { TUPLE_CLASS_BOILERPLATE(SavedEntity); - std::tuple t; + DEFINE_NESTED_ENUM_CLASS(Kind, Object, ProcPointer, Common); + std::tuple t; }; // R856 save-stmt -> SAVE [[::] saved-entity-list] @@ -2611,29 +2613,17 @@ struct PositionOrFlushSpec { // R1224 backspace-stmt -> // BACKSPACE file-unit-number | BACKSPACE ( position-spec-list ) -struct BackspaceStmt { - UNION_CLASS_BOILERPLATE(BackspaceStmt); - std::variant> u; -}; +WRAPPER_CLASS(BackspaceStmt, std::list); // R1225 endfile-stmt -> // ENDFILE file-unit-number | ENDFILE ( position-spec-list ) -struct EndfileStmt { - UNION_CLASS_BOILERPLATE(EndfileStmt); - std::variant> u; -}; +WRAPPER_CLASS(EndfileStmt, std::list); // R1226 rewind-stmt -> REWIND file-unit-number | REWIND ( position-spec-list ) -struct RewindStmt { - UNION_CLASS_BOILERPLATE(RewindStmt); - std::variant> u; -}; +WRAPPER_CLASS(RewindStmt, std::list); // R1228 flush-stmt -> FLUSH file-unit-number | FLUSH ( flush-spec-list ) -struct FlushStmt { - UNION_CLASS_BOILERPLATE(FlushStmt); - std::variant> u; -}; +WRAPPER_CLASS(FlushStmt, std::list); // R1231 inquire-spec -> // [UNIT =] file-unit-number | FILE = file-name-expr | @@ -3090,17 +3080,12 @@ struct StmtFunctionStmt { std::tuple, Scalar> t; }; -// Extension and deprecated statements +// Legacy extensions struct BasedPointerStmt { TUPLE_CLASS_BOILERPLATE(BasedPointerStmt); std::tuple> t; }; -struct RedimensionStmt { - TUPLE_CLASS_BOILERPLATE(RedimensionStmt); - std::tuple> t; -}; - struct Union; struct StructureDef; @@ -3129,7 +3114,7 @@ struct Union { struct StructureStmt { TUPLE_CLASS_BOILERPLATE(StructureStmt); - std::tuple> t; + std::tuple> t; }; struct StructureDef { @@ -3140,6 +3125,11 @@ struct StructureDef { t; }; +// Old style PARAMETER statement without parentheses. +// Types are determined entirely from the right-hand sides, not the names. +WRAPPER_CLASS(OldParameterStmt, std::list); + +// Deprecations struct ArithmeticIfStmt { TUPLE_CLASS_BOILERPLATE(ArithmeticIfStmt); std::tuple t; @@ -3156,59 +3146,6 @@ struct AssignedGotoStmt { }; WRAPPER_CLASS(PauseStmt, std::optional); - -// Formatting of template types -template -std::ostream &operator<<(std::ostream &o, const Statement &x) { - return o << "(Statement " << x.label << ' ' - << (x.isLabelInAcceptableField ? ""s : "!isLabelInAcceptableField "s) - << ' ' << x.statement << ')'; -} - -template -std::ostream &operator<<(std::ostream &o, const Scalar &x) { - return o << "(Scalar- " << x.thing << ')'; -} - -template -std::ostream &operator<<(std::ostream &o, const Constant &x) { - return o << "(Constant- " << x.thing << ')'; -} - -template -std::ostream &operator<<(std::ostream &o, const Integer &x) { - return o << "(Integer- " << x.thing << ')'; -} - -template -std::ostream &operator<<(std::ostream &o, const Logical &x) { - return o << "(Logical- " << x.thing << ')'; -} - -template -std::ostream &operator<<(std::ostream &o, const DefaultChar &x) { - return o << "(DefaultChar- " << x.thing << ')'; -} - -template -std::ostream &operator<<(std::ostream &o, const LoopBounds &x) { - return o << "(LoopBounds " << x.name << ' ' << x.lower << ' ' << x.upper - << ' ' << x.step << ')'; -} - -// Formatting enumerations defined via DEFINE_NESTED_ENUM_CLASS -#define NESTED_ENUM_TO_STRING(ENUMTYPE) \ - static std::string ToString(ENUMTYPE x) { \ - std::string str{ENUMTYPE##AsString}; \ - size_t start{0}; \ - for (int j{static_cast(x)}; j-- > 0;) { \ - start = str.find(',', start) + 1; \ - } \ - while (str[start] == ' ') { \ - ++start; \ - } \ - return str.substr(start, str.find(',', start)); \ - } } // namespace parser } // namespace Fortran #endif // FORTRAN_PARSER_PARSE_TREE_H_ diff --git a/flang/lib/parser/parsing.cc b/flang/lib/parser/parsing.cc new file mode 100644 index 000000000000..f2c5d6a388d7 --- /dev/null +++ b/flang/lib/parser/parsing.cc @@ -0,0 +1,84 @@ +#include "parsing.h" +#include "grammar.h" +#include "message.h" +#include "preprocessor.h" +#include "prescan.h" +#include "provenance.h" +#include "source.h" +#include + +namespace Fortran { +namespace parser { + +void Parsing::PushSearchPathDirectory(std::string path) { + allSources_.PushSearchPathDirectory(path); +} + +bool Parsing::Prescan(const std::string &path, Options options) { + options_ = options; + + std::stringstream fileError; + const auto *sourceFile = allSources_.Open(path, &fileError); + if (sourceFile == nullptr) { + ProvenanceRange range{allSources_.AddCompilerInsertion(path)}; + MessageFormattedText msg("%s"_en_US, fileError.str().data()); + messages_.Put(Message(range.start(), std::move(msg))); + anyFatalError_ = true; + return false; + } + + Preprocessor preprocessor{&allSources_}; + Prescanner prescanner{&messages_, &cooked_, &preprocessor}; + prescanner.set_fixedForm(options.isFixedForm) + .set_fixedFormColumnLimit(options.fixedFormColumns) + .set_encoding(options.encoding) + .set_enableBackslashEscapesInCharLiterals(options.enableBackslashEscapes) + .set_enableOldDebugLines(options.enableOldDebugLines); + ProvenanceRange range{ + allSources_.AddIncludedFile(*sourceFile, ProvenanceRange{})}; + if ((anyFatalError_ = !prescanner.Prescan(range))) { + return false; + } + + cooked_.Marshal(); + return true; +} + +void Parsing::DumpCookedChars(std::ostream &out) const { + if (anyFatalError_) { + return; + } + UserState userState; + ParseState parseState{cooked_}; + parseState.set_inFixedForm(options_.isFixedForm).set_userState(&userState); + while (std::optional ch{parseState.GetNextChar()}) { + out << *ch; + } +} + +void Parsing::DumpProvenance(std::ostream &out) const { cooked_.Dump(out); } + +bool Parsing::Parse() { + if (anyFatalError_) { + return false; + } + UserState userState; + ParseState parseState{cooked_}; + parseState.set_inFixedForm(options_.isFixedForm) + .set_encoding(options_.encoding) + .set_warnOnNonstandardUsage(options_.isStrictlyStandard) + .set_warnOnDeprecatedUsage(options_.isStrictlyStandard) + .set_userState(&userState); + parseTree_ = program.Parse(&parseState); + anyFatalError_ = parseState.anyErrorRecovery(); +#if 0 // pgf90 -Mstandard enables warnings only, they aren't fatal. + // TODO: -Werror + || (options_.isStrictlyStandard && parseState.anyConformanceViolation()); +#endif + consumedWholeFile_ = parseState.IsAtEnd(); + finalRestingPlace_ = parseState.GetProvenance(); + messages_.Annex(parseState.messages()); + return parseTree_.has_value() && !anyFatalError_; +} +} // namespace parser +} // namespace Fortran diff --git a/flang/lib/parser/parsing.h b/flang/lib/parser/parsing.h new file mode 100644 index 000000000000..4ae3df7f5671 --- /dev/null +++ b/flang/lib/parser/parsing.h @@ -0,0 +1,56 @@ +#ifndef FORTRAN_PARSER_PARSING_H_ +#define FORTRAN_PARSER_PARSING_H_ + +#include "characters.h" +#include "message.h" +#include "parse-tree.h" +#include "provenance.h" +#include + +namespace Fortran { +namespace parser { + +struct Options { + Options() {} + + bool isFixedForm{false}; + int fixedFormColumns{72}; + bool enableBackslashEscapes{true}; + bool enableOldDebugLines{false}; + bool isStrictlyStandard{false}; + Encoding encoding{Encoding::UTF8}; +}; + +class Parsing { +public: + Parsing() {} + + bool consumedWholeFile() const { return consumedWholeFile_; } + Provenance finalRestingPlace() const { return finalRestingPlace_; } + Messages &messages() { return messages_; } + Program &parseTree() { return *parseTree_; } + + void PushSearchPathDirectory(std::string); + bool Prescan(const std::string &path, Options); + void DumpCookedChars(std::ostream &) const; + void DumpProvenance(std::ostream &) const; + bool Parse(); + + void Identify(std::ostream &o, Provenance p, const std::string &prefix, + bool echoSourceLine = false) const { + allSources_.Identify(o, p, prefix, echoSourceLine); + } + +private: + Options options_; + AllSources allSources_; + Messages messages_{allSources_}; + CookedSource cooked_{&allSources_}; + bool anyFatalError_{false}; + bool consumedWholeFile_{false}; + Provenance finalRestingPlace_; + std::optional parseTree_; +}; +} // namespace parser +} // namespace Fortran +#endif // FORTRAN_PARSER_PARSING_H_ diff --git a/flang/lib/parser/prescan.cc b/flang/lib/parser/prescan.cc index 599ce4915f8f..b0ad84f4cf05 100644 --- a/flang/lib/parser/prescan.cc +++ b/flang/lib/parser/prescan.cc @@ -59,11 +59,11 @@ bool Prescanner::Prescan(ProvenanceRange range) { ++newlineDebt_; } else { preprocessed.pop_back(); // clip the newline added above - preprocessed.EmitWithCaseConversion(cooked_); + preprocessed.Emit(cooked_); } preprocessed.clear(); } else { - tokens.EmitWithCaseConversion(cooked_); + tokens.Emit(cooked_); } tokens.clear(); ++newlineDebt_; @@ -126,10 +126,14 @@ void Prescanner::LabelField(TokenSequence *token) { token->CloseToken(); } if (outCol < 7) { - for (; outCol < 7; ++outCol) { - token->PutNextTokenChar(' ', spaceProvenance_); + if (outCol == 1) { + token->Put(" ", 6, sixSpaceProvenance_.start()); + } else { + for (; outCol < 7; ++outCol) { + token->PutNextTokenChar(' ', spaceProvenance_); + } + token->CloseToken(); } - token->CloseToken(); } } @@ -176,9 +180,12 @@ void Prescanner::NextChar() { } void Prescanner::SkipSpaces() { + bool wasInCharLiteral{inCharLiteral_}; + inCharLiteral_ = false; while (*at_ == ' ' || *at_ == '\t') { NextChar(); } + inCharLiteral_ = wasInCharLiteral; } bool Prescanner::NextToken(TokenSequence *tokens) { @@ -204,7 +211,7 @@ bool Prescanner::NextToken(TokenSequence *tokens) { preventHollerith_ = false; } else if (IsDecimalDigit(*at_)) { int n{0}; - static constexpr int maxHollerith = 256 * (132 - 6); + static constexpr int maxHollerith{256 /*lines*/ * (132 - 6 /*columns*/)}; do { if (n < maxHollerith) { n = 10 * n + DecimalDigitValue(*at_); @@ -216,17 +223,7 @@ bool Prescanner::NextToken(TokenSequence *tokens) { } while (IsDecimalDigit(*at_)); if ((*at_ == 'h' || *at_ == 'H') && n > 0 && n < maxHollerith && !preventHollerith_) { - EmitCharAndAdvance(tokens, 'h'); - inCharLiteral_ = true; - while (n-- > 0) { - if (!PadOutCharacterLiteral(tokens)) { - if (*at_ == '\n') { - break; // TODO error - } - EmitCharAndAdvance(tokens, *at_); - } - } - inCharLiteral_ = false; + Hollerith(tokens, n); } else if (*at_ == '.') { while (IsDecimalDigit(EmitCharAndAdvance(tokens, *at_))) { } @@ -235,7 +232,7 @@ bool Prescanner::NextToken(TokenSequence *tokens) { } else if (IsLetter(*at_)) { // Handles FORMAT(3I9HHOLLERITH) by skipping over the first I so that // we don't misrecognize I9HOLLERITH as an identifier in the next case. - EmitCharAndAdvance(tokens, *at_); + EmitCharAndAdvance(tokens, ToLowerCaseLetter(*at_)); } preventHollerith_ = false; } else if (*at_ == '.') { @@ -249,7 +246,8 @@ bool Prescanner::NextToken(TokenSequence *tokens) { } preventHollerith_ = false; } else if (IsLegalInIdentifier(*at_)) { - while (IsLegalInIdentifier(EmitCharAndAdvance(tokens, *at_))) { + while (IsLegalInIdentifier( + EmitCharAndAdvance(tokens, ToLowerCaseLetter(*at_)))) { } if (*at_ == '\'' || *at_ == '"') { QuotedCharacterLiteral(tokens); @@ -285,7 +283,7 @@ bool Prescanner::NextToken(TokenSequence *tokens) { } bool Prescanner::ExponentAndKind(TokenSequence *tokens) { - char ed = tolower(*at_); + char ed = ToLowerCaseLetter(*at_); if (ed != 'e' && ed != 'd') { return false; } @@ -297,41 +295,36 @@ bool Prescanner::ExponentAndKind(TokenSequence *tokens) { EmitCharAndAdvance(tokens, *at_); } if (*at_ == '_') { - while (IsLegalInIdentifier(EmitCharAndAdvance(tokens, *at_))) { + while (IsLegalInIdentifier( + EmitCharAndAdvance(tokens, ToLowerCaseLetter(*at_)))) { } } return true; } -void Prescanner::EmitQuotedCharacter(TokenSequence *tokens, char ch) { - if (std::optional escape{BackslashEscapeChar(ch)}) { - if (ch != '\'' && ch != '"' && - (ch != '\\' || !enableBackslashEscapesInCharLiterals_)) { - EmitInsertedChar(tokens, '\\'); - } - EmitChar(tokens, *escape); - } else if (ch < ' ') { - // emit an octal escape sequence - EmitInsertedChar(tokens, '\\'); - EmitInsertedChar(tokens, '0' + ((ch >> 6) & 3)); - EmitInsertedChar(tokens, '0' + ((ch >> 3) & 7)); - EmitInsertedChar(tokens, '0' + (ch & 7)); - } else { - EmitChar(tokens, ch); - } -} - void Prescanner::QuotedCharacterLiteral(TokenSequence *tokens) { - char quote{*at_}; + const char *start{at_}, quote{*start}; inCharLiteral_ = true; - do { - EmitQuotedCharacter(tokens, *at_); - NextChar(); + const auto emit = [&](char ch) { EmitChar(tokens, ch); }; + const auto insert = [&](char ch) { EmitInsertedChar(tokens, ch); }; + bool escape{false}; + while (true) { + char ch{*at_}; + escape = !escape && ch == '\\' && enableBackslashEscapesInCharLiterals_; + EmitQuotedChar( + ch, emit, insert, false, !enableBackslashEscapesInCharLiterals_); while (PadOutCharacterLiteral(tokens)) { } - if (*at_ == quote) { + if (*at_ == '\n') { + messages_->Put( + {GetProvenance(start), "incomplete character literal"_en_US}); + break; + } + NextChar(); + if (*at_ == quote && !escape) { // A doubled quote mark becomes a single instance of the quote character - // in the literal later. + // in the literal (later). There can be spaces between the quotes in + // fixed form source. EmitCharAndAdvance(tokens, quote); if (inFixedForm_) { SkipSpaces(); @@ -340,16 +333,61 @@ void Prescanner::QuotedCharacterLiteral(TokenSequence *tokens) { break; } } - } while (*at_ != '\n'); + } inCharLiteral_ = false; } +void Prescanner::Hollerith(TokenSequence *tokens, int count) { + inCharLiteral_ = true; + EmitChar(tokens, 'H'); + const char *start{at_}; + while (count-- > 0) { + if (PadOutCharacterLiteral(tokens)) { + } else if (*at_ != '\n') { + NextChar(); + EmitChar(tokens, *at_); + // Multi-byte character encodings should count as single characters. + int bytes{1}; + if (encoding_ == Encoding::EUC_JP) { + if (std::optional chBytes{EUC_JPCharacterBytes(at_)}) { + bytes = *chBytes; + } + } else if (encoding_ == Encoding::UTF8) { + if (std::optional chBytes{UTF8CharacterBytes(at_)}) { + bytes = *chBytes; + } + } + while (bytes-- > 1) { + EmitChar(tokens, *++at_); + } + } else { + break; + } + } + if (*at_ == '\n') { + messages_->Put( + {GetProvenance(start), "incomplete Hollerith literal"_en_US}); + } else { + NextChar(); + } + inCharLiteral_ = false; +} + +// In fixed form, source card images must be processed as if they were at +// least 72 columns wide, at least in character literal contexts. bool Prescanner::PadOutCharacterLiteral(TokenSequence *tokens) { - if (inFixedForm_ && !tabInCurrentLine_ && *at_ == '\n' && - column_ < fixedFormColumnLimit_) { - tokens->PutNextTokenChar(' ', spaceProvenance_); - ++column_; - return true; + while (inFixedForm_ && !tabInCurrentLine_ && at_[1] == '\n') { + if (column_ < fixedFormColumnLimit_) { + tokens->PutNextTokenChar(' ', spaceProvenance_); + ++column_; + return true; + } + if (!FixedFormContinuation() || tabInCurrentLine_) { + return false; + } + CHECK(column_ == 7); + --at_; // point to column 6 of continuation line + column_ = 6; } return false; } @@ -407,7 +445,7 @@ bool Prescanner::IncludeLine(const char *p) { ++p; } for (char ch : "include"s) { - if (tolower(*p++) != ch) { + if (ToLowerCaseLetter(*p++) != ch) { return false; } } @@ -518,7 +556,7 @@ const char *Prescanner::FixedFormContinuationLine() { } tabInCurrentLine_ = false; if (*p == '&') { - return p + 1; // extension + return p + 1; // extension; TODO: emit warning with -Mstandard } if (*p == '\t' && p[1] >= '1' && p[1] <= '9') { tabInCurrentLine_ = true; diff --git a/flang/lib/parser/prescan.h b/flang/lib/parser/prescan.h index 8951d07fbdd8..b31f26474291 100644 --- a/flang/lib/parser/prescan.h +++ b/flang/lib/parser/prescan.h @@ -8,6 +8,7 @@ // fixed form character literals on truncated card images, file // inclusion, and driving the Fortran source preprocessor. +#include "characters.h" #include "message.h" #include "provenance.h" #include "token-sequence.h" @@ -31,6 +32,10 @@ public: inFixedForm_ = yes; return *this; } + Prescanner &set_encoding(Encoding code) { + encoding_ = code; + return *this; + } Prescanner &set_enableOldDebugLines(bool yes) { enableOldDebugLines_ = yes; return *this; @@ -92,8 +97,8 @@ private: void SkipSpaces(); bool NextToken(TokenSequence *); bool ExponentAndKind(TokenSequence *); - void EmitQuotedCharacter(TokenSequence *, char); void QuotedCharacterLiteral(TokenSequence *); + void Hollerith(TokenSequence *, int); bool PadOutCharacterLiteral(TokenSequence *); bool CommentLines(); bool CommentLinesAndPreprocessorDirectives(); @@ -125,6 +130,7 @@ private: bool inPreprocessorDirective_{false}; bool inFixedForm_{false}; int fixedFormColumnLimit_{72}; + Encoding encoding_{Encoding::UTF8}; bool enableOldDebugLines_{false}; bool enableBackslashEscapesInCharLiterals_{true}; int delimiterNesting_{0}; @@ -132,6 +138,8 @@ private: cooked_->allSources()->CompilerInsertionProvenance(' ')}; Provenance backslashProvenance_{ cooked_->allSources()->CompilerInsertionProvenance('\\')}; + ProvenanceRange sixSpaceProvenance_{ + cooked_->allSources()->AddCompilerInsertion(" "s)}; }; } // namespace parser } // namespace Fortran diff --git a/flang/lib/parser/provenance.cc b/flang/lib/parser/provenance.cc index b3c847c07432..0aef7a5d89c2 100644 --- a/flang/lib/parser/provenance.cc +++ b/flang/lib/parser/provenance.cc @@ -172,11 +172,7 @@ void AllSources::Identify(std::ostream &o, Provenance at, } }, [&](const CompilerInsertion &ins) { - o << prefix << "in text "; - if (echoSourceLine) { - o << '\'' << ins.text << "' "; - } - o << "inserted by the compiler\n"; + o << prefix << ins.text << '\n'; }}, origin.u); } @@ -318,7 +314,12 @@ void AllSources::Dump(std::ostream &o) const { }, [&](const Macro &mac) { o << "macro " << mac.expansion; }, [&](const CompilerInsertion &ins) { - o << "compiler " << ins.text; + o << "compiler '" << ins.text << '\''; + if (ins.text.length() == 1) { + int ch = ins.text[0]; + o << " (0x" << std::hex << (ch & 0xff) << std::dec + << ")"; + } }}, m.u); o << '\n'; diff --git a/flang/lib/parser/provenance.h b/flang/lib/parser/provenance.h index 95898454fef6..50d28cdedbf9 100644 --- a/flang/lib/parser/provenance.h +++ b/flang/lib/parser/provenance.h @@ -173,6 +173,7 @@ public: std::string GetPath(Provenance) const; // __FILE__ int GetLineNumber(Provenance) const; // __LINE__ Provenance CompilerInsertionProvenance(char ch); + Provenance CompilerInsertionProvenance(const char *, size_t); void Dump(std::ostream &) const; private: diff --git a/flang/lib/parser/token-parsers.h b/flang/lib/parser/token-parsers.h index 21842c860ea4..72087a812ac4 100644 --- a/flang/lib/parser/token-parsers.h +++ b/flang/lib/parser/token-parsers.h @@ -64,21 +64,20 @@ public: } }; -constexpr struct Space { +// Skips over spaces. Always succeeds. +constexpr struct Spaces { using resultType = Success; - constexpr Space() {} + constexpr Spaces() {} static std::optional Parse(ParseState *state) { - std::optional ch{nextChar.Parse(state)}; - if (ch) { - if (ch == ' ' || ch == '\t') { - return {Success{}}; + while (std::optional ch{state->PeekAtNextChar()}) { + if (ch != ' ' && ch != '\t') { + break; } + state->UncheckedAdvance(); } - return {}; + return {Success{}}; } -} space; - -constexpr auto spaces = skipMany(space); +} spaces; class TokenStringMatch { public: @@ -89,9 +88,7 @@ public: constexpr TokenStringMatch(const char *str) : str_{str} {} std::optional Parse(ParseState *state) const { auto at = state->GetLocation(); - if (!spaces.Parse(state)) { - return {}; - } + spaces.Parse(state); const char *p{str_}; std::optional ch; // initially empty for (size_t j{0}; j < bytes_ && *p != '\0'; ++j, ++p) { @@ -236,9 +233,20 @@ template struct CharLiteral { } }; +static bool IsNonstandardUsageOk(ParseState *state) { + if (state->strictConformance()) { + return false; + } + state->set_anyConformanceViolation(); + if (state->warnOnNonstandardUsage()) { + state->PutMessage("nonstandard usage"_en_US); + } + return true; +} + // Parse "BOZ" binary literal quoted constants. // As extensions, support X as an alternate hexadecimal marker, and allow -// BOZX markers to appear as synonyms. +// BOZX markers to appear as suffixes. struct BOZLiteral { using resultType = std::uint64_t; static std::optional Parse(ParseState *state) { @@ -253,15 +261,12 @@ struct BOZLiteral { } }; - if (!spaces.Parse(state)) { - return {}; - } - + spaces.Parse(state); auto ch = nextChar.Parse(state); if (!ch) { return {}; } - if (toupper(*ch) == 'X' && state->strictConformance()) { + if (toupper(*ch) == 'X' && !IsNonstandardUsageOk(state)) { return {}; } if (baseChar(*ch) && !(ch = nextChar.Parse(state))) { @@ -282,15 +287,19 @@ struct BOZLiteral { if (*ch == quote) { break; } + if (*ch == ' ') { + continue; + } if (!IsHexadecimalDigit(*ch)) { return {}; } content += *ch; } - if (!shift && !state->strictConformance()) { - // extension: base allowed to appear as suffix - if (!(ch = nextChar.Parse(state)) || !baseChar(*ch)) { + if (!shift) { + // extension: base allowed to appear as suffix, too + if (!IsNonstandardUsageOk(state) || !(ch = nextChar.Parse(state)) || + !baseChar(*ch)) { return {}; } } @@ -353,9 +362,7 @@ struct DigitString { struct HollerithLiteral { using resultType = std::string; static std::optional Parse(ParseState *state) { - if (!spaces.Parse(state)) { - return {}; - } + spaces.Parse(state); auto at = state->GetLocation(); std::optional charCount{DigitString{}.Parse(state)}; if (!charCount || *charCount < 1) { @@ -367,13 +374,39 @@ struct HollerithLiteral { } std::string content; for (auto j = *charCount; j-- > 0;) { - std::optional ch{nextChar.Parse(state)}; - if (!ch || !isprint(*ch)) { - state->PutMessage( - at, "insufficient or bad characters in Hollerith"_en_US); - return {}; + int bytes{1}; + const char *p{state->GetLocation()}; + if (state->encoding() == Encoding::EUC_JP) { + if (std::optional chBytes{EUC_JPCharacterBytes(p)}) { + bytes = *chBytes; + } else { + state->PutMessage(at, "bad EUC_JP characters in Hollerith"_en_US); + return {}; + } + } else if (state->encoding() == Encoding::UTF8) { + if (std::optional chBytes{UTF8CharacterBytes(p)}) { + bytes = *chBytes; + } else { + state->PutMessage(at, "bad UTF-8 characters in Hollerith"_en_US); + return {}; + } + } + if (bytes == 1) { + std::optional ch{nextChar.Parse(state)}; + if (!ch.has_value() || !isprint(*ch)) { + state->PutMessage( + at, "insufficient or bad characters in Hollerith"_en_US); + return {}; + } + content += *ch; + } else { + // Multi-byte character + while (bytes-- > 0) { + std::optional byte{nextChar.Parse(state)}; + CHECK(byte.has_value()); + content += *byte; + } } - content += *ch; } return {content}; } @@ -413,7 +446,7 @@ template struct SkipTo { if (*ch == goal) { return {Success{}}; } - state->GetNextChar(); + state->UncheckedAdvance(); } return {}; } diff --git a/flang/lib/parser/token-sequence.cc b/flang/lib/parser/token-sequence.cc index ad89e0f70f68..aa2a970533d8 100644 --- a/flang/lib/parser/token-sequence.cc +++ b/flang/lib/parser/token-sequence.cc @@ -96,20 +96,14 @@ void TokenSequence::Put(const std::stringstream &ss, Provenance provenance) { Put(ss.str(), provenance); } -void TokenSequence::EmitWithCaseConversion(CookedSource *cooked) const { +void TokenSequence::Emit(CookedSource *cooked) const { size_t tokens{start_.size()}; size_t chars{char_.size()}; size_t atToken{0}; for (size_t j{0}; j < chars;) { size_t nextStart{atToken + 1 < tokens ? start_[++atToken] : chars}; - if (IsLegalInIdentifier(char_[j])) { - for (; j < nextStart; ++j) { - cooked->Put(tolower(char_[j])); - } - } else { - cooked->Put(&char_[j], nextStart - j); - j = nextStart; - } + cooked->Put(&char_[j], nextStart - j); + j = nextStart; } cooked->PutProvenanceMappings(provenances_); } diff --git a/flang/lib/parser/token-sequence.h b/flang/lib/parser/token-sequence.h index 12333badf343..4e39f96a50ec 100644 --- a/flang/lib/parser/token-sequence.h +++ b/flang/lib/parser/token-sequence.h @@ -122,7 +122,7 @@ public: void Put(const ContiguousChars &, Provenance); void Put(const std::string &, Provenance); void Put(const std::stringstream &, Provenance); - void EmitWithCaseConversion(CookedSource *) const; + void Emit(CookedSource *) const; std::string ToString() const; Provenance GetTokenProvenance(size_t token, size_t offset = 0) const; ProvenanceRange GetTokenProvenanceRange( diff --git a/flang/lib/parser/unparse.cc b/flang/lib/parser/unparse.cc index c25d35b18be1..11b3e796dc3c 100644 --- a/flang/lib/parser/unparse.cc +++ b/flang/lib/parser/unparse.cc @@ -1,25 +1,26 @@ +// 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 namespace Fortran { namespace parser { class UnparseVisitor { public: - // Create an UnparseVisitor that emits the Fortran to this ostream. - UnparseVisitor(std::ostream &out, const char *indentation = " ") - : out_{out}, indentation_{indentation} {} + UnparseVisitor(std::ostream &out, int indentationAmount, Encoding encoding) + : out_{out}, indentationAmount_{indentationAmount}, encoding_{encoding} {} - // Default action for a parse tree node is to visit children. + // Default actions: just traverse the children template bool Pre(const T &x) { return true; } - template void Post(const T &) {} - template void Post(const Statement &x) { Endl(); } - // Emit simple types as-is. bool Pre(const std::string &x) { Put(x); @@ -42,261 +43,170 @@ public: return false; } - bool Pre(const ContainsStmt &x) { - Outdent(); - Put("CONTAINS"); - Indent(); - return false; + // Statement labels and ends of lines + template bool Pre(const Statement &x) { + Walk(x.label, " "); + return true; } - bool Pre(const ContinueStmt &x) { - Put("CONTINUE"); - return false; + 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 Post(const ProgramUnit &x) { // R502, R503 + out_ << '\n'; // blank line after each ProgramUnit } - bool Pre(const FailImageStmt &x) { - Put("FAIL IMAGE"); - return false; - } - void Post(const ProgramUnit &x) { - Put('\n'); // blank line after each ProgramUnit - } - bool Pre(const DefinedOpName &x) { - Put('.'); - Put(x.v); - Put('.'); - return false; - } - bool Pre(const ImportStmt &x) { - Put("IMPORT"); - switch (x.kind) { - case ImportStmt::Kind::Default: - Put(" :: "); - WalkList(x.names); - break; - case ImportStmt::Kind::Only: Put(", ONLY:"); break; - case ImportStmt::Kind::None: Put(", NONE"); break; - case ImportStmt::Kind::All: Put(", ALL"); break; - default: CRASH_NO_CASE; + 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(x), DefinedOperator::IntrinsicOperatorAsString); } return false; } - bool Pre(const NamelistStmt &x) { - Put("NAMELIST"); - WalkList(x.v); + 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 NamelistStmt::Group &x) { - Put('/'); - Put(std::get(x.t)); - Put('/'); - WalkList(std::get>(x.t)); + bool Pre(const DeclarationTypeSpec::Class &x) { + Put("CLASS("), Walk(x.derived), Put(')'); return false; } - bool Pre(const Star &x) { - Put('*'); + 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 TypeParamValue::Deferred &x) { - Put(':'); - return false; - } - bool Pre(const KindSelector &x) { - Put('('); - Walk(x.v); - Put(')'); - return false; - } - bool Pre(const IntegerTypeSpec &x) { - Put("INTEGER"); - return true; - } - bool Pre(const CharLength &x) { - std::visit( - visitors{ - [&](const TypeParamValue &y) { - Put('('); - Walk(y); - Put(')'); - }, - [&](const int64_t &y) { Put(y); }, - }, - x.u); - return false; - } - bool Pre(const LengthSelector &x) { - std::visit( - visitors{ - [&](const TypeParamValue &y) { - Put('('); - Walk(y); - Put(')'); - }, - [&](const CharLength &y) { - Put('*'); - Walk(y); - }, - }, - x.u); - return false; - } - bool Pre(const CharSelector::LengthAndKind &x) { - Put('('); - if (x.length) { - Put("LEN="); - Walk(*x.length); - Put(", "); - } - Put("KIND="); - Walk(x.kind); - Put(')'); - return false; - } - - // TODO: rest of parse-tree.h after CharSelector - - bool Pre(const ModuleStmt &x) { - Put("MODULE "); - Indent(); - return true; - } - bool Pre(const EndModuleStmt &x) { - Outdent(); - Put("END MODULE"); - return true; - } - bool Pre(const ProgramStmt &x) { - Put("PROGRAM "); - Indent(); - return true; - } - bool Pre(const EndProgramStmt &x) { - Outdent(); - Put("END PROGRAM"); - return false; - } - bool Pre(const TypeDeclarationStmt &x) { - Walk(std::get(x.t)); - WalkList(std::get>(x.t), true); - Put(" :: "); - WalkList(std::get>(x.t)); - return false; - } - bool Pre(const Abstract &x) { - Put("ABSTRACT"); - return false; - } - bool Pre(const Allocatable &x) { - Put("ALLOCATABLE"); - return false; - } - bool Pre(const AssignmentStmt &x) { - WalkPair(x.t, " = "); - return false; - } - bool Pre(const Expr::Add &x) { - WalkPair(x.t, " + "); - return false; - } - bool Pre(const Expr::Concat &x) { - WalkPair(x.t, " // "); - return false; - } - bool Pre(const Expr::Divide &x) { - WalkPair(x.t, " / "); - return false; - } - bool Pre(const Expr::EQ &x) { - WalkPair(x.t, " .eq. "); - return false; - } - bool Pre(const Expr::EQV &x) { - WalkPair(x.t, " .eqv. "); - return false; - } - bool Pre(const Expr::Multiply &x) { - WalkPair(x.t, " * "); - return false; - } - bool Pre(const Expr::Negate &x) { - Put("-"); - return true; - } - bool Pre(const Expr::Parentheses &x) { - Put("("); - return true; - } - void Post(const Expr::Parentheses &x) { Put(")"); } - bool Pre(const Initialization &x) { - std::visit( - visitors{[&](const ConstantExpr &y) { Put(" = "); }, - [&](const NullInit &) {}, [&](const auto &) { Put("TODO"); }}, - x.u); - return true; - } - bool Pre(const IntrinsicTypeSpec::Character &x) { - Put("CHARACTER"); + bool Pre(const IntrinsicTypeSpec::Real &x) { // R704 + Put("REAL"); return true; } bool Pre(const IntrinsicTypeSpec::Complex &x) { Put("COMPLEX"); return true; } - bool Pre(const IntrinsicTypeSpec::DoubleComplex &x) { - Put("DOUBLE COMPLEX"); - return true; - } - bool Pre(const IntrinsicTypeSpec::DoublePrecision &x) { + 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 IntrinsicTypeSpec::Real &x) { - Put("REAL"); + bool Pre(const IntegerTypeSpec &x) { // R705 + Put("INTEGER"); return true; } - bool Pre(const KindParam &x) { - Put("_"); + 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(x.t)); + Walk("_", std::get>(x.t)); + return false; + } + bool Pre(const IntLiteralConstant &x) { // R708 + Walk(std::get(x.t)); + Walk("_", std::get>(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>(x.t)) { + if (std::holds_alternative(k->u)) { + Put("NC"); + } else { + Walk(*k), Put('_'); + } + } + PutQuoted(std::get(x.t)); + return false; + } + bool Pre(const HollerithLiteralConstant &x) { + std::optional 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 KindParam::Kanji &x) { - Put("Kanji???"); + bool Pre(const LogicalLiteralConstant &x) { // R725 + Put(x.v ? ".TRUE." : ".FALSE."); return false; } - bool Pre(const RealLiteralConstant &x) { - Put(x.intPart); - ; - Put("."); - Put(x.fraction); - if (x.exponent) { - Walk(*x.exponent); - } - Walk(x.kind); - return false; - } - - bool Pre(const DerivedTypeStmt &x) { - Put("TYPE"); - WalkList(std::get>(x.t), true); - Put(" :: "); - Put(std::get(x.t)); - const auto ¶ms = std::get>(x.t); - if (!params.empty()) { - Put('('); - WalkList(params); - Put(')'); - } + bool Pre(const DerivedTypeStmt &x) { // R727 + Put("TYPE"), Walk(", ", std::get>(x.t), ", "); + Put(" :: "), Put(std::get(x.t)); + Walk("(", std::get>(x.t), ", ", ")"); Indent(); return false; } - bool Pre(const EndTypeStmt &) { - Outdent(); - Put("END TYPE"); + bool Pre(const Abstract &x) { // R728, &c. + Put("ABSTRACT"); return false; } bool Pre(const TypeAttrSpec::BindC &x) { @@ -304,135 +214,1846 @@ public: return false; } bool Pre(const TypeAttrSpec::Extends &x) { - Put("EXTENDS("); - return true; - } - void Post(const TypeAttrSpec::Extends &x) { Put(")"); } - bool Pre(const AccessSpec &x) { - if (x.v == AccessSpec::Kind::Public) { - Put("PUBLIC"); - } else if (x.v == AccessSpec::Kind::Private) { - Put("PRIVATE"); - } else { - CHECK(false); - } + Put("EXTENDS("), Walk(x.v), Put(')'); return false; } - bool Pre(const SequenceStmt &x) { + void Post(const EndTypeStmt &) { // R730 + Outdent(); + Put("END TYPE"); + } + bool Pre(const SequenceStmt &x) { // R731 Put("SEQUENCE"); return false; } - bool Pre(const PrivateStmt &x) { - Put("PRIVATE"); + bool Pre(const TypeParamDefStmt &x) { // R732 + Walk(std::get(x.t)); + Put(", "), Walk(std::get(x.t)); + Put(" :: "), Walk(std::get>(x.t), ", "); return false; } - bool Pre(const DataComponentDefStmt &x) { - Walk(std::get(x.t)); - WalkList(std::get>(x.t), true); - Put(" :: "); - WalkList(std::get>(x.t)); + bool Pre(const TypeParamDecl &x) { // R733 + Put(std::get(x.t)); + Walk("=", std::get>(x.t)); return false; } - bool Pre(const ProcComponentDefStmt &x) { - Put("PROCEDURE("); - Walk(std::get>(x.t)); - Put(')'); - WalkList(std::get>(x.t), true); - Put(" :: "); - WalkList(std::get>(x.t)); + bool Pre(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, ", "); return false; } - bool Pre(const Pass &x) { - Put("PASS"); - return false; - } - bool Pre(const NoPass &x) { - Put("NOPASS"); + bool Pre(const Allocatable &x) { // R738 + Put("ALLOCATABLE"); return false; } bool Pre(const Pointer &x) { Put("POINTER"); return false; } - bool Pre(const ProcPointerInit &x) { - Put(" => "); + 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; } - bool Pre(const NullInit &x) { - Put("NULL()"); + 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(x.t)); + Walk("(", std::get>(x.t), ")"); + Walk("[", std::get>(x.t), "]"); + Walk("*", std::get>(x.t)); + Walk(std::get>(x.t)); + return false; + } + bool Pre(const ComponentArraySpec &x) { // R740 + std::visit( + visitors{[&](const std::list &y) { Walk(y, ","); }, + [&](const DeferredShapeSpecList &y) { Walk(y); }}, + x.u); + return false; + } + bool Pre(const ProcComponentDefStmt &x) { // R741 + Put("PROCEDURE("); + Walk(std::get>(x.t)), Put(')'); + Walk(", ", std::get>(x.t), ", "); + Put(" :: "), Walk(std::get>(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> &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(x.t)); + Walk(" => ", std::get>(x.t)); + return false; + } + bool Pre(const TypeBoundGenericStmt &x) { // R751 + Put("GENERIC"), Walk(", ", std::get>(x.t)); + Put(" :: "), Walk(std::get>(x.t)); + Put(" => "), Walk(std::get>(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(x.t)); + Walk("(", std::get>(x.t), ",", ")"); + return false; + } + bool Pre(const TypeParamSpec &x) { // R755 + Walk(std::get>(x.t), "="); + Walk(std::get(x.t)); + return false; + } + bool Pre(const StructureConstructor &x) { // R756 + Walk(std::get(x.t)); + Put('('), Walk(std::get>(x.t), ", "), Put(')'); + return false; + } + bool Pre(const ComponentSpec &x) { // R757 + Walk(std::get>(x.t), "="); + Walk(std::get(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(x.t)); + Walk(" = ", std::get>(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>(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 bool Pre(const LoopBounds &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>(x.t), "::"); + Walk(std::get>(x.t)); return false; } -private: - std::ostream &out_; - const char *const indentation_; - int indent_{0}; - int col_{0}; - - void Put(char x) { Put(std::string(1, x)); } - - void Put(const std::string &str) { - int len = str.length(); - if (len == 0) { - return; + bool Pre(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, ", "); + if (!attrs.empty() || + (!std::holds_alternative(dts.u) && + std::none_of(decls.begin(), decls.end(), [](const EntityDecl &d) { + const auto &init = std::get>(d.t); + return init.has_value() && + std::holds_alternative>>( + init->u); + }))) { + Put(" ::"); } - if (col_ == 0) { - for (int i = 0; i < indent_; ++i) { - out_ << indentation_; + Put(' '), Walk(std::get>(x.t), ", "); + return false; + } + bool Pre(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)); + 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(','); } } - out_ << str; - if (str.back() == '\n') { - col_ = 0; - } else { - col_ += len; - } + return false; } - void Endl() { - if (col_ > 0) { - out_ << '\n'; - col_ = 0; - } + bool Pre(const ExplicitCoshapeSpec &x) { // R811 + Walk(std::get>(x.t), ",", ","); + Walk(std::get>(x.t), ":"), Put('*'); + return false; + } + bool Pre(const ExplicitShapeSpec &x) { // R812 - R813 & R816 - R818 + Walk(std::get>(x.t), ":"); + Walk(std::get(x.t)); + return false; + } + bool Pre(const ArraySpec &x) { // R815 + std::visit( + 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); + 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>(x.t), ",", ","); + Walk(std::get(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(x.t)); + Walk(" :: ", std::get>(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(x.t)); + Walk("(", std::get>(x.t), ")"); + Walk("[", std::get>(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(x.t) == BindEntity::Kind::Common}; + const char *slash{isCommon ? "/" : ""}; + Put(slash), Walk(std::get(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(x.t)); + Put('['), Walk(std::get(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>(x.t), ", "); + Put('/'), Walk(std::get>(x.t), ", "), Put('/'); + return false; + } + bool Pre(const DataImpliedDo &x) { // R840, R842 + Put("("), Walk(std::get>(x.t), ", "), Put(','); + Walk(std::get>(x.t), "::"); + Walk(std::get>(x.t)), Put(')'); + return false; + } + bool Pre(const DataStmtValue &x) { // R843 + Walk(std::get>(x.t), "*"); + Walk(std::get(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(x.t)); + Put('('), Walk(std::get(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(x.t) == SavedEntity::Kind::Common}; + const char *slash{isCommon ? "/" : ""}; + Put(slash), Walk(std::get(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 &y) { Walk(y, ", "); }, + [&](const std::list &y) { + Put("NONE"), Walk(" (", y, ", ", ")"); + }}, + x.u); + return false; + } + bool Pre(const ImplicitSpec &x) { // R864 + Walk(std::get(x.t)); + Put('('), Walk(std::get>(x.t), ", "), Put(')'); + return false; + } + bool Pre(const LetterSpec &x) { // R865 + Put(std::get(x.t)), Walk("-", std::get>(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(x.t)), Put('/'); + Walk(std::get>(x.t), ", "); + return false; + } + bool Pre(const EquivalenceStmt &x) { // R870, R871 + Put("EQUIVALENCE"); + const char *separator{" "}; + for (const std::list &y : x.v) { + Put(separator), Put('('), Walk(y), Put(')'); + separator = ", "; + } + return false; + } + bool Pre(const CommonStmt &x) { // R873 + Put("COMMON "); + Walk("/", std::get>>(x.t), "/"); + Walk(std::get>(x.t), ", "); + Walk(", ", std::get>(x.t), ", "); + return false; + } + bool Pre(const CommonBlockObject &x) { // R874 + Walk(std::get(x.t)); + Walk("(", std::get>(x.t), ")"); + return false; + } + bool Pre(const CommonStmt::Block &x) { + Walk("/", std::get>(x.t), "/"); + Walk(std::get>(x.t)); + return false; } - void Indent() { ++indent_; } - void Outdent() { --indent_; } + bool Pre(const Substring &x) { // R908, R909 + Walk(std::get(x.t)); + Put('('), Walk(std::get(x.t)), Put(')'); + return false; + } + bool Pre(const CharLiteralConstantSubstring &x) { + Walk(std::get(x.t)); + Put('('), Walk(std::get(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>(x.t), ","); + Walk(",", std::get>(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>(x.t), "::"); + Walk(std::get>(x.t), ", "); + Walk(", ", std::get>(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(x.t)); + Walk("(", std::get>(x.t), ",", ")"); + Walk("[", std::get>(x.t), "]"); + return false; + } + bool Pre(const AllocateShapeSpec &x) { // R934 & R938 + Walk(std::get>(x.t), ":"); + Walk(std::get(x.t)); + return false; + } + bool Pre(const AllocateCoarraySpec &x) { // R937 + Walk(std::get>(x.t), ",", ","); + Walk(std::get>(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>(x.t), ", "); + Walk(", ", std::get>(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(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(x.t)); + std::visit( + 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)); + 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>(x.t)), Put(percentOrDot_); + Walk(std::get(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>(x.t), ": "); + Put("WHERE ("), Walk(std::get(x.t)), Put(')'); + Indent(); + return false; + } + bool Pre(const MaskedElsewhereStmt &x) { // R1047 + Outdent(); + Put("ELSEWHERE ("), Walk(std::get(x.t)), Put(')'); + Walk(" ", std::get>(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>(x.t), ": "); + Put("FORALL"), Walk(std::get>(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>(x.t), ": "); + Put("ASSOCIATE ("), Walk(std::get>(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>(x.t), ": "); + Put("CHANGE TEAM ("), Walk(std::get(x.t)); + Walk(", ", std::get>(x.t), ", "); + Walk(", ", std::get>(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>(x.t), ", "); + Put(')'), Walk(" ", std::get>(x.t)); + return false; + } + bool Pre(const CriticalStmt &x) { // R1117 + Walk(std::get>(x.t), ": "); + Put("CRITICAL ("), Walk(std::get>(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>(x.t)); + Indent(), Walk(std::get(x.t), ""), Outdent(); + Walk(std::get>(x.t)); + return false; + } + bool Pre(const LabelDoStmt &x) { // R1121 + Walk(std::get>(x.t), ": "); + Put("DO "), Walk(std::get &x, const char *suffix = "") { + if (x.has_value()) { + Put(prefix), Walk(*x), Put(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) { + Put(str), Walk(x); + str = comma; + } + Put(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) { + Put(separator); + } + Walk(std::get(tuple)); + WalkTupleElements(tuple, separator); + } + } + template + void Walk(const std::tuple &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 Unparse(std::ostream &out, const Program &program) { - UnparseVisitor visitor{out}; - Walk(program, visitor); +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 diff --git a/flang/lib/parser/unparse.h b/flang/lib/parser/unparse.h index fe66546bea21..91f41e4de719 100644 --- a/flang/lib/parser/unparse.h +++ b/flang/lib/parser/unparse.h @@ -1,6 +1,7 @@ #ifndef FORTRAN_PARSER_UNPARSE_H_ #define FORTRAN_PARSER_UNPARSE_H_ +#include "characters.h" #include namespace Fortran { @@ -9,7 +10,8 @@ namespace parser { class Program; /// Convert parsed program to out as Fortran. -void Unparse(std::ostream &out, const Program &program); +void Unparse(std::ostream &out, const Program &program, + Encoding encoding = Encoding::UTF8); } // namespace parser } // namespace Fortran diff --git a/flang/lib/semantics/make-types.cc b/flang/lib/semantics/make-types.cc index a91622764bba..e0466e847366 100644 --- a/flang/lib/semantics/make-types.cc +++ b/flang/lib/semantics/make-types.cc @@ -325,11 +325,15 @@ static KindParamValue GetKindParamValue( const std::optional &kind) { if (!kind) { return KindParamValue(); - } else { + } else if (std::holds_alternative(kind->u)) { + const auto &expr = std::get(kind->u); const auto &lit = - std::get(kind->v.thing.thing.thing->u); + std::get(expr.thing.thing.thing->u); const auto &intlit = std::get(lit.u); return KindParamValue(std::get(intlit.t)); + } else { + // TODO: COMPLEX*16 means COMPLEX(KIND=8) (yes?); translate + return KindParamValue(std::get(kind->u).v); } } @@ -342,7 +346,6 @@ static const IntExpr *GetIntExpr(const parser::ScalarIntExpr &x) { return &IntConst::Make(std::get(intLit.t)); } } - std::cerr << "IntExpr:\n" << expr << "\n"; return new IntExpr(); // TODO } diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt index 588db35256e3..136a44411b3e 100644 --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -5,7 +5,7 @@ add_executable( f18 f18.cc ) target_link_libraries( f18 - FlangParser + FortranParser ) ######## test-type ########## @@ -15,6 +15,6 @@ add_executable( test-type ) target_link_libraries( test-type - FlangParser + FortranParser FlangSemantics ) diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc index 1f475f0f2ed2..dd3bbd7f91a6 100644 --- a/flang/tools/f18/f18.cc +++ b/flang/tools/f18/f18.cc @@ -1,27 +1,25 @@ // Temporary Fortran front end driver main program for development scaffolding. -#include "../../lib/parser/grammar.h" -#include "../../lib/parser/idioms.h" +#include "../../lib/parser/characters.h" #include "../../lib/parser/message.h" #include "../../lib/parser/parse-tree.h" #include "../../lib/parser/parse-tree-visitor.h" -#include "../../lib/parser/preprocessor.h" -#include "../../lib/parser/prescan.h" +#include "../../lib/parser/parsing.h" #include "../../lib/parser/provenance.h" #include "../../lib/parser/unparse.h" -#include "../../lib/parser/user-state.h" #include #include -#include #include +#include #include -#include #include #include #include -#include #include +#include +#include #include +#include static std::list argList(int argc, char *const argv[]) { std::list result; @@ -31,14 +29,6 @@ static std::list argList(int argc, char *const argv[]) { return result; } -namespace Fortran { -namespace parser { -constexpr auto grammar = program; -} // namespace parser -} // namespace Fortran -using Fortran::parser::grammar; -using ParseTree = typename decltype(grammar)::resultType; - struct MeasurementVisitor { template bool Pre(const A &) { return true; } template void Post(const A &) { @@ -48,7 +38,7 @@ struct MeasurementVisitor { size_t objects{0}, bytes{0}; }; -void MeasureParseTree(const ParseTree &program) { +void MeasureParseTree(const Fortran::parser::Program &program) { MeasurementVisitor visitor; Fortran::parser::Walk(program, visitor); std::cout << "Parse tree comprises " << visitor.objects @@ -56,134 +46,272 @@ void MeasureParseTree(const ParseTree &program) { << " total bytes.\n"; } -int main(int argc, char *const argv[]) { +std::vector filesToDelete; - auto args = argList(argc, argv); - std::string progName{args.front()}; - args.pop_front(); - - bool dumpCookedChars{false}, dumpProvenance{false}; - bool fixedForm{false}, freeForm{false}; - bool backslashEscapes{true}; - bool standard{false}; - bool enableOldDebugLines{false}; - int columns{72}; - - Fortran::parser::AllSources allSources; - - while (!args.empty()) { - if (args.front().empty()) { - args.pop_front(); - } else if (args.front().at(0) != '-' || args.front() == "-") { - break; - } else if (args.front() == "--") { - args.pop_front(); - break; - } else { - std::string flag{std::move(args.front())}; - args.pop_front(); - if (flag == "-Mfixed") { - fixedForm = true; - } else if (flag == "-Mfree") { - freeForm = true; - } else if (flag == "-Mbackslash") { - backslashEscapes = false; - } else if (flag == "-Mstandard") { - standard = false; - } else if (flag == "-Mextend") { - columns = 132; - } else if (flag == "-fdebug-dump-cooked-chars") { - dumpCookedChars = true; - } else if (flag == "-fdebug-dump-provenance") { - dumpProvenance = true; - } else if (flag == "-ed") { - enableOldDebugLines = true; - } else if (flag == "-I") { - allSources.PushSearchPathDirectory(args.front()); - args.pop_front(); - } else if (flag.substr(0, 2) == "-I") { - allSources.PushSearchPathDirectory(flag.substr(2, std::string::npos)); - } else { - std::cerr << "unknown flag: '" << flag << "'\n"; - return EXIT_FAILURE; - } +void CleanUpAtExit() { + for (const auto &path : filesToDelete) { + if (!path.empty()) { + unlink(path.data()); } } +} - std::string path{"-"}; - if (!args.empty()) { - path = std::move(args.front()); - args.pop_front(); - if (!args.empty()) { - std::cerr << "multiple input files\n"; - return EXIT_FAILURE; +struct DriverOptions { + DriverOptions() {} + bool verbose{false}; // -v + bool compileOnly{false}; // -c + std::string outputPath; // -o path + bool forcedForm{false}; // -Mfixed or -Mfree appeared + std::vector searchPath; // -I path + Fortran::parser::Encoding encoding{Fortran::parser::Encoding::UTF8}; + bool dumpProvenance{false}; + bool dumpCookedChars{false}; + bool dumpUnparse{false}; + bool measureTree{false}; + std::vector pgf90Args; + const char *prefix{nullptr}; +}; + +bool ParentProcess() { + if (fork() == 0) { + return false; // in child process + } + int childStat{0}; + wait(&childStat); + if (!WIFEXITED(childStat) || + WEXITSTATUS(childStat) != 0) { + exit(EXIT_FAILURE); + } + return true; +} + +void Exec(std::vector &argv, bool verbose = false) { + if (verbose) { + for (size_t j{0}; j < argv.size(); ++j) { + std::cerr << (j > 0 ? " " : "") << argv[j]; } + std::cerr << '\n'; } + argv.push_back(nullptr); + execvp(argv[0], &argv[0]); + std::cerr << "execvp(" << argv[0] << ") failed: " + << std::strerror(errno) << '\n'; + exit(EXIT_FAILURE); +} - std::stringstream error; - const auto *sourceFile = allSources.Open(path, &error); - if (!sourceFile) { - std::cerr << error.str() << '\n'; - return EXIT_FAILURE; - } - - if (!freeForm) { +std::string Compile(std::string path, Fortran::parser::Options options, + DriverOptions &driver) { + if (!driver.forcedForm) { auto dot = path.rfind("."); if (dot != std::string::npos) { std::string suffix{path.substr(dot + 1, std::string::npos)}; - if (suffix == "f" || suffix == "F") { - fixedForm = true; + options.isFixedForm = suffix == "f" || suffix == "F"; + } + } + Fortran::parser::Parsing parsing; + for (const auto &searchPath : driver.searchPath) { + parsing.PushSearchPathDirectory(searchPath); + } + if (!parsing.Prescan(path, options)) { + parsing.messages().Emit(std::cerr, driver.prefix); + exit(EXIT_FAILURE); + } + if (driver.dumpProvenance) { + parsing.DumpProvenance(std::cout); + return {}; + } + if (driver.dumpCookedChars) { + parsing.DumpCookedChars(std::cout); + return {}; + } + if (!parsing.Parse()) { + if (!parsing.consumedWholeFile()) { + std::cerr << "f18 FAIL; final position: "; + parsing.Identify(std::cerr, parsing.finalRestingPlace(), " "); + } + std::cerr << driver.prefix << "could not parse " << path << '\n'; + parsing.messages().Emit(std::cerr, driver.prefix); + exit(EXIT_FAILURE); + } + if (driver.measureTree) { + MeasureParseTree(parsing.parseTree()); + } + if (driver.dumpUnparse) { + Unparse(std::cout, parsing.parseTree(), driver.encoding); + return {}; + } + + parsing.messages().Emit(std::cerr, driver.prefix); + + std::string relo; + bool deleteReloAfterLink{false}; + if (driver.compileOnly && !driver.outputPath.empty()) { + relo = driver.outputPath; + } else { + std::string base{path}; + auto slash = base.rfind("/"); + if (slash != std::string::npos) { + base = base.substr(slash + 1); + } + auto dot = base.rfind("."); + if (dot == std::string::npos) { + relo = base; + } else { + relo = base.substr(0, dot); + } + relo += ".o"; + deleteReloAfterLink = !driver.compileOnly; + } + + char tmpSourcePath[32]; + std::snprintf(tmpSourcePath, sizeof tmpSourcePath, "/tmp/f18-%lx.f90", + static_cast(getpid())); + { std::ofstream tmpSource; + tmpSource.open(tmpSourcePath); + Unparse(tmpSource, parsing.parseTree(), driver.encoding); + } + + if (ParentProcess()) { + filesToDelete.push_back(tmpSourcePath); + if (deleteReloAfterLink) { + filesToDelete.push_back(relo); + } + return relo; + } + + std::vector argv; + for (size_t j{0}; j < driver.pgf90Args.size(); ++j) { + argv.push_back(driver.pgf90Args[j].data()); + } + char dashC[3] = "-c", dashO[3] = "-o"; + argv.push_back(dashC); + argv.push_back(dashO); + argv.push_back(relo.data()); + argv.push_back(tmpSourcePath); + Exec(argv, driver.verbose); + return {}; +} + +void Link(std::vector &relocatables, DriverOptions &driver) { + if (!ParentProcess()) { + std::vector argv; + for (size_t j{0}; j < driver.pgf90Args.size(); ++j) { + argv.push_back(driver.pgf90Args[j].data()); + } + for (auto &relo : relocatables) { + argv.push_back(relo.data()); + } + if (!driver.outputPath.empty()) { + char dashO[3] = "-o"; + argv.push_back(dashO); + argv.push_back(driver.outputPath.data()); + } + Exec(argv, driver.verbose); + } +} + +int main(int argc, char *const argv[]) { + + atexit(CleanUpAtExit); + + DriverOptions driver; + const char *pgf90{getenv("F18_FC")}; + driver.pgf90Args.push_back(pgf90 ? pgf90 : "pgf90"); + + std::list args{argList(argc, argv)}; + std::string prefix{args.front()}; + args.pop_front(); + prefix += ": "; + driver.prefix = prefix.data(); + + Fortran::parser::Options options; + std::vector sources, relocatables; + + while (!args.empty()) { + std::string arg{std::move(args.front())}; + args.pop_front(); + if (arg.empty()) { + } else if (arg.at(0) != '-') { + auto dot = arg.rfind("."); + if (dot == std::string::npos) { + driver.pgf90Args.push_back(arg); + } else { + std::string suffix{arg.substr(dot + 1, std::string::npos)}; + if (suffix == "f" || suffix == "F" || + suffix == "f90" || suffix == "F90" || + suffix == "cuf" || suffix == "CUF" || + suffix == "f18" || suffix == "F18") { + sources.push_back(arg); + } else { + driver.pgf90Args.push_back(arg); + } + } + } else if (arg == "-") { + sources.push_back("-"); + } else if (arg == "--") { + while (!args.empty()) { + sources.emplace_back(std::move(args.front())); + args.pop_front(); + } + break; + } else if (arg == "-Mfixed") { + driver.forcedForm = true; + options.isFixedForm = true; + } else if (arg == "-Mfree") { + driver.forcedForm = true; + options.isFixedForm = false; + } else if (arg == "-Mextend") { + options.fixedFormColumns = 132; + } else if (arg == "-Mbackslash") { + options.enableBackslashEscapes = false; + } else if (arg == "-Mstandard") { + options.isStrictlyStandard = true; + } else if (arg == "-ed") { + options.enableOldDebugLines = true; + } else if (arg == "-E") { + driver.dumpCookedChars = true; + } else if (arg == "-fdebug-dump-provenance") { + driver.dumpProvenance = true; + } else if (arg == "-fdebug-measure-parse-tree") { + driver.measureTree = true; + } else if (arg == "-funparse") { + driver.dumpUnparse = true; + } else if (arg == "-c") { + driver.compileOnly = true; + } else if (arg == "-o") { + driver.outputPath = args.front(); + args.pop_front(); + } else { + driver.pgf90Args.push_back(arg); + if (arg == "-v") { + driver.verbose = true; + } else if (arg == "-I") { + driver.pgf90Args.push_back(args.front()); + driver.searchPath.push_back(args.front()); + args.pop_front(); + } else if (arg.substr(0, 2) == "-I") { + driver.searchPath.push_back(arg.substr(2, std::string::npos)); + } else if (arg == "-Mx,125,4") { // PGI "all Kanji" mode + options.encoding = Fortran::parser::Encoding::EUC_JP; } } } + driver.encoding = options.encoding; - Fortran::parser::ProvenanceRange range{allSources.AddIncludedFile( - *sourceFile, Fortran::parser::ProvenanceRange{})}; - Fortran::parser::Messages messages{allSources}; - Fortran::parser::CookedSource cooked{&allSources}; - Fortran::parser::Preprocessor preprocessor{&allSources}; - Fortran::parser::Prescanner prescanner{&messages, &cooked, &preprocessor}; - bool prescanOk{prescanner.set_fixedForm(fixedForm) - .set_enableBackslashEscapesInCharLiterals(backslashEscapes) - .set_fixedFormColumnLimit(columns) - .set_enableOldDebugLines(enableOldDebugLines) - .Prescan(range)}; - messages.Emit(std::cerr); - if (!prescanOk) { - return EXIT_FAILURE; - } - columns = std::numeric_limits::max(); - - cooked.Marshal(); - if (dumpProvenance) { - cooked.Dump(std::cout); - } - - Fortran::parser::ParseState state{cooked}; - Fortran::parser::UserState ustate; - state.set_inFixedForm(fixedForm) - .set_strictConformance(standard) - .set_userState(&ustate); - - if (dumpCookedChars) { - while (std::optional och{state.GetNextChar()}) { - std::cout << *och; - } + if (sources.empty()) { + driver.measureTree = true; + driver.dumpUnparse = true; + Compile("-", options, driver); return EXIT_SUCCESS; } - - std::optional result{grammar.Parse(&state)}; - if (result.has_value() && !state.anyErrorRecovery()) { - MeasureParseTree(*result); - Unparse(std::cout, *result); - return EXIT_SUCCESS; - } else { - std::cerr << "demo FAIL\n"; - if (!state.IsAtEnd()) { - std::cerr << "final position: "; - allSources.Identify(std::cerr, state.GetProvenance(), " "); + for (const auto &path : sources) { + std::string relo{Compile(path, options, driver)}; + if (!driver.compileOnly && !relo.empty()) { + relocatables.push_back(relo); } - state.messages()->Emit(std::cerr); - return EXIT_FAILURE; } + if (!relocatables.empty()) { + Link(relocatables, driver); + } + return EXIT_SUCCESS; }