//===-- 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 warnOnSuspiciousUsage{false}; // -pedantic
  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, std::nullopt, {}, 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)", "error: ", llvm::raw_ostream::RED);
    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 == "-pedantic") {
      driver.warnOnNonstandardUsage = true;
      driver.warnOnSuspiciousUsage = 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);
      defaultKinds.set_defaultLogicalKind(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 (driver.warnOnSuspiciousUsage) {
    options.features.WarnOnAllUsage();
  }
  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;
}