// This is basically the old DECSIX encoding, which maps the
// 7-bit ASCII codes [32..95] to [0..63]. Only '#', '&', '?', '\', and '^'
// in that range are unused in Fortran after preprocessing outside
- // character literals. We repurpose '?' and '^' for newline and unknown
+ // character literals. We repurpose '^' and '?' for newline and unknown
// characters (resp.), leaving the others alone in case this code might
// be useful in preprocssing.
// TODO: EBCDIC?
if (c == '\n') {
- // map newline to '?'
- c = '?';
- } else if (c < 32 || c >= 127) {
- // map other control characters, DEL, and 8-bit characters to '^'
+ // map newline to '^'
c = '^';
+ } else if (c < 32 || c >= 127) {
+ // map other control characters, DEL, and 8-bit characters to '?'
+ c = '?';
} else if (c >= 96) {
// map lower-case letters to upper-case
c -= 32;
// each part is a name, maybe a (section-subscript-list), and
// maybe an [image-selector].
// If it's a substring, it ends with (substring-range).
-TYPE_PARSER(
+TYPE_CONTEXT_PARSER("designator"_en_US,
construct<Designator>{}(substring) || construct<Designator>{}(dataRef))
constexpr struct OldStructureComponentName {
// that are NOPASS). However, Fortran constrains the use of a variable in a
// proc-component-ref to be a data-ref without coindices (C1027).
// Some array element references will be misrecognized as function references.
-TYPE_PARSER(construct<Variable>{}(
- indirect(functionReference / !"("_ch) / !percentOrDot) ||
- construct<Variable>{}(indirect(designator)))
+TYPE_CONTEXT_PARSER("variable"_en_US,
+ construct<Variable>{}(
+ indirect(functionReference / !"("_ch) / !percentOrDot) ||
+ construct<Variable>{}(indirect(designator)))
// R904 logical-variable -> variable
// Appears only as part of scalar-logical-variable.
// literal-constant | designator | array-constructor |
// structure-constructor | function-reference | type-param-inquiry |
// type-param-name | ( expr )
-constexpr auto primary =
+constexpr auto primary = instrumented("primary"_en_US,
construct<Expr>{}(indirect(Parser<CharLiteralConstantSubstring>{})) ||
- construct<Expr>{}(literalConstant) ||
- construct<Expr>{}(construct<Expr::Parentheses>{}(parenthesized(expr))) ||
- construct<Expr>{}(indirect(functionReference) / !"("_tok) ||
- construct<Expr>{}(designator / !"("_tok) ||
- construct<Expr>{}(Parser<StructureConstructor>{}) ||
- construct<Expr>{}(Parser<ArrayConstructor>{}) ||
- construct<Expr>{}(indirect(Parser<TypeParamInquiry>{})) || // occulted
- // PGI/XLF extension: COMPLEX constructor (x,y)
- extension(construct<Expr>{}(parenthesized(
- construct<Expr::ComplexConstructor>{}(expr, "," >> expr)))) ||
- extension(construct<Expr>{}("%LOC" >>
- parenthesized(construct<Expr::PercentLoc>{}(indirect(variable)))));
+ construct<Expr>{}(literalConstant) ||
+ construct<Expr>{}(
+ construct<Expr::Parentheses>{}(parenthesized(expr))) ||
+ construct<Expr>{}(indirect(functionReference) / !"("_tok) ||
+ construct<Expr>{}(designator / !"("_tok) ||
+ construct<Expr>{}(Parser<StructureConstructor>{}) ||
+ construct<Expr>{}(Parser<ArrayConstructor>{}) ||
+ construct<Expr>{}(indirect(Parser<TypeParamInquiry>{})) || // occulted
+ // PGI/XLF extension: COMPLEX constructor (x,y)
+ extension(construct<Expr>{}(parenthesized(
+ construct<Expr::ComplexConstructor>{}(expr, "," >> expr)))) ||
+ extension(construct<Expr>{}("%LOC" >>
+ parenthesized(construct<Expr::PercentLoc>{}(indirect(variable))))));
// R1002 level-1-expr -> [defined-unary-op] primary
// TODO: Reasonable extension: permit multiple defined-unary-ops
construct<IntrinsicStmt>{}(nonemptyList(name)))
// R1520 function-reference -> procedure-designator ( [actual-arg-spec-list] )
-TYPE_PARSER(construct<FunctionReference>{}(construct<Call>{}(
- Parser<ProcedureDesignator>{}, parenthesized(optionalList(actualArgSpec)))))
+TYPE_CONTEXT_PARSER("function reference"_en_US,
+ construct<FunctionReference>{}(
+ construct<Call>{}(Parser<ProcedureDesignator>{},
+ parenthesized(optionalList(actualArgSpec)))))
// R1521 call-stmt -> CALL procedure-designator [( [actual-arg-spec-list] )]
TYPE_PARSER(construct<CallStmt>{}(
#include "instrumented-parser.h"
#include "message.h"
+#include "provenance.h"
#include <map>
#include <ostream>
return x.str() < y.str();
}
-void ParsingLog::Note(const char *at, const MessageFixedText &tag, bool pass) {
+bool ParsingLog::Fails(
+ const char *at, const MessageFixedText &tag, Messages &messages) {
std::size_t offset = reinterpret_cast<std::size_t>(at);
- if (pass) {
- ++perPos_[offset].perTag[tag].passes;
+ auto posIter = perPos_.find(offset);
+ if (posIter == perPos_.end()) {
+ return false;
+ }
+ auto tagIter = posIter->second.perTag.find(tag);
+ if (tagIter == posIter->second.perTag.end()) {
+ return false;
+ }
+ auto &entry = tagIter->second;
+ ++entry.count;
+ messages.Copy(entry.messages);
+ return !entry.pass;
+}
+
+void ParsingLog::Note(const char *at, const MessageFixedText &tag, bool pass,
+ const Messages &messages) {
+ std::size_t offset = reinterpret_cast<std::size_t>(at);
+ auto &entry = perPos_[offset].perTag[tag];
+ if (++entry.count == 1) {
+ entry.pass = pass;
+ entry.messages.Copy(messages);
} else {
- ++perPos_[offset].perTag[tag].failures;
+ CHECK(entry.pass == pass);
}
}
-void ParsingLog::Dump(std::ostream &o) const {
+void ParsingLog::Dump(std::ostream &o, const CookedSource &cooked) const {
for (const auto &posLog : perPos_) {
- o << "at offset " << posLog.first << ":\n";
+ const char *at{reinterpret_cast<const char *>(posLog.first)};
for (const auto &tagLog : posLog.second.perTag) {
- o << " " << tagLog.first.ToString() << ' ' << tagLog.second.passes
- << ", " << tagLog.second.failures << '\n';
+ Message{at, tagLog.first}.Emit(o, cooked, true);
+ o << " " << (tagLog.second.pass ? "pass" : "fail") << " "
+ << tagLog.second.count << '\n';
}
}
}
#include "message.h"
#include "parse-state.h"
+#include "provenance.h"
#include "user-state.h"
#include <cstddef>
#include <map>
class ParsingLog {
public:
- void Note(const char *at, const MessageFixedText &tag, bool pass);
- void Dump(std::ostream &) const;
+ bool Fails(const char *at, const MessageFixedText &tag, Messages &);
+ void Note(
+ const char *at, const MessageFixedText &tag, bool pass, const Messages &);
+ void Dump(std::ostream &, const CookedSource &) const;
private:
struct LogForPosition {
- struct Entries {
- int passes{0};
- int failures{0};
+ struct Entry {
+ Entry() {}
+ bool pass{true};
+ int count{0};
+ Messages messages;
};
- std::map<MessageFixedText, Entries> perTag;
+ std::map<MessageFixedText, Entry> perTag;
};
std::map<std::size_t, LogForPosition> perPos_;
};
constexpr InstrumentedParser(const MessageFixedText &tag, const PA &parser)
: tag_{tag}, parser_{parser} {}
std::optional<resultType> Parse(ParseState *state) const {
- const char *at{state->GetLocation()};
- std::optional<resultType> result{parser_.Parse(state)};
if (UserState * ustate{state->userState()}) {
if (ParsingLog * log{ustate->log()}) {
- log->Note(at, tag_, result.has_value());
+ const char *at{state->GetLocation()};
+ if (log->Fails(at, tag_, state->messages())) {
+ return {};
+ }
+ Messages messages{std::move(state->messages())};
+ std::optional<resultType> result{parser_.Parse(state)};
+ log->Note(at, tag_, result.has_value(), state->messages());
+ messages.Annex(state->messages());
+ state->messages() = std::move(messages);
+ return result;
}
}
- return result;
+ return parser_.Parse(state);
}
private:
}
}
-void Messages::Emit(
- std::ostream &o, const char *prefix, bool echoSourceLines) const {
+void Messages::Copy(const Messages &that) {
+ for (const Message &m : that) {
+ Put(Message{m});
+ }
+}
+
+void Messages::Emit(std::ostream &o, const CookedSource &cooked,
+ const char *prefix, bool echoSourceLines) const {
for (const auto &msg : messages_) {
if (prefix) {
o << prefix;
if (msg.context()) {
o << "In the context ";
}
- msg.Emit(o, cooked_, echoSourceLines);
+ msg.Emit(o, cooked, echoSourceLines);
}
}
using Context = CountedReference<Message>;
Message() {}
+ Message(const Message &) = default;
Message(Message &&) = default;
+ Message &operator=(const Message &that) = default;
Message &operator=(Message &&that) = default;
// TODO: Change these to cover ranges of provenance
using iterator = listType::iterator;
using const_iterator = listType::const_iterator;
- explicit Messages(const CookedSource &cooked) : cooked_{cooked} {}
- Messages(Messages &&that)
- : cooked_{that.cooked_}, messages_{std::move(that.messages_)} {
+ Messages() {}
+ Messages(Messages &&that) : messages_{std::move(that.messages_)} {
if (!messages_.empty()) {
last_ = that.last_;
that.last_ = that.messages_.before_begin();
const_iterator cbegin() const { return messages_.cbegin(); }
const_iterator cend() const { return messages_.cend(); }
- const CookedSource &cooked() const { return cooked_; }
-
- bool IsValidLocation(const Message &m) {
- if (auto p{m.cookedSourceLocation()}) {
- return cooked_.IsValid(p);
- } else {
- return cooked_.IsValid(m.provenance());
- }
- }
-
Message &Put(Message &&m) {
- CHECK(IsValidLocation(m));
last_ = messages_.emplace_after(last_, std::move(m));
return *last_;
}
}
void Incorporate(Messages &);
+ void Copy(const Messages &);
- void Emit(std::ostream &, const char *prefix = nullptr,
- bool echoSourceLines = true) const;
+ void Emit(std::ostream &, const CookedSource &cooked,
+ const char *prefix = nullptr, bool echoSourceLines = true) const;
bool AnyFatalError() const;
private:
- const CookedSource &cooked_;
listType messages_;
iterator last_{messages_.before_begin()};
};
public:
// TODO: Add a constructor for parsing a normalized module file.
ParseState(const CookedSource &cooked)
- : p_{&cooked[0]}, limit_{p_ + cooked.size()}, messages_{cooked} {}
+ : p_{&cooked[0]}, limit_{p_ + cooked.size()} {}
ParseState(const ParseState &that)
- : p_{that.p_}, limit_{that.limit_}, messages_{that.messages_.cooked()},
- context_{that.context_}, userState_{that.userState_},
- inFixedForm_{that.inFixedForm_}, encoding_{that.encoding_},
- strictConformance_{that.strictConformance_},
+ : p_{that.p_}, limit_{that.limit_}, context_{that.context_},
+ userState_{that.userState_}, inFixedForm_{that.inFixedForm_},
+ encoding_{that.encoding_}, strictConformance_{that.strictConformance_},
warnOnNonstandardUsage_{that.warnOnNonstandardUsage_},
warnOnDeprecatedUsage_{that.warnOnDeprecatedUsage_},
anyErrorRecovery_{that.anyErrorRecovery_},
void Parsing::DumpProvenance(std::ostream &out) const { cooked_.Dump(out); }
-void Parsing::DumpParsingLog(std::ostream &out) const { log_.Dump(out); }
+void Parsing::DumpParsingLog(std::ostream &out) const {
+ log_.Dump(out, cooked_);
+}
void Parsing::Parse() {
UserState userState;
- if (options_.instrumentedParse) {
+ if (options_.instrumentedParse || true /*pmk*/) {
userState.set_log(&log_);
}
ParseState parseState{cooked_};
bool Parsing::ForTesting(std::string path, std::ostream &err) {
Prescan(path, Options{});
if (messages_.AnyFatalError()) {
- messages_.Emit(err);
+ messages_.Emit(err, cooked_);
err << "could not scan " << path << '\n';
return false;
}
Parse();
- messages_.Emit(err);
+ messages_.Emit(err, cooked_);
if (!consumedWholeFile_) {
err << "f18 parser FAIL; final position: ";
Identify(err, finalRestingPlace_, " ");
bool consumedWholeFile() const { return consumedWholeFile_; }
const char *finalRestingPlace() const { return finalRestingPlace_; }
+ CookedSource &cooked() { return cooked_; }
Messages &messages() { return messages_; }
std::optional<Program> &parseTree() { return parseTree_; }
Options options_;
AllSources allSources_;
CookedSource cooked_{allSources_};
- Messages messages_{cooked_};
+ Messages messages_;
bool consumedWholeFile_{false};
const char *finalRestingPlace_{nullptr};
std::optional<Program> parseTree_;
void ResolveNames(
parser::Program &program, const parser::CookedSource &cookedSource) {
- parser::Messages messages{cookedSource};
+ parser::Messages messages;
ResolveNamesVisitor visitor{messages};
parser::Walk(static_cast<const parser::Program &>(program), visitor);
if (!messages.empty()) {
- messages.Emit(std::cerr);
+ messages.Emit(std::cerr, cookedSource);
return;
}
RewriteParseTree(program);
MeasurementVisitor visitor;
Fortran::parser::Walk(program, visitor);
std::cout << "Parse tree comprises " << visitor.objects
- << " objects and occupies " << visitor.bytes
- << " total bytes.\n";
+ << " objects and occupies " << visitor.bytes << " total bytes.\n";
}
std::vector<std::string> filesToDelete;
}
int childStat{0};
wait(&childStat);
- if (!WIFEXITED(childStat) ||
- WEXITSTATUS(childStat) != 0) {
+ if (!WIFEXITED(childStat) || WEXITSTATUS(childStat) != 0) {
exit(EXIT_FAILURE);
}
return true;
}
argv.push_back(nullptr);
execvp(argv[0], &argv[0]);
- std::cerr << "execvp(" << argv[0] << ") failed: "
- << std::strerror(errno) << '\n';
+ std::cerr << "execvp(" << argv[0] << ") failed: " << std::strerror(errno)
+ << '\n';
exit(EXIT_FAILURE);
}
return relo;
}
-std::string CompileFortran(std::string path, Fortran::parser::Options options,
- DriverOptions &driver) {
+std::string CompileFortran(
+ std::string path, Fortran::parser::Options options, DriverOptions &driver) {
if (!driver.forcedForm) {
auto dot = path.rfind(".");
if (dot != std::string::npos) {
if (!parsing.messages().empty() &&
(driver.warningsAreErrors || parsing.messages().AnyFatalError())) {
std::cerr << driver.prefix << "could not scan " << path << '\n';
- parsing.messages().Emit(std::cerr, driver.prefix);
+ parsing.messages().Emit(std::cerr, parsing.cooked(), driver.prefix);
exit(EXIT_FAILURE);
}
if (driver.dumpProvenance) {
parsing.DumpParsingLog(std::cout);
return {};
}
- parsing.messages().Emit(std::cerr, driver.prefix);
+ parsing.messages().Emit(std::cerr, parsing.cooked(), driver.prefix);
if (!parsing.consumedWholeFile()) {
std::cerr << "f18 parser FAIL; final position: ";
parsing.Identify(std::cerr, parsing.finalRestingPlace(), " ");
exit(EXIT_FAILURE);
}
if ((!parsing.messages().empty() &&
- (driver.warningsAreErrors || parsing.messages().AnyFatalError())) ||
+ (driver.warningsAreErrors || parsing.messages().AnyFatalError())) ||
!parsing.parseTree().has_value()) {
std::cerr << driver.prefix << "could not parse " << path << '\n';
exit(EXIT_FAILURE);
MeasureParseTree(*parsing.parseTree());
}
if (driver.debugResolveNames || driver.dumpSymbols) {
- Fortran::semantics::ResolveNames(
- *parsing.parseTree(), parsing.messages().cooked());
+ Fortran::semantics::ResolveNames(*parsing.parseTree(), parsing.cooked());
if (driver.dumpSymbols) {
Fortran::semantics::DumpSymbols(std::cout);
}
Fortran::parser::DumpTree(*parsing.parseTree());
}
if (driver.dumpUnparse) {
- Unparse(std::cout, *parsing.parseTree(), driver.encoding,
- true /*capitalize*/);
+ Unparse(
+ std::cout, *parsing.parseTree(), driver.encoding, true /*capitalize*/);
return {};
}
if (driver.parseOnly) {
char tmpSourcePath[32];
std::snprintf(tmpSourcePath, sizeof tmpSourcePath, "/tmp/f18-%lx.f90",
- static_cast<unsigned long>(getpid()));
- { std::ofstream tmpSource;
+ static_cast<unsigned long>(getpid()));
+ {
+ std::ofstream tmpSource;
tmpSource.open(tmpSourcePath);
Unparse(tmpSource, *parsing.parseTree(), driver.encoding);
}
driver.pgf90Args.push_back(arg);
} else {
std::string suffix{arg.substr(dot + 1)};
- if (suffix == "f" || suffix == "F" ||
- suffix == "f90" || suffix == "F90" ||
- suffix == "cuf" || suffix == "CUF" ||
+ if (suffix == "f" || suffix == "F" || suffix == "f90" ||
+ suffix == "F90" || suffix == "cuf" || suffix == "CUF" ||
suffix == "f18" || suffix == "F18") {
fortranSources.push_back(arg);
} else if (suffix == "o" || suffix == "a") {
if (eq == std::string::npos) {
options.predefinitions.emplace_back(arg.substr(2), "1");
} else {
- options.predefinitions.emplace_back(arg.substr(2, eq-2),
- arg.substr(eq+1));
+ options.predefinitions.emplace_back(
+ arg.substr(2, eq - 2), arg.substr(eq + 1));
}
- } else if (arg.substr(0, 2) == "-U") {
- options.predefinitions.emplace_back(arg.substr(2), std::optional<std::string>{});
+ } else if (arg.substr(0, 2) == "-U") {
+ options.predefinitions.emplace_back(
+ arg.substr(2), std::optional<std::string>{});
} else if (arg == "-help" || arg == "--help" || arg == "-?") {
- std::cerr << "f18 options:\n"
- << " -Mfixed | -Mfree force the source form\n"
- << " -Mextend 132-column fixed form\n"
- << " -M[no]backslash disable[enable] \\escapes in literals\n"
- << " -Mstandard enable conformance warnings\n"
- << " -Mx,125,4 set bit 2 in xflag[125] (all Kanji mode)\n"
- << " -Werror treat warnings as errors\n"
- << " -ed enable fixed form D lines\n"
- << " -E prescan & preprocess only\n"
- << " -fparse-only parse only, no output except messages\n"
- << " -funparse parse & reformat only, no code generation\n"
- << " -fdebug-measure-parse-tree\n"
- << " -fdebug-dump-provenance\n"
- << " -fdebug-dump-parse-tree\n"
- << " -fdebug-resolve-names\n"
- << " -fdebug-instrumented-parse\n"
- << " -v -c -o -I -D -U have their usual meanings\n"
- << " -help print this again\n"
- << "Other options are passed through to the compiler.\n";
+ std::cerr
+ << "f18 options:\n"
+ << " -Mfixed | -Mfree force the source form\n"
+ << " -Mextend 132-column fixed form\n"
+ << " -M[no]backslash disable[enable] \\escapes in literals\n"
+ << " -Mstandard enable conformance warnings\n"
+ << " -Mx,125,4 set bit 2 in xflag[125] (all Kanji mode)\n"
+ << " -Werror treat warnings as errors\n"
+ << " -ed enable fixed form D lines\n"
+ << " -E prescan & preprocess only\n"
+ << " -fparse-only parse only, no output except messages\n"
+ << " -funparse parse & reformat only, no code "
+ "generation\n"
+ << " -fdebug-measure-parse-tree\n"
+ << " -fdebug-dump-provenance\n"
+ << " -fdebug-dump-parse-tree\n"
+ << " -fdebug-resolve-names\n"
+ << " -fdebug-instrumented-parse\n"
+ << " -v -c -o -I -D -U have their usual meanings\n"
+ << " -help print this again\n"
+ << "Other options are passed through to the compiler.\n";
return EXIT_SUCCESS;
} else if (arg == "-V") {
std::cerr << "\nf18 compiler (under development)\n";
std::string path{argv[1]};
Parsing parsing;
if (parsing.ForTesting(path, std::cerr)) {
- DoSemanticAnalysis(parsing.messages().cooked(), *parsing.parseTree());
+ DoSemanticAnalysis(parsing.cooked(), *parsing.parseTree());
return EXIT_SUCCESS;
}
return EXIT_FAILURE;