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