|  | //===-- tools/f18/f18-parse-demo.cpp --------------------------------------===// | 
|  | // | 
|  | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. | 
|  | // See https://llvm.org/LICENSE.txt for license information. | 
|  | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception | 
|  | // | 
|  | //===----------------------------------------------------------------------===// | 
|  |  | 
|  | // F18 parsing demonstration. | 
|  | //   f18-parse-demo [ -E | -fdump-parse-tree | -funparse-only ] | 
|  | //     foo.{f,F,f77,F77,f90,F90,&c.} | 
|  | // | 
|  | // By default, runs the supplied source files through the F18 preprocessing and | 
|  | // parsing phases, reconstitutes a Fortran program from the parse tree, and | 
|  | // passes that Fortran program to a Fortran compiler identified by the $F18_FC | 
|  | // environment variable (defaulting to gfortran).  The Fortran preprocessor is | 
|  | // always run, whatever the case of the source file extension.  Unrecognized | 
|  | // options are passed through to the underlying Fortran compiler. | 
|  | // | 
|  | // This program is actually a stripped-down variant of f18.cpp, a temporary | 
|  | // scaffolding compiler driver that can test some semantic passes of the | 
|  | // F18 compiler under development. | 
|  |  | 
|  | #include "flang/Common/Fortran-features.h" | 
|  | #include "flang/Common/default-kinds.h" | 
|  | #include "flang/Parser/characters.h" | 
|  | #include "flang/Parser/dump-parse-tree.h" | 
|  | #include "flang/Parser/message.h" | 
|  | #include "flang/Parser/parse-tree-visitor.h" | 
|  | #include "flang/Parser/parse-tree.h" | 
|  | #include "flang/Parser/parsing.h" | 
|  | #include "flang/Parser/provenance.h" | 
|  | #include "flang/Parser/unparse.h" | 
|  | #include "llvm/Support/Errno.h" | 
|  | #include "llvm/Support/FileSystem.h" | 
|  | #include "llvm/Support/Program.h" | 
|  | #include "llvm/Support/raw_ostream.h" | 
|  | #include <cstdio> | 
|  | #include <cstring> | 
|  | #include <fstream> | 
|  | #include <list> | 
|  | #include <memory> | 
|  | #include <optional> | 
|  | #include <stdlib.h> | 
|  | #include <string> | 
|  | #include <time.h> | 
|  | #include <vector> | 
|  |  | 
|  | static std::list<std::string> argList(int argc, char *const argv[]) { | 
|  | std::list<std::string> result; | 
|  | for (int j = 0; j < argc; ++j) { | 
|  | result.emplace_back(argv[j]); | 
|  | } | 
|  | return result; | 
|  | } | 
|  |  | 
|  | std::vector<std::string> filesToDelete; | 
|  |  | 
|  | void CleanUpAtExit() { | 
|  | for (const auto &path : filesToDelete) { | 
|  | if (!path.empty()) { | 
|  | llvm::sys::fs::remove(path); | 
|  | } | 
|  | } | 
|  | } | 
|  |  | 
|  | #if _POSIX_C_SOURCE >= 199309L && _POSIX_TIMERS > 0 && _POSIX_CPUTIME && \ | 
|  | defined CLOCK_PROCESS_CPUTIME_ID | 
|  | static constexpr bool canTime{true}; | 
|  | double CPUseconds() { | 
|  | struct timespec tspec; | 
|  | clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &tspec); | 
|  | return tspec.tv_nsec * 1.0e-9 + tspec.tv_sec; | 
|  | } | 
|  | #else | 
|  | static constexpr bool canTime{false}; | 
|  | double CPUseconds() { return 0; } | 
|  | #endif | 
|  |  | 
|  | struct DriverOptions { | 
|  | DriverOptions() {} | 
|  | bool verbose{false}; // -v | 
|  | bool compileOnly{false}; // -c | 
|  | std::string outputPath; // -o path | 
|  | std::vector<std::string> searchDirectories{"."s}; // -I dir | 
|  | bool forcedForm{false}; // -Mfixed or -Mfree appeared | 
|  | bool warnOnNonstandardUsage{false}; // -Mstandard | 
|  | bool warningsAreErrors{false}; // -Werror | 
|  | Fortran::parser::Encoding encoding{Fortran::parser::Encoding::LATIN_1}; | 
|  | bool lineDirectives{true}; // -P disables | 
|  | bool syntaxOnly{false}; | 
|  | bool dumpProvenance{false}; | 
|  | bool noReformat{false}; // -E -fno-reformat | 
|  | bool dumpUnparse{false}; | 
|  | bool dumpParseTree{false}; | 
|  | bool timeParse{false}; | 
|  | std::vector<std::string> fcArgs; | 
|  | const char *prefix{nullptr}; | 
|  | }; | 
|  |  | 
|  | void Exec(std::vector<llvm::StringRef> &argv, bool verbose = false) { | 
|  | if (verbose) { | 
|  | for (size_t j{0}; j < argv.size(); ++j) { | 
|  | llvm::errs() << (j > 0 ? " " : "") << argv[j]; | 
|  | } | 
|  | llvm::errs() << '\n'; | 
|  | } | 
|  | std::string ErrMsg; | 
|  | llvm::ErrorOr<std::string> Program = llvm::sys::findProgramByName(argv[0]); | 
|  | if (!Program) | 
|  | ErrMsg = Program.getError().message(); | 
|  | if (!Program || | 
|  | llvm::sys::ExecuteAndWait( | 
|  | Program.get(), argv, llvm::None, {}, 0, 0, &ErrMsg)) { | 
|  | llvm::errs() << "execvp(" << argv[0] << ") failed: " << ErrMsg << '\n'; | 
|  | exit(EXIT_FAILURE); | 
|  | } | 
|  | } | 
|  |  | 
|  | void RunOtherCompiler(DriverOptions &driver, char *source, char *relo) { | 
|  | std::vector<llvm::StringRef> argv; | 
|  | for (size_t j{0}; j < driver.fcArgs.size(); ++j) { | 
|  | argv.push_back(driver.fcArgs[j]); | 
|  | } | 
|  | char dashC[3] = "-c", dashO[3] = "-o"; | 
|  | argv.push_back(dashC); | 
|  | argv.push_back(dashO); | 
|  | argv.push_back(relo); | 
|  | argv.push_back(source); | 
|  | Exec(argv, driver.verbose); | 
|  | } | 
|  |  | 
|  | std::string RelocatableName(const DriverOptions &driver, std::string path) { | 
|  | if (driver.compileOnly && !driver.outputPath.empty()) { | 
|  | return driver.outputPath; | 
|  | } | 
|  | std::string base{path}; | 
|  | auto slash{base.rfind("/")}; | 
|  | if (slash != std::string::npos) { | 
|  | base = base.substr(slash + 1); | 
|  | } | 
|  | std::string relo{base}; | 
|  | auto dot{base.rfind(".")}; | 
|  | if (dot != std::string::npos) { | 
|  | relo = base.substr(0, dot); | 
|  | } | 
|  | relo += ".o"; | 
|  | return relo; | 
|  | } | 
|  |  | 
|  | int exitStatus{EXIT_SUCCESS}; | 
|  |  | 
|  | std::string CompileFortran( | 
|  | 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)}; | 
|  | options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff"; | 
|  | } | 
|  | } | 
|  | options.searchDirectories = driver.searchDirectories; | 
|  | Fortran::parser::AllSources allSources; | 
|  | Fortran::parser::AllCookedSources allCookedSources{allSources}; | 
|  | Fortran::parser::Parsing parsing{allCookedSources}; | 
|  |  | 
|  | auto start{CPUseconds()}; | 
|  | parsing.Prescan(path, options); | 
|  | if (!parsing.messages().empty() && | 
|  | (driver.warningsAreErrors || parsing.messages().AnyFatalError())) { | 
|  | llvm::errs() << driver.prefix << "could not scan " << path << '\n'; | 
|  | parsing.messages().Emit(llvm::errs(), parsing.allCooked()); | 
|  | exitStatus = EXIT_FAILURE; | 
|  | return {}; | 
|  | } | 
|  | if (driver.dumpProvenance) { | 
|  | parsing.DumpProvenance(llvm::outs()); | 
|  | return {}; | 
|  | } | 
|  | if (options.prescanAndReformat) { | 
|  | parsing.messages().Emit(llvm::errs(), allCookedSources); | 
|  | if (driver.noReformat) { | 
|  | parsing.DumpCookedChars(llvm::outs()); | 
|  | } else { | 
|  | parsing.EmitPreprocessedSource(llvm::outs(), driver.lineDirectives); | 
|  | } | 
|  | return {}; | 
|  | } | 
|  | parsing.Parse(llvm::outs()); | 
|  | auto stop{CPUseconds()}; | 
|  | if (driver.timeParse) { | 
|  | if (canTime) { | 
|  | llvm::outs() << "parse time for " << path << ": " << (stop - start) | 
|  | << " CPU seconds\n"; | 
|  | } else { | 
|  | llvm::outs() << "no timing information due to lack of clock_gettime()\n"; | 
|  | } | 
|  | } | 
|  |  | 
|  | parsing.ClearLog(); | 
|  | parsing.messages().Emit(llvm::errs(), parsing.allCooked()); | 
|  | if (!parsing.consumedWholeFile()) { | 
|  | parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(), | 
|  | "parser FAIL (final position)"); | 
|  | exitStatus = EXIT_FAILURE; | 
|  | return {}; | 
|  | } | 
|  | if ((!parsing.messages().empty() && | 
|  | (driver.warningsAreErrors || parsing.messages().AnyFatalError())) || | 
|  | !parsing.parseTree()) { | 
|  | llvm::errs() << driver.prefix << "could not parse " << path << '\n'; | 
|  | exitStatus = EXIT_FAILURE; | 
|  | return {}; | 
|  | } | 
|  | auto &parseTree{*parsing.parseTree()}; | 
|  | if (driver.dumpParseTree) { | 
|  | Fortran::parser::DumpTree(llvm::outs(), parseTree); | 
|  | return {}; | 
|  | } | 
|  | if (driver.dumpUnparse) { | 
|  | Unparse(llvm::outs(), parseTree, driver.encoding, true /*capitalize*/, | 
|  | options.features.IsEnabled( | 
|  | Fortran::common::LanguageFeature::BackslashEscapes)); | 
|  | return {}; | 
|  | } | 
|  | if (driver.syntaxOnly) { | 
|  | return {}; | 
|  | } | 
|  |  | 
|  | std::string relo{RelocatableName(driver, path)}; | 
|  |  | 
|  | llvm::SmallString<32> tmpSourcePath; | 
|  | { | 
|  | int fd; | 
|  | std::error_code EC = | 
|  | llvm::sys::fs::createUniqueFile("f18-%%%%.f90", fd, tmpSourcePath); | 
|  | if (EC) { | 
|  | llvm::errs() << EC.message() << "\n"; | 
|  | std::exit(EXIT_FAILURE); | 
|  | } | 
|  | llvm::raw_fd_ostream tmpSource(fd, /*shouldClose*/ true); | 
|  | Unparse(tmpSource, parseTree, driver.encoding, true /*capitalize*/, | 
|  | options.features.IsEnabled( | 
|  | Fortran::common::LanguageFeature::BackslashEscapes)); | 
|  | } | 
|  |  | 
|  | RunOtherCompiler(driver, tmpSourcePath.data(), relo.data()); | 
|  | filesToDelete.emplace_back(tmpSourcePath); | 
|  | if (!driver.compileOnly && driver.outputPath.empty()) { | 
|  | filesToDelete.push_back(relo); | 
|  | } | 
|  | return relo; | 
|  | } | 
|  |  | 
|  | std::string CompileOtherLanguage(std::string path, DriverOptions &driver) { | 
|  | std::string relo{RelocatableName(driver, path)}; | 
|  | RunOtherCompiler(driver, path.data(), relo.data()); | 
|  | if (!driver.compileOnly && driver.outputPath.empty()) { | 
|  | filesToDelete.push_back(relo); | 
|  | } | 
|  | return relo; | 
|  | } | 
|  |  | 
|  | void Link(std::vector<std::string> &relocatables, DriverOptions &driver) { | 
|  | std::vector<llvm::StringRef> argv; | 
|  | for (size_t j{0}; j < driver.fcArgs.size(); ++j) { | 
|  | argv.push_back(driver.fcArgs[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 *fc{getenv("F18_FC")}; | 
|  | driver.fcArgs.push_back(fc ? fc : "gfortran"); | 
|  |  | 
|  | 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; | 
|  | options.predefinitions.emplace_back("__F18", "1"); | 
|  | options.predefinitions.emplace_back("__F18_MAJOR__", "1"); | 
|  | options.predefinitions.emplace_back("__F18_MINOR__", "1"); | 
|  | options.predefinitions.emplace_back("__F18_PATCHLEVEL__", "1"); | 
|  |  | 
|  | options.features.Enable( | 
|  | Fortran::common::LanguageFeature::BackslashEscapes, true); | 
|  |  | 
|  | Fortran::common::IntrinsicTypeDefaultKinds defaultKinds; | 
|  |  | 
|  | std::vector<std::string> fortranSources, otherSources, relocatables; | 
|  | bool anyFiles{false}; | 
|  |  | 
|  | while (!args.empty()) { | 
|  | std::string arg{std::move(args.front())}; | 
|  | args.pop_front(); | 
|  | if (arg.empty() || arg == "-Xflang") { | 
|  | } else if (arg.at(0) != '-') { | 
|  | anyFiles = true; | 
|  | auto dot{arg.rfind(".")}; | 
|  | if (dot == std::string::npos) { | 
|  | driver.fcArgs.push_back(arg); | 
|  | } else { | 
|  | std::string suffix{arg.substr(dot + 1)}; | 
|  | if (suffix == "f" || suffix == "F" || suffix == "ff" || | 
|  | suffix == "f90" || suffix == "F90" || suffix == "ff90" || | 
|  | suffix == "f95" || suffix == "F95" || suffix == "ff95" || | 
|  | suffix == "cuf" || suffix == "CUF" || suffix == "f18" || | 
|  | suffix == "F18" || suffix == "ff18") { | 
|  | fortranSources.push_back(arg); | 
|  | } else if (suffix == "o" || suffix == "a") { | 
|  | relocatables.push_back(arg); | 
|  | } else { | 
|  | otherSources.push_back(arg); | 
|  | } | 
|  | } | 
|  | } else if (arg == "-") { | 
|  | fortranSources.push_back("-"); | 
|  | } else if (arg == "--") { | 
|  | while (!args.empty()) { | 
|  | fortranSources.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.features.Enable( | 
|  | Fortran::common::LanguageFeature::BackslashEscapes, false); | 
|  | } else if (arg == "-Mnobackslash") { | 
|  | options.features.Enable( | 
|  | Fortran::common::LanguageFeature::BackslashEscapes); | 
|  | } else if (arg == "-Mstandard") { | 
|  | driver.warnOnNonstandardUsage = true; | 
|  | } else if (arg == "-fopenmp") { | 
|  | options.features.Enable(Fortran::common::LanguageFeature::OpenMP); | 
|  | options.predefinitions.emplace_back("_OPENMP", "201511"); | 
|  | } else if (arg == "-Werror") { | 
|  | driver.warningsAreErrors = true; | 
|  | } else if (arg == "-ed") { | 
|  | options.features.Enable(Fortran::common::LanguageFeature::OldDebugLines); | 
|  | } else if (arg == "-E") { | 
|  | options.prescanAndReformat = true; | 
|  | } else if (arg == "-P") { | 
|  | driver.lineDirectives = false; | 
|  | } else if (arg == "-fno-reformat") { | 
|  | driver.noReformat = true; | 
|  | } else if (arg == "-fbackslash") { | 
|  | options.features.Enable( | 
|  | Fortran::common::LanguageFeature::BackslashEscapes); | 
|  | } else if (arg == "-fno-backslash") { | 
|  | options.features.Enable( | 
|  | Fortran::common::LanguageFeature::BackslashEscapes, false); | 
|  | } else if (arg == "-fdump-provenance") { | 
|  | driver.dumpProvenance = true; | 
|  | } else if (arg == "-fdump-parse-tree") { | 
|  | driver.dumpParseTree = true; | 
|  | } else if (arg == "-funparse") { | 
|  | driver.dumpUnparse = true; | 
|  | } else if (arg == "-ftime-parse") { | 
|  | driver.timeParse = true; | 
|  | } else if (arg == "-fparse-only" || arg == "-fsyntax-only") { | 
|  | driver.syntaxOnly = true; | 
|  | } else if (arg == "-c") { | 
|  | driver.compileOnly = true; | 
|  | } else if (arg == "-o") { | 
|  | driver.outputPath = args.front(); | 
|  | args.pop_front(); | 
|  | } else if (arg.substr(0, 2) == "-D") { | 
|  | auto eq{arg.find('=')}; | 
|  | 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)); | 
|  | } | 
|  | } else if (arg.substr(0, 2) == "-U") { | 
|  | options.predefinitions.emplace_back( | 
|  | arg.substr(2), std::optional<std::string>{}); | 
|  | } else if (arg == "-r8" || arg == "-fdefault-real-8") { | 
|  | defaultKinds.set_defaultRealKind(8); | 
|  | } else if (arg == "-i8" || arg == "-fdefault-integer-8") { | 
|  | defaultKinds.set_defaultIntegerKind(8); | 
|  | } else if (arg == "-help" || arg == "--help" || arg == "-?") { | 
|  | llvm::errs() | 
|  | << "f18-parse-demo options:\n" | 
|  | << "  -Mfixed | -Mfree     force the source form\n" | 
|  | << "  -Mextend             132-column fixed form\n" | 
|  | << "  -f[no-]backslash     enable[disable] \\escapes in literals\n" | 
|  | << "  -M[no]backslash      disable[enable] \\escapes in literals\n" | 
|  | << "  -Mstandard           enable conformance warnings\n" | 
|  | << "  -r8 | -fdefault-real-8 | -i8 | -fdefault-integer-8  " | 
|  | "change default kinds of intrinsic types\n" | 
|  | << "  -Werror              treat warnings as errors\n" | 
|  | << "  -ed                  enable fixed form D lines\n" | 
|  | << "  -E                   prescan & preprocess only\n" | 
|  | << "  -ftime-parse         measure parsing time\n" | 
|  | << "  -fsyntax-only        parse only, no output except messages\n" | 
|  | << "  -funparse            parse & reformat only, no code " | 
|  | "generation\n" | 
|  | << "  -fdump-provenance    dump the provenance table (no code)\n" | 
|  | << "  -fdump-parse-tree    dump the parse tree (no code)\n" | 
|  | << "  -v -c -o -I -D -U    have their usual meanings\n" | 
|  | << "  -help                print this again\n" | 
|  | << "Other options are passed through to the $F18_FC compiler.\n"; | 
|  | return exitStatus; | 
|  | } else if (arg == "-V") { | 
|  | llvm::errs() << "\nf18-parse-demo\n"; | 
|  | return exitStatus; | 
|  | } else { | 
|  | driver.fcArgs.push_back(arg); | 
|  | if (arg == "-v") { | 
|  | driver.verbose = true; | 
|  | } else if (arg == "-I") { | 
|  | driver.fcArgs.push_back(args.front()); | 
|  | driver.searchDirectories.push_back(args.front()); | 
|  | args.pop_front(); | 
|  | } else if (arg.substr(0, 2) == "-I") { | 
|  | driver.searchDirectories.push_back(arg.substr(2)); | 
|  | } | 
|  | } | 
|  | } | 
|  |  | 
|  | if (driver.warnOnNonstandardUsage) { | 
|  | options.features.WarnOnAllNonstandard(); | 
|  | } | 
|  | if (!options.features.IsEnabled( | 
|  | Fortran::common::LanguageFeature::BackslashEscapes)) { | 
|  | driver.fcArgs.push_back("-fno-backslash"); // PGI "-Mbackslash" | 
|  | } | 
|  |  | 
|  | if (!anyFiles) { | 
|  | driver.dumpUnparse = true; | 
|  | CompileFortran("-", options, driver); | 
|  | return exitStatus; | 
|  | } | 
|  | for (const auto &path : fortranSources) { | 
|  | std::string relo{CompileFortran(path, options, driver)}; | 
|  | if (!driver.compileOnly && !relo.empty()) { | 
|  | relocatables.push_back(relo); | 
|  | } | 
|  | } | 
|  | for (const auto &path : otherSources) { | 
|  | std::string relo{CompileOtherLanguage(path, driver)}; | 
|  | if (!driver.compileOnly && !relo.empty()) { | 
|  | relocatables.push_back(relo); | 
|  | } | 
|  | } | 
|  | if (!relocatables.empty()) { | 
|  | Link(relocatables, driver); | 
|  | } | 
|  | return exitStatus; | 
|  | } |