maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Take flang-compiler/f18#2 on unparsing, now using the new parse tree walker. 

Clean out old data structure formatter.

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

Hello, world!

Better error recovery on command line errors.

Fix bugs from initial run at f77_correct.

Allow parentheses on PROGRAM statement.

Fix Hollerith scanning.

Remove REDIMENSION with good error recovery.

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

Fix bugs exposed by in38.f90.

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

Better multi-byte source encoding support in Hollerith.

Reformat C++.

More work on multi-byte source encoding.

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

Original-commit: flang-compiler/f18@8a1a0aa2dc
Reviewed-on: https://github.com/flang-compiler/f18/pull/25
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2018-02-28 16:56:10 -08:00
parent 6fab60d6db
commit 79d044e9b5
28 changed files with 2816 additions and 1523 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
flang/lib/parser/CMakeLists.txt
View File

@ -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

33
flang/lib/parser/basic-parsers.h
View File

@ -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<typename PA> 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<typename PA> 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<typename PA> 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);
}

70
flang/lib/parser/characters.cc Normal file
View File

@ -0,0 +1,70 @@
#include "characters.h"
namespace Fortran {
namespace parser {
std::optional<int> 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<int> 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<size_t> CountCharacters(
const char *p, size_t bytes, std::optional<int> (*cbf)(const char *)) {
size_t chars{0};
const char *limit{p + bytes};
while (p < limit) {
++chars;
if (std::optional<int> cb{cbf(p)}) {
p += *cb;
} else {
return {};
}
}
return {chars};
}
} // namespace parser
} // namespace Fortran

63
flang/lib/parser/characters.h
View File

@ -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<char>(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<char> 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<char> BackslashEscapeValue(char ch) {
static constexpr std::optional<char> 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<char> BackslashEscapeChar(char ch) {
default: return {};
}
}
template<typename NORMAL, typename INSERTED>
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<int> UTF8CharacterBytes(const char *);
std::optional<int> EUC_JPCharacterBytes(const char *);
std::optional<size_t> CountCharacters(
const char *, size_t bytes, std::optional<int> (*)(const char *));
} // namespace parser
} // namespace Fortran
#endif // FORTRAN_PARSER_CHARACTERS_H_

132
flang/lib/parser/grammar.h
View File

@ -97,6 +97,7 @@ constexpr Parser<IntentSpec> intentSpec; // R826
constexpr Parser<DataStmt> dataStmt; // R837
constexpr Parser<DataImpliedDo> dataImpliedDo; // R840
constexpr Parser<ParameterStmt> parameterStmt; // R851
constexpr Parser<OldParameterStmt> oldParameterStmt;
constexpr Parser<Designator> designator; // R901
constexpr Parser<Variable> variable; // R902
constexpr Parser<Substring> substring; // R908
@ -192,18 +193,22 @@ template<typename PA> 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<ErrorRecovery>{};
constexpr auto errorRecovery = construct<ErrorRecovery>{};
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<ErrorRecovery>{};
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<SpecificationConstruct>{}(indirect(interfaceBlock)) ||
construct<SpecificationConstruct>{}(
statement(indirect(parameterStmt))) ||
construct<SpecificationConstruct>{}(
statement(indirect(oldParameterStmt))) ||
construct<SpecificationConstruct>{}(
statement(indirect(Parser<ProcedureDeclarationStmt>{}))) ||
construct<SpecificationConstruct>{}(
@ -383,11 +390,12 @@ struct StartNewSubprogram {
}
} startNewSubprogram;
TYPE_PARSER(construct<Program>{}(
// statements consume only trailing noise; consume leading noise here.
skipMany("\n"_tok) >>
some(startNewSubprogram >> Parser<ProgramUnit>{} / endOfLine) /
consumedAllInput))
TYPE_PARSER(
construct<Program>{}(
// statements consume only trailing noise; consume leading noise here.
skipMany("\n"_tok) >>
some(startNewSubprogram >> Parser<ProgramUnit>{} / 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<ImplicitPartStmt>{}(
statement(indirect(Parser<ImplicitStmt>{}))) ||
construct<ImplicitPartStmt>{}(statement(indirect(parameterStmt))) ||
construct<ImplicitPartStmt>{}(statement(indirect(oldParameterStmt))) ||
construct<ImplicitPartStmt>{}(statement(indirect(formatStmt))) ||
construct<ImplicitPartStmt>{}(statement(indirect(entryStmt))))
@ -484,7 +493,6 @@ constexpr auto actionStmt = construct<ActionStmt>{}(
construct<ActionStmt>{}(indirect(Parser<WriteStmt>{})) ||
construct<ActionStmt>{}(indirect(Parser<ComputedGotoStmt>{})) ||
construct<ActionStmt>{}(indirect(forallStmt)) ||
construct<ActionStmt>{}(indirect(Parser<RedimensionStmt>{})) ||
construct<ActionStmt>{}(indirect(Parser<ArithmeticIfStmt>{})) ||
construct<ActionStmt>{}(indirect(Parser<AssignStmt>{})) ||
construct<ActionStmt>{}(indirect(Parser<AssignedGotoStmt>{})) ||
@ -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<ExecutionPartConstruct>(
"obsolete legacy extension is not supported"_en_US),
construct<ExecutionPartConstruct>{}(
statement("REDIMENSION" >> name >>
parenthesized(nonemptyList(Parser<AllocateShapeSpec>{})) >> ok) >>
errorRecovery));
TYPE_CONTEXT_PARSER("execution part construct"_en_US,
recovery(construct<ExecutionPartConstruct>{}(executableConstruct) ||
construct<ExecutionPartConstruct>{}(
@ -561,7 +578,8 @@ TYPE_CONTEXT_PARSER("execution part construct"_en_US,
construct<ExecutionPartConstruct>{}(
statement(indirect(dataStmt))) ||
extension(construct<ExecutionPartConstruct>{}(
statement(indirect(Parser<NamelistStmt>{})))),
statement(indirect(Parser<NamelistStmt>{}))) ||
obsoleteExecutionPartConstruct),
construct<ExecutionPartConstruct>{}(executionPartErrorRecovery)))
// R509 execution-part -> executable-construct [execution-part-construct]...
@ -691,17 +709,11 @@ TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,
TYPE_PARSER(construct<IntegerTypeSpec>{}("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<Expr>{}(construct<LiteralConstant>{}(
construct<IntLiteralConstant>{}(spaces >> digitString,
construct<std::optional<KindParam>>{})))))))));
// Legacy extension: kind-selector -> * digit-string
TYPE_PARSER(construct<KindSelector>{}(
parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr) ||
extStarKindExpr))
parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) ||
extension(construct<KindSelector>{}(
construct<KindSelector::StarSize>{}("*" >> 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<DerivedTypeStmt>{}(
optionalBeforeColons(nonemptyList(Parser<TypeAttrSpec>{})),
name, defaulted(parenthesized(nonemptyList(name)))))
construct<DerivedTypeStmt>{}(
"TYPE" >> optionalBeforeColons(nonemptyList(Parser<TypeAttrSpec>{})),
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<BindStmt>{}(
languageBindingSpec / maybe("::"_tok), nonemptyList(Parser<BindEntity>{})))
// R833 bind-entity -> entity-name | / common-block-name /
TYPE_PARSER(construct<BindEntity>{}(name, pure(false)) ||
"/" >> construct<BindEntity>{}(name, pure(true /*COMMON*/)) / "/")
TYPE_PARSER(construct<BindEntity>{}(pure(BindEntity::Kind::Object), name) ||
"/" >> construct<BindEntity>{}(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<OptionalStmt>{}(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<ParameterStmt>{}(
parenthesized(nonemptyList(Parser<NamedConstantDef>{})) ||
extension(nonemptyList(Parser<NamedConstantDef>{}))))
construct<ParameterStmt>{}(
"PARAMETER" >> parenthesized(nonemptyList(Parser<NamedConstantDef>{}))))
TYPE_CONTEXT_PARSER("old style PARAMETER statement"_en_US,
extension(construct<OldParameterStmt>{}(
"PARAMETER" >> nonemptyList(Parser<NamedConstantDef>{}))))
// R852 named-constant-def -> named-constant = constant-expr
TYPE_PARSER(construct<NamedConstantDef>{}(namedConstant, "=" >> constantExpr))
@ -1425,8 +1438,10 @@ TYPE_PARSER("SAVE" >> construct<SaveStmt>{}(defaulted(maybe("::"_tok) >>
// R857 saved-entity -> object-name | proc-pointer-name | / common-block-name /
// R858 proc-pointer-name -> name
TYPE_PARSER(construct<SavedEntity>{}(name, pure(false)) ||
"/" >> construct<SavedEntity>{}(name, pure(true /*COMMON*/)) / "/")
// TODO: Distinguish Kind::ProcPointer and Kind::Object
TYPE_PARSER(construct<SavedEntity>{}(pure(SavedEntity::Kind::Object), name) ||
"/" >>
construct<SavedEntity>{}(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<WaitSpec>{}(fileUnitNumber) ||
"IOMSG =" >> construct<WaitSpec>{}(msgVariable) ||
"IOSTAT =" >> construct<WaitSpec>{}(statVariable))
template<typename A> std::list<A> singletonList(A &&x) {
std::list<A> result;
result.push_front(std::move(x));
return result;
}
constexpr auto bareUnitNumberAsList =
applyFunction(singletonList<PositionOrFlushSpec>,
construct<PositionOrFlushSpec>{}(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<BackspaceStmt>{}(fileUnitNumber) ||
construct<BackspaceStmt>{}(
parenthesized(nonemptyList(positionOrFlushSpec)))))
construct<BackspaceStmt>{}("BACKSPACE" >> positionOrFlushSpecList))
// R1225 endfile-stmt ->
// ENDFILE file-unit-number | ENDFILE ( position-spec-list )
TYPE_CONTEXT_PARSER("ENDFILE statement"_en_US,
"ENDFILE" >> (construct<EndfileStmt>{}(fileUnitNumber) ||
construct<EndfileStmt>{}(
parenthesized(nonemptyList(positionOrFlushSpec)))))
construct<EndfileStmt>{}("ENDFILE" >> positionOrFlushSpecList))
// R1226 rewind-stmt -> REWIND file-unit-number | REWIND ( position-spec-list )
TYPE_CONTEXT_PARSER("REWIND statement"_en_US,
"REWIND" >> (construct<RewindStmt>{}(fileUnitNumber) ||
construct<RewindStmt>{}(
parenthesized(nonemptyList(positionOrFlushSpec)))))
construct<RewindStmt>{}("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<FlushStmt>{}(fileUnitNumber) ||
construct<FlushStmt>{}(
parenthesized(nonemptyList(positionOrFlushSpec)))))
construct<FlushStmt>{}("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<ProgramStmt>{}("PROGRAM" >> name))
// PGI allows empty parentheses after the name.
TYPE_CONTEXT_PARSER("PROGRAM statement"_en_US,
construct<ProgramStmt>{}(
"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<StmtFunctionStmt>{}(
name, parenthesized(optionalList(name)), "=" >> scalar(expr)))
// Extension and deprecated statements
TYPE_PARSER(extension(
"POINTER" >> parenthesized(construct<BasedPointerStmt>{}(objectName / ",",
objectName, maybe(Parser<ArraySpec>{})))))
TYPE_PARSER(
extension(construct<BasedPointerStmt>{}("POINTER (" >> objectName / ",",
objectName, maybe(Parser<ArraySpec>{}) / ")")))
TYPE_PARSER(extension("REDIMENSION" >>
construct<RedimensionStmt>{}(
objectName, parenthesized(nonemptyList(Parser<AllocateShapeSpec>{})))))
TYPE_PARSER("STRUCTURE /" >>
construct<StructureStmt>{}(name / "/", optionalList(entityDecl)) ||
"STRUCTURE" >>
construct<StructureStmt>{}(name, defaulted(cut >> many(entityDecl))))
TYPE_PARSER(construct<StructureStmt>{}("STRUCTURE /" >> name / "/", pure(true),
optionalList(entityDecl)) ||
construct<StructureStmt>{}(
"STRUCTURE" >> name, pure(false), defaulted(cut >> many(entityDecl))))
TYPE_PARSER(
construct<StructureField>{}(statement(Parser<DataComponentDefStmt>{})) ||

4
flang/lib/parser/idioms.cc
View File

@ -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

47
flang/lib/parser/idioms.h
View File

@ -17,7 +17,6 @@
#include <list>
#include <optional>
#include <ostream>
#include <tuple>
#include <type_traits>
#include <variant>
@ -58,8 +57,6 @@ template<typename... LAMBDAS> visitors(LAMBDAS... x)->visitors<LAMBDAS...>;
template<typename A> bool operator!(const std::optional<A> &x) {
return !x.has_value();
}
} // namespace parser
} // namespace Fortran
// For switch statements without default: labels.
#define CRASH_NO_CASE \
@ -105,50 +102,6 @@ template<typename A> struct BadType : std::false_type {};
} \
} \
template<typename A> constexpr bool T { class_trait_ns_##T::trait_value<A>() }
// Formatting
// TODO: remove when unparser is up and running
namespace Fortran {
namespace parser {
template<typename A>
std::ostream &operator<<(std::ostream &o, const std::optional<A> &x) {
if (x.has_value()) {
return o << x.value();
}
return o << "()";
}
template<typename A>
std::ostream &operator<<(std::ostream &o, const std::list<A> &xs) {
if (xs.empty()) {
return o << "[]";
}
char marker{'['};
for (const auto &x : xs) {
o << marker << x;
marker = ' ';
}
return o << ']';
}
template<int J, typename T>
std::ostream &formatTuple(std::ostream &o, const T &x) {
if constexpr (J < std::tuple_size_v<T>) {
return formatTuple<J + 1>(o << std::get<J>(x), x);
}
return o;
}
template<typename... As>
std::ostream &operator<<(std::ostream &o, const std::tuple<As...> &xs) {
return formatTuple<0>(o << '{', xs) << '}';
}
template<typename... As>
std::ostream &operator<<(std::ostream &o, const std::variant<As...> &x) {
return std::visit(
[&o](const auto &y) -> std::ostream & { return o << y; }, x);
}
} // namespace parser
} // namespace Fortran
#endif // FORTRAN_PARSER_IDIOMS_H_

6
flang/lib/parser/indirection.h
View File

@ -7,7 +7,6 @@
// Intended to be as invisible as possible.
#include "idioms.h"
#include <ostream>
#include <utility>
namespace Fortran {
@ -51,11 +50,6 @@ public:
private:
A *p_{nullptr};
};
template<typename A>
std::ostream &operator<<(std::ostream &o, const Indirection<A> &x) {
return o << *x;
}
} // namespace parser
} // namespace Fortran
#endif // FORTRAN_PARSER_INDIRECTION_H_

5
flang/lib/parser/message.cc
View File

@ -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 ";
}

2
flang/lib/parser/message.h
View File

@ -153,7 +153,7 @@ public:
}
}
void Emit(std::ostream &) const;
void Emit(std::ostream &, const char *prefix = nullptr) const;
private:
const AllSources &allSources_;

38
flang/lib/parser/parse-state.h
View File

@ -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<char> GetNextChar() {
if (p_ >= limit_) {
return {};
}
char ch{*p_++};
++column_;
if (ch == '\n') {
column_ = 1;
}
return {ch};
return {UncheckedAdvance()};
}
std::optional<char> 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!

1
flang/lib/parser/parse-tree-visitor.h
View File

@ -124,6 +124,7 @@ void Walk(const DefaultChar<T> &x, V &visitor) {
template<typename T, typename V> void Walk(const Statement<T> &x, V &visitor) {
if (visitor.Pre(x)) {
// N.B. the label is not traversed
Walk(x.statement, visitor);
visitor.Post(x);
}

735
flang/lib/parser/parse-tree.cc
View File

@ -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>{
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<char> &&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<std::list<ImplicitStmt::ImplicitNoneNameSpec>>(
x.u)) {
o << "NONE ";
}
std::visit([&o](const auto &y) { o << y; }, x.u);
return o << ')';
}
// R867
ImportStmt::ImportStmt(Kind &&k, std::list<Name> &&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<PartRef> &&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<Rename> &y) -> void { o << "RENAME " << y; },
[&o](const std::list<Only> &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

121
flang/lib/parser/parse-tree.h
View File

@ -17,7 +17,6 @@
#include <cinttypes>
#include <list>
#include <optional>
#include <ostream>
#include <string>
#include <tuple>
#include <type_traits>
@ -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<DerivedTypeDef>, Indirection<EnumDef>,
Statement<Indirection<GenericStmt>>, Indirection<InterfaceBlock>,
Statement<Indirection<ParameterStmt>>,
Statement<Indirection<OldParameterStmt>>,
Statement<Indirection<ProcedureDeclarationStmt>>,
Statement<OtherSpecificationStmt>,
Statement<Indirection<TypeDeclarationStmt>>, Indirection<StructureDef>>
@ -348,8 +345,9 @@ struct SpecificationConstruct {
struct ImplicitPartStmt {
UNION_CLASS_BOILERPLATE(ImplicitPartStmt);
std::variant<Statement<Indirection<ImplicitStmt>>,
Statement<Indirection<ParameterStmt>>, Statement<Indirection<FormatStmt>>,
Statement<Indirection<EntryStmt>>>
Statement<Indirection<ParameterStmt>>,
Statement<Indirection<OldParameterStmt>>,
Statement<Indirection<FormatStmt>>, Statement<Indirection<EntryStmt>>>
u;
};
@ -429,9 +427,8 @@ struct ActionStmt {
Indirection<SyncTeamStmt>, Indirection<UnlockStmt>, Indirection<WaitStmt>,
Indirection<WhereStmt>, Indirection<WriteStmt>,
Indirection<ComputedGotoStmt>, Indirection<ForallStmt>,
Indirection<RedimensionStmt>, Indirection<ArithmeticIfStmt>,
Indirection<AssignStmt>, Indirection<AssignedGotoStmt>,
Indirection<PauseStmt>>
Indirection<ArithmeticIfStmt>, Indirection<AssignStmt>,
Indirection<AssignedGotoStmt>, Indirection<PauseStmt>>
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<ScalarIntConstantExpr, StarSize> u;
};
// R705 integer-type-spec -> INTEGER [kind-selector]
@ -748,7 +748,7 @@ struct CharLiteralConstant {
std::string GetString() const { return std::get<std::string>(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<ObjectName>);
// R833 bind-entity -> entity-name | / common-block-name /
struct BindEntity {
TUPLE_CLASS_BOILERPLATE(BindEntity);
std::tuple<Name, bool /*COMMON*/> t;
DEFINE_NESTED_ENUM_CLASS(Kind, Object, Common);
std::tuple<Kind, Name> t;
};
// R832 bind-stmt -> language-binding-spec [::] bind-entity-list
@ -1412,7 +1413,8 @@ WRAPPER_CLASS(ProtectedStmt, std::list<Name>);
// R858 proc-pointer-name -> name
struct SavedEntity {
TUPLE_CLASS_BOILERPLATE(SavedEntity);
std::tuple<Name, bool /*COMMON*/> t;
DEFINE_NESTED_ENUM_CLASS(Kind, Object, ProcPointer, Common);
std::tuple<Kind, Name> 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<FileUnitNumber, std::list<PositionOrFlushSpec>> u;
};
WRAPPER_CLASS(BackspaceStmt, std::list<PositionOrFlushSpec>);
// R1225 endfile-stmt ->
// ENDFILE file-unit-number | ENDFILE ( position-spec-list )
struct EndfileStmt {
UNION_CLASS_BOILERPLATE(EndfileStmt);
std::variant<FileUnitNumber, std::list<PositionOrFlushSpec>> u;
};
WRAPPER_CLASS(EndfileStmt, std::list<PositionOrFlushSpec>);
// R1226 rewind-stmt -> REWIND file-unit-number | REWIND ( position-spec-list )
struct RewindStmt {
UNION_CLASS_BOILERPLATE(RewindStmt);
std::variant<FileUnitNumber, std::list<PositionOrFlushSpec>> u;
};
WRAPPER_CLASS(RewindStmt, std::list<PositionOrFlushSpec>);
// R1228 flush-stmt -> FLUSH file-unit-number | FLUSH ( flush-spec-list )
struct FlushStmt {
UNION_CLASS_BOILERPLATE(FlushStmt);
std::variant<FileUnitNumber, std::list<PositionOrFlushSpec>> u;
};
WRAPPER_CLASS(FlushStmt, std::list<PositionOrFlushSpec>);
// R1231 inquire-spec ->
// [UNIT =] file-unit-number | FILE = file-name-expr |
@ -3090,17 +3080,12 @@ struct StmtFunctionStmt {
std::tuple<Name, std::list<Name>, Scalar<Expr>> t;
};
// Extension and deprecated statements
// Legacy extensions
struct BasedPointerStmt {
TUPLE_CLASS_BOILERPLATE(BasedPointerStmt);
std::tuple<ObjectName, ObjectName, std::optional<ArraySpec>> t;
};
struct RedimensionStmt {
TUPLE_CLASS_BOILERPLATE(RedimensionStmt);
std::tuple<ObjectName, std::list<AllocateShapeSpec>> t;
};
struct Union;
struct StructureDef;
@ -3129,7 +3114,7 @@ struct Union {
struct StructureStmt {
TUPLE_CLASS_BOILERPLATE(StructureStmt);
std::tuple<Name, std::list<EntityDecl>> t;
std::tuple<Name, bool /*slashes*/, std::list<EntityDecl>> 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<NamedConstantDef>);
// Deprecations
struct ArithmeticIfStmt {
TUPLE_CLASS_BOILERPLATE(ArithmeticIfStmt);
std::tuple<Expr, Label, Label, Label> t;
@ -3156,59 +3146,6 @@ struct AssignedGotoStmt {
};
WRAPPER_CLASS(PauseStmt, std::optional<StopCode>);
// Formatting of template types
template<typename A>
std::ostream &operator<<(std::ostream &o, const Statement<A> &x) {
return o << "(Statement " << x.label << ' '
<< (x.isLabelInAcceptableField ? ""s : "!isLabelInAcceptableField "s)
<< ' ' << x.statement << ')';
}
template<typename A>
std::ostream &operator<<(std::ostream &o, const Scalar<A> &x) {
return o << "(Scalar- " << x.thing << ')';
}
template<typename A>
std::ostream &operator<<(std::ostream &o, const Constant<A> &x) {
return o << "(Constant- " << x.thing << ')';
}
template<typename A>
std::ostream &operator<<(std::ostream &o, const Integer<A> &x) {
return o << "(Integer- " << x.thing << ')';
}
template<typename A>
std::ostream &operator<<(std::ostream &o, const Logical<A> &x) {
return o << "(Logical- " << x.thing << ')';
}
template<typename A>
std::ostream &operator<<(std::ostream &o, const DefaultChar<A> &x) {
return o << "(DefaultChar- " << x.thing << ')';
}
template<typename A>
std::ostream &operator<<(std::ostream &o, const LoopBounds<A> &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<int>(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_

84
flang/lib/parser/parsing.cc Normal file
View File

@ -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 <sstream>
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<char> 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

56
flang/lib/parser/parsing.h Normal file
View File

@ -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 <ostream>
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<Program> parseTree_;
};
} // namespace parser
} // namespace Fortran
#endif // FORTRAN_PARSER_PARSING_H_

144
flang/lib/parser/prescan.cc
View File

@ -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<int> chBytes{EUC_JPCharacterBytes(at_)}) {
bytes = *chBytes;
}
} else if (encoding_ == Encoding::UTF8) {
if (std::optional<int> 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;

10
flang/lib/parser/prescan.h
View File

@ -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

13
flang/lib/parser/provenance.cc
View File

@ -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';

1
flang/lib/parser/provenance.h
View File

@ -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:

97
flang/lib/parser/token-parsers.h
View File

@ -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<Success> Parse(ParseState *state) {
std::optional<char> ch{nextChar.Parse(state)};
if (ch) {
if (ch == ' ' || ch == '\t') {
return {Success{}};
while (std::optional<char> 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<Success> Parse(ParseState *state) const {
auto at = state->GetLocation();
if (!spaces.Parse(state)) {
return {};
}
spaces.Parse(state);
const char *p{str_};
std::optional<char> ch; // initially empty
for (size_t j{0}; j < bytes_ && *p != '\0'; ++j, ++p) {
@ -236,9 +233,20 @@ template<char quote> 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<std::uint64_t> 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<std::string> Parse(ParseState *state) {
if (!spaces.Parse(state)) {
return {};
}
spaces.Parse(state);
auto at = state->GetLocation();
std::optional<std::uint64_t> 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<char> 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<int> 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<int> chBytes{UTF8CharacterBytes(p)}) {
bytes = *chBytes;
} else {
state->PutMessage(at, "bad UTF-8 characters in Hollerith"_en_US);
return {};
}
}
if (bytes == 1) {
std::optional<char> 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<char> byte{nextChar.Parse(state)};
CHECK(byte.has_value());
content += *byte;
}
}
content += *ch;
}
return {content};
}
@ -413,7 +446,7 @@ template<char goal> struct SkipTo {
if (*ch == goal) {
return {Success{}};
}
state->GetNextChar();
state->UncheckedAdvance();
}
return {};
}

12
flang/lib/parser/token-sequence.cc
View File

@ -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_);
}

2
flang/lib/parser/token-sequence.h
View File

@ -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(

2255
flang/lib/parser/unparse.cc
View File

File diff suppressed because it is too large Load Diff

4
flang/lib/parser/unparse.h
View File

@ -1,6 +1,7 @@
#ifndef FORTRAN_PARSER_UNPARSE_H_
#define FORTRAN_PARSER_UNPARSE_H_
#include "characters.h"
#include <iosfwd>
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

9
flang/lib/semantics/make-types.cc
View File

@ -325,11 +325,15 @@ static KindParamValue GetKindParamValue(
const std::optional<parser::KindSelector> &kind) {
if (!kind) {
return KindParamValue();
} else {
} else if (std::holds_alternative<parser::ScalarIntConstantExpr>(kind->u)) {
const auto &expr = std::get<parser::ScalarIntConstantExpr>(kind->u);
const auto &lit =
std::get<parser::LiteralConstant>(kind->v.thing.thing.thing->u);
std::get<parser::LiteralConstant>(expr.thing.thing.thing->u);
const auto &intlit = std::get<parser::IntLiteralConstant>(lit.u);
return KindParamValue(std::get<std::uint64_t>(intlit.t));
} else {
// TODO: COMPLEX*16 means COMPLEX(KIND=8) (yes?); translate
return KindParamValue(std::get<parser::KindSelector::StarSize>(kind->u).v);
}
}
@ -342,7 +346,6 @@ static const IntExpr *GetIntExpr(const parser::ScalarIntExpr &x) {
return &IntConst::Make(std::get<std::uint64_t>(intLit.t));
}
}
std::cerr << "IntExpr:\n" << expr << "\n";
return new IntExpr(); // TODO
}

4
flang/tools/f18/CMakeLists.txt
View File

@ -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
)

386
flang/tools/f18/f18.cc
View File

@ -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 <cerrno>
#include <cstdio>
#include <cstdlib>
#include <cstring>
#include <fstream>
#include <iostream>
#include <limits>
#include <list>
#include <memory>
#include <optional>
#include <sstream>
#include <string>
#include <vector>
#include <stdlib.h>
#include <unistd.h>
#include <sys/wait.h>
static std::list<std::string> argList(int argc, char *const argv[]) {
std::list<std::string> result;
@ -31,14 +29,6 @@ static std::list<std::string> 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<typename A> bool Pre(const A &) { return true; }
template<typename A> 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<std::string> 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<std::string> 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<std::string> 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<char *> &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<unsigned long>(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<char *> 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<std::string> &relocatables, DriverOptions &driver) {
if (!ParentProcess()) {
std::vector<char *> 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<std::string> args{argList(argc, argv)};
std::string prefix{args.front()};
args.pop_front();
prefix += ": ";
driver.prefix = prefix.data();
Fortran::parser::Options options;
std::vector<std::string> 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<int>::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<char> och{state.GetNextChar()}) {
std::cout << *och;
}
if (sources.empty()) {
driver.measureTree = true;
driver.dumpUnparse = true;
Compile("-", options, driver);
return EXIT_SUCCESS;
}
std::optional<ParseTree> 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;
}