486 lines · cpp
1//===-- tools/f18/f18-parse-demo.cpp --------------------------------------===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9// F18 parsing demonstration.10// f18-parse-demo [ -E | -fdump-parse-tree | -funparse-only ]11// foo.{f,F,f77,F77,f90,F90,&c.}12//13// By default, runs the supplied source files through the F18 preprocessing and14// parsing phases, reconstitutes a Fortran program from the parse tree, and15// passes that Fortran program to a Fortran compiler identified by the $F18_FC16// environment variable (defaulting to gfortran). The Fortran preprocessor is17// always run, whatever the case of the source file extension. Unrecognized18// options are passed through to the underlying Fortran compiler.19//20// This program is actually a stripped-down variant of f18.cpp, a temporary21// scaffolding compiler driver that can test some semantic passes of the22// F18 compiler under development.23 24#include "flang/Parser/characters.h"25#include "flang/Parser/dump-parse-tree.h"26#include "flang/Parser/message.h"27#include "flang/Parser/parse-tree-visitor.h"28#include "flang/Parser/parse-tree.h"29#include "flang/Parser/parsing.h"30#include "flang/Parser/provenance.h"31#include "flang/Parser/unparse.h"32#include "flang/Support/Fortran-features.h"33#include "flang/Support/LangOptions.h"34#include "flang/Support/default-kinds.h"35#include "llvm/Support/Errno.h"36#include "llvm/Support/FileSystem.h"37#include "llvm/Support/Program.h"38#include "llvm/Support/raw_ostream.h"39#include <cstdio>40#include <cstring>41#include <fstream>42#include <list>43#include <memory>44#include <optional>45#include <stdlib.h>46#include <string>47#include <time.h>48#include <vector>49 50static std::list<std::string> argList(int argc, char *const argv[]) {51 std::list<std::string> result;52 for (int j = 0; j < argc; ++j) {53 result.emplace_back(argv[j]);54 }55 return result;56}57 58std::vector<std::string> filesToDelete;59 60void CleanUpAtExit() {61 for (const auto &path : filesToDelete) {62 if (!path.empty()) {63 llvm::sys::fs::remove(path);64 }65 }66}67 68#if _POSIX_C_SOURCE >= 199309L && _POSIX_TIMERS > 0 && _POSIX_CPUTIME && \69 defined CLOCK_PROCESS_CPUTIME_ID70static constexpr bool canTime{true};71double CPUseconds() {72 struct timespec tspec;73 clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &tspec);74 return tspec.tv_nsec * 1.0e-9 + tspec.tv_sec;75}76#else77static constexpr bool canTime{false};78double CPUseconds() { return 0; }79#endif80 81struct DriverOptions {82 DriverOptions() {}83 bool verbose{false}; // -v84 bool compileOnly{false}; // -c85 std::string outputPath; // -o path86 std::vector<std::string> searchDirectories{"."s}; // -I dir87 Fortran::common::LangOptions langOpts;88 bool forcedForm{false}; // -Mfixed or -Mfree appeared89 bool warnOnNonstandardUsage{false}; // -Mstandard90 bool warnOnSuspiciousUsage{false}; // -pedantic91 bool warningsAreErrors{false}; // -Werror92 Fortran::parser::Encoding encoding{Fortran::parser::Encoding::LATIN_1};93 bool lineDirectives{true}; // -P disables94 bool syntaxOnly{false};95 bool dumpProvenance{false};96 bool noReformat{false}; // -E -fno-reformat97 bool dumpUnparse{false};98 bool dumpParseTree{false};99 bool timeParse{false};100 std::vector<std::string> fcArgs;101 const char *prefix{nullptr};102};103 104void Exec(std::vector<llvm::StringRef> &argv, bool verbose = false) {105 if (verbose) {106 for (size_t j{0}; j < argv.size(); ++j) {107 llvm::errs() << (j > 0 ? " " : "") << argv[j];108 }109 llvm::errs() << '\n';110 }111 std::string ErrMsg;112 llvm::ErrorOr<std::string> Program = llvm::sys::findProgramByName(argv[0]);113 if (!Program)114 ErrMsg = Program.getError().message();115 if (!Program ||116 llvm::sys::ExecuteAndWait(117 Program.get(), argv, std::nullopt, {}, 0, 0, &ErrMsg)) {118 llvm::errs() << "execvp(" << argv[0] << ") failed: " << ErrMsg << '\n';119 exit(EXIT_FAILURE);120 }121}122 123void RunOtherCompiler(DriverOptions &driver, char *source, char *relo) {124 std::vector<llvm::StringRef> argv;125 for (size_t j{0}; j < driver.fcArgs.size(); ++j) {126 argv.push_back(driver.fcArgs[j]);127 }128 char dashC[3] = "-c", dashO[3] = "-o";129 argv.push_back(dashC);130 argv.push_back(dashO);131 argv.push_back(relo);132 argv.push_back(source);133 Exec(argv, driver.verbose);134}135 136std::string RelocatableName(const DriverOptions &driver, std::string path) {137 if (driver.compileOnly && !driver.outputPath.empty()) {138 return driver.outputPath;139 }140 std::string base{path};141 auto slash{base.rfind("/")};142 if (slash != std::string::npos) {143 base = base.substr(slash + 1);144 }145 std::string relo{base};146 auto dot{base.rfind(".")};147 if (dot != std::string::npos) {148 relo = base.substr(0, dot);149 }150 relo += ".o";151 return relo;152}153 154int exitStatus{EXIT_SUCCESS};155 156std::string CompileFortran(157 std::string path, Fortran::parser::Options options, DriverOptions &driver) {158 if (!driver.forcedForm) {159 auto dot{path.rfind(".")};160 if (dot != std::string::npos) {161 std::string suffix{path.substr(dot + 1)};162 options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff";163 }164 }165 options.searchDirectories = driver.searchDirectories;166 Fortran::parser::AllSources allSources;167 Fortran::parser::AllCookedSources allCookedSources{allSources};168 Fortran::parser::Parsing parsing{allCookedSources};169 170 auto start{CPUseconds()};171 parsing.Prescan(path, options);172 if (!parsing.messages().empty() &&173 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) {174 llvm::errs() << driver.prefix << "could not scan " << path << '\n';175 parsing.messages().Emit(llvm::errs(), parsing.allCooked());176 exitStatus = EXIT_FAILURE;177 return {};178 }179 if (driver.dumpProvenance) {180 parsing.DumpProvenance(llvm::outs());181 return {};182 }183 if (options.prescanAndReformat) {184 parsing.messages().Emit(llvm::errs(), allCookedSources);185 if (driver.noReformat) {186 parsing.DumpCookedChars(llvm::outs());187 } else {188 parsing.EmitPreprocessedSource(llvm::outs(), driver.lineDirectives);189 }190 return {};191 }192 parsing.Parse(llvm::outs());193 auto stop{CPUseconds()};194 if (driver.timeParse) {195 if (canTime) {196 llvm::outs() << "parse time for " << path << ": " << (stop - start)197 << " CPU seconds\n";198 } else {199 llvm::outs() << "no timing information due to lack of clock_gettime()\n";200 }201 }202 203 parsing.ClearLog();204 parsing.messages().Emit(llvm::errs(), parsing.allCooked());205 if (!parsing.consumedWholeFile()) {206 parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(),207 "parser FAIL (final position)", "error: ", llvm::raw_ostream::RED);208 exitStatus = EXIT_FAILURE;209 return {};210 }211 if ((!parsing.messages().empty() &&212 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) ||213 !parsing.parseTree()) {214 llvm::errs() << driver.prefix << "could not parse " << path << '\n';215 exitStatus = EXIT_FAILURE;216 return {};217 }218 auto &parseTree{*parsing.parseTree()};219 if (driver.dumpParseTree) {220 Fortran::parser::DumpTree(llvm::outs(), parseTree);221 return {};222 }223 if (driver.dumpUnparse) {224 Unparse(llvm::outs(), parseTree, driver.langOpts, driver.encoding,225 true /*capitalize*/,226 options.features.IsEnabled(227 Fortran::common::LanguageFeature::BackslashEscapes));228 return {};229 }230 if (driver.syntaxOnly) {231 return {};232 }233 234 std::string relo{RelocatableName(driver, path)};235 236 llvm::SmallString<32> tmpSourcePath;237 {238 int fd;239 std::error_code EC =240 llvm::sys::fs::createUniqueFile("f18-%%%%.f90", fd, tmpSourcePath);241 if (EC) {242 llvm::errs() << EC.message() << "\n";243 std::exit(EXIT_FAILURE);244 }245 llvm::raw_fd_ostream tmpSource(fd, /*shouldClose*/ true);246 Unparse(tmpSource, parseTree, driver.langOpts, driver.encoding,247 true /*capitalize*/,248 options.features.IsEnabled(249 Fortran::common::LanguageFeature::BackslashEscapes));250 }251 252 RunOtherCompiler(driver, tmpSourcePath.data(), relo.data());253 filesToDelete.emplace_back(tmpSourcePath);254 if (!driver.compileOnly && driver.outputPath.empty()) {255 filesToDelete.push_back(relo);256 }257 return relo;258}259 260std::string CompileOtherLanguage(std::string path, DriverOptions &driver) {261 std::string relo{RelocatableName(driver, path)};262 RunOtherCompiler(driver, path.data(), relo.data());263 if (!driver.compileOnly && driver.outputPath.empty()) {264 filesToDelete.push_back(relo);265 }266 return relo;267}268 269void Link(std::vector<std::string> &relocatables, DriverOptions &driver) {270 std::vector<llvm::StringRef> argv;271 for (size_t j{0}; j < driver.fcArgs.size(); ++j) {272 argv.push_back(driver.fcArgs[j].data());273 }274 for (auto &relo : relocatables) {275 argv.push_back(relo.data());276 }277 if (!driver.outputPath.empty()) {278 char dashO[3] = "-o";279 argv.push_back(dashO);280 argv.push_back(driver.outputPath.data());281 }282 Exec(argv, driver.verbose);283}284 285int main(int argc, char *const argv[]) {286 287 atexit(CleanUpAtExit);288 289 DriverOptions driver;290 const char *fc{getenv("F18_FC")};291 driver.fcArgs.push_back(fc ? fc : "gfortran");292 293 std::list<std::string> args{argList(argc, argv)};294 std::string prefix{args.front()};295 args.pop_front();296 prefix += ": ";297 driver.prefix = prefix.data();298 299 Fortran::parser::Options options;300 options.predefinitions.emplace_back("__F18", "1");301 options.predefinitions.emplace_back("__F18_MAJOR__", "1");302 options.predefinitions.emplace_back("__F18_MINOR__", "1");303 options.predefinitions.emplace_back("__F18_PATCHLEVEL__", "1");304 305 options.features.Enable(306 Fortran::common::LanguageFeature::BackslashEscapes, true);307 308 Fortran::common::IntrinsicTypeDefaultKinds defaultKinds;309 310 std::vector<std::string> fortranSources, otherSources, relocatables;311 bool anyFiles{false};312 313 while (!args.empty()) {314 std::string arg{std::move(args.front())};315 args.pop_front();316 if (arg.empty() || arg == "-Xflang") {317 } else if (arg.at(0) != '-') {318 anyFiles = true;319 auto dot{arg.rfind(".")};320 if (dot == std::string::npos) {321 driver.fcArgs.push_back(arg);322 } else {323 std::string suffix{arg.substr(dot + 1)};324 if (suffix == "f" || suffix == "F" || suffix == "ff" ||325 suffix == "f90" || suffix == "F90" || suffix == "ff90" ||326 suffix == "f95" || suffix == "F95" || suffix == "ff95" ||327 suffix == "cuf" || suffix == "CUF" || suffix == "f18" ||328 suffix == "F18" || suffix == "ff18") {329 fortranSources.push_back(arg);330 } else if (suffix == "o" || suffix == "a") {331 relocatables.push_back(arg);332 } else {333 otherSources.push_back(arg);334 }335 }336 } else if (arg == "-") {337 fortranSources.push_back("-");338 } else if (arg == "--") {339 while (!args.empty()) {340 fortranSources.emplace_back(std::move(args.front()));341 args.pop_front();342 }343 break;344 } else if (arg == "-Mfixed") {345 driver.forcedForm = true;346 options.isFixedForm = true;347 } else if (arg == "-Mfree") {348 driver.forcedForm = true;349 options.isFixedForm = false;350 } else if (arg == "-Mextend") {351 options.fixedFormColumns = 132;352 } else if (arg == "-Mbackslash") {353 options.features.Enable(354 Fortran::common::LanguageFeature::BackslashEscapes, false);355 } else if (arg == "-Mnobackslash") {356 options.features.Enable(357 Fortran::common::LanguageFeature::BackslashEscapes);358 } else if (arg == "-Mstandard") {359 driver.warnOnNonstandardUsage = true;360 } else if (arg == "-pedantic") {361 driver.warnOnNonstandardUsage = true;362 driver.warnOnSuspiciousUsage = true;363 } else if (arg == "-fopenmp") {364 options.features.Enable(Fortran::common::LanguageFeature::OpenMP);365 options.predefinitions.emplace_back("_OPENMP", "201511");366 } else if (arg == "-Werror") {367 driver.warningsAreErrors = true;368 } else if (arg == "-ed") {369 options.features.Enable(Fortran::common::LanguageFeature::OldDebugLines);370 } else if (arg == "-E") {371 options.prescanAndReformat = true;372 } else if (arg == "-P") {373 driver.lineDirectives = false;374 } else if (arg == "-fno-reformat") {375 driver.noReformat = true;376 } else if (arg == "-fbackslash") {377 options.features.Enable(378 Fortran::common::LanguageFeature::BackslashEscapes);379 } else if (arg == "-fno-backslash") {380 options.features.Enable(381 Fortran::common::LanguageFeature::BackslashEscapes, false);382 } else if (arg == "-fdump-provenance") {383 driver.dumpProvenance = true;384 } else if (arg == "-fdump-parse-tree") {385 driver.dumpParseTree = true;386 } else if (arg == "-funparse") {387 driver.dumpUnparse = true;388 } else if (arg == "-ftime-parse") {389 driver.timeParse = true;390 } else if (arg == "-fparse-only" || arg == "-fsyntax-only") {391 driver.syntaxOnly = true;392 } else if (arg == "-c") {393 driver.compileOnly = true;394 } else if (arg == "-o") {395 driver.outputPath = args.front();396 args.pop_front();397 } else if (arg.substr(0, 2) == "-D") {398 auto eq{arg.find('=')};399 if (eq == std::string::npos) {400 options.predefinitions.emplace_back(arg.substr(2), "1");401 } else {402 options.predefinitions.emplace_back(403 arg.substr(2, eq - 2), arg.substr(eq + 1));404 }405 } else if (arg.substr(0, 2) == "-U") {406 options.predefinitions.emplace_back(407 arg.substr(2), std::optional<std::string>{});408 } else if (arg == "-r8" || arg == "-fdefault-real-8") {409 defaultKinds.set_defaultRealKind(8);410 } else if (arg == "-i8" || arg == "-fdefault-integer-8") {411 defaultKinds.set_defaultIntegerKind(8);412 defaultKinds.set_defaultLogicalKind(8);413 } else if (arg == "-help" || arg == "--help" || arg == "-?") {414 llvm::errs()415 << "f18-parse-demo options:\n"416 << " -Mfixed | -Mfree force the source form\n"417 << " -Mextend 132-column fixed form\n"418 << " -f[no-]backslash enable[disable] \\escapes in literals\n"419 << " -M[no]backslash disable[enable] \\escapes in literals\n"420 << " -Mstandard enable conformance warnings\n"421 << " -r8 | -fdefault-real-8 | -i8 | -fdefault-integer-8 "422 "change default kinds of intrinsic types\n"423 << " -Werror treat warnings as errors\n"424 << " -ed enable fixed form D lines\n"425 << " -E prescan & preprocess only\n"426 << " -ftime-parse measure parsing time\n"427 << " -fsyntax-only parse only, no output except messages\n"428 << " -funparse parse & reformat only, no code "429 "generation\n"430 << " -fdump-provenance dump the provenance table (no code)\n"431 << " -fdump-parse-tree dump the parse tree (no code)\n"432 << " -v -c -o -I -D -U have their usual meanings\n"433 << " -help print this again\n"434 << "Other options are passed through to the $F18_FC compiler.\n";435 return exitStatus;436 } else if (arg == "-V") {437 llvm::errs() << "\nf18-parse-demo\n";438 return exitStatus;439 } else {440 driver.fcArgs.push_back(arg);441 if (arg == "-v") {442 driver.verbose = true;443 } else if (arg == "-I") {444 driver.fcArgs.push_back(args.front());445 driver.searchDirectories.push_back(args.front());446 args.pop_front();447 } else if (arg.substr(0, 2) == "-I") {448 driver.searchDirectories.push_back(arg.substr(2));449 }450 }451 }452 453 if (driver.warnOnNonstandardUsage) {454 options.features.WarnOnAllNonstandard();455 }456 if (driver.warnOnSuspiciousUsage) {457 options.features.WarnOnAllUsage();458 }459 if (!options.features.IsEnabled(460 Fortran::common::LanguageFeature::BackslashEscapes)) {461 driver.fcArgs.push_back("-fno-backslash"); // PGI "-Mbackslash"462 }463 464 if (!anyFiles) {465 driver.dumpUnparse = true;466 CompileFortran("-", options, driver);467 return exitStatus;468 }469 for (const auto &path : fortranSources) {470 std::string relo{CompileFortran(path, options, driver)};471 if (!driver.compileOnly && !relo.empty()) {472 relocatables.push_back(relo);473 }474 }475 for (const auto &path : otherSources) {476 std::string relo{CompileOtherLanguage(path, driver)};477 if (!driver.compileOnly && !relo.empty()) {478 relocatables.push_back(relo);479 }480 }481 if (!relocatables.empty()) {482 Link(relocatables, driver);483 }484 return exitStatus;485}486