1 //===-- tools/f18/f18.cpp -------------------------------------------------===//
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
7 //===----------------------------------------------------------------------===//
9 // Temporary Fortran front end driver main program for development scaffolding.
11 #include "flang/Common/Fortran-features.h"
12 #include "flang/Common/default-kinds.h"
13 #include "flang/Evaluate/expression.h"
14 #include "flang/Lower/PFTBuilder.h"
15 #include "flang/Parser/characters.h"
16 #include "flang/Parser/dump-parse-tree.h"
17 #include "flang/Parser/message.h"
18 #include "flang/Parser/parse-tree-visitor.h"
19 #include "flang/Parser/parse-tree.h"
20 #include "flang/Parser/parsing.h"
21 #include "flang/Parser/provenance.h"
22 #include "flang/Parser/unparse.h"
23 #include "flang/Semantics/expression.h"
24 #include "flang/Semantics/semantics.h"
25 #include "flang/Semantics/unparse-with-symbols.h"
26 #include "llvm/Support/raw_ostream.h"
41 static std::list<std::string> argList(int argc, char *const argv[]) {
42 std::list<std::string> result;
43 for (int j = 0; j < argc; ++j) {
44 result.emplace_back(argv[j]);
49 struct MeasurementVisitor {
50 template<typename A> bool Pre(const A &) { return true; }
51 template<typename A> void Post(const A &) {
55 size_t objects{0}, bytes{0};
58 void MeasureParseTree(const Fortran::parser::Program &program) {
59 MeasurementVisitor visitor;
60 Fortran::parser::Walk(program, visitor);
61 std::cout << "Parse tree comprises " << visitor.objects
62 << " objects and occupies " << visitor.bytes << " total bytes.\n";
65 std::vector<std::string> filesToDelete;
67 void CleanUpAtExit() {
68 for (const auto &path : filesToDelete) {
75 struct GetDefinitionArgs {
76 int line, startColumn, endColumn;
79 struct DriverOptions {
81 bool verbose{false}; // -v
82 bool compileOnly{false}; // -c
83 std::string outputPath; // -o path
84 std::vector<std::string> searchDirectories{"."s}; // -I dir
85 std::string moduleDirectory{"."s}; // -module dir
86 std::string moduleFileSuffix{".mod"}; // -moduleSuffix suff
87 bool forcedForm{false}; // -Mfixed or -Mfree appeared
88 bool warnOnNonstandardUsage{false}; // -Mstandard
89 bool warningsAreErrors{false}; // -Werror
90 Fortran::parser::Encoding encoding{Fortran::parser::Encoding::UTF_8};
91 bool parseOnly{false};
92 bool dumpProvenance{false};
93 bool dumpCookedChars{false};
94 bool dumpUnparse{false};
95 bool dumpUnparseWithSymbols{false};
96 bool dumpParseTree{false};
97 bool dumpPreFirTree{false};
98 bool dumpSymbols{false};
99 bool debugResolveNames{false};
100 bool debugNoSemantics{false};
101 bool debugModuleWriter{false};
102 bool measureTree{false};
103 bool unparseTypedExprsToPGF90{false};
104 std::vector<std::string> pgf90Args;
105 const char *prefix{nullptr};
106 bool getDefinition{false};
107 GetDefinitionArgs getDefinitionArgs{0, 0, 0};
108 bool getSymbolsSources{false};
111 bool ParentProcess() {
113 return false; // in child process
117 if (!WIFEXITED(childStat) || WEXITSTATUS(childStat) != 0) {
123 void Exec(std::vector<char *> &argv, bool verbose = false) {
125 for (size_t j{0}; j < argv.size(); ++j) {
126 std::cerr << (j > 0 ? " " : "") << argv[j];
130 argv.push_back(nullptr);
131 execvp(argv[0], &argv[0]);
132 std::cerr << "execvp(" << argv[0] << ") failed: " << std::strerror(errno)
137 void RunOtherCompiler(DriverOptions &driver, char *source, char *relo) {
138 std::vector<char *> argv;
139 for (size_t j{0}; j < driver.pgf90Args.size(); ++j) {
140 argv.push_back(driver.pgf90Args[j].data());
142 char dashC[3] = "-c", dashO[3] = "-o";
143 argv.push_back(dashC);
144 argv.push_back(dashO);
145 argv.push_back(relo);
146 argv.push_back(source);
147 Exec(argv, driver.verbose);
150 std::string RelocatableName(const DriverOptions &driver, std::string path) {
151 if (driver.compileOnly && !driver.outputPath.empty()) {
152 return driver.outputPath;
154 std::string base{path};
155 auto slash{base.rfind("/")};
156 if (slash != std::string::npos) {
157 base = base.substr(slash + 1);
159 std::string relo{base};
160 auto dot{base.rfind(".")};
161 if (dot != std::string::npos) {
162 relo = base.substr(0, dot);
168 int exitStatus{EXIT_SUCCESS};
170 static Fortran::parser::AnalyzedObjectsAsFortran asFortran{
171 [](std::ostream &o, const Fortran::evaluate::GenericExprWrapper &x) {
175 o << "(bad expression)";
178 [](std::ostream &o, const Fortran::evaluate::GenericAssignmentWrapper &x) {
182 o << "(bad assignment)";
185 [](std::ostream &o, const Fortran::evaluate::ProcedureRef &x) {
186 x.AsFortran(o << "CALL ");
190 std::string CompileFortran(std::string path, Fortran::parser::Options options,
191 DriverOptions &driver,
192 const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds) {
193 Fortran::parser::AllSources allSources;
194 allSources.set_encoding(driver.encoding);
195 Fortran::semantics::SemanticsContext semanticsContext{
196 defaultKinds, options.features, allSources};
197 semanticsContext.set_moduleDirectory(driver.moduleDirectory)
198 .set_moduleFileSuffix(driver.moduleFileSuffix)
199 .set_searchDirectories(driver.searchDirectories)
200 .set_warnOnNonstandardUsage(driver.warnOnNonstandardUsage)
201 .set_warningsAreErrors(driver.warningsAreErrors);
202 if (!driver.forcedForm) {
203 auto dot{path.rfind(".")};
204 if (dot != std::string::npos) {
205 std::string suffix{path.substr(dot + 1)};
206 options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff";
209 options.searchDirectories = driver.searchDirectories;
210 Fortran::parser::Parsing parsing{semanticsContext.allSources()};
211 parsing.Prescan(path, options);
212 if (!parsing.messages().empty() &&
213 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) {
214 std::cerr << driver.prefix << "could not scan " << path << '\n';
215 parsing.messages().Emit(std::cerr, parsing.cooked());
216 exitStatus = EXIT_FAILURE;
219 if (driver.dumpProvenance) {
220 parsing.DumpProvenance(std::cout);
223 if (driver.dumpCookedChars) {
224 parsing.messages().Emit(std::cerr, parsing.cooked());
225 parsing.DumpCookedChars(std::cout);
228 parsing.Parse(&std::cout);
229 if (options.instrumentedParse) {
230 parsing.DumpParsingLog(std::cout);
234 parsing.messages().Emit(std::cerr, parsing.cooked());
235 if (!parsing.consumedWholeFile()) {
237 std::cerr, parsing.finalRestingPlace(), "parser FAIL (final position)");
238 exitStatus = EXIT_FAILURE;
241 if ((!parsing.messages().empty() &&
242 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) ||
243 !parsing.parseTree()) {
244 std::cerr << driver.prefix << "could not parse " << path << '\n';
245 exitStatus = EXIT_FAILURE;
248 auto &parseTree{*parsing.parseTree()};
249 if (driver.measureTree) {
250 MeasureParseTree(parseTree);
252 if (!driver.debugNoSemantics || driver.debugResolveNames ||
253 driver.dumpSymbols || driver.dumpUnparseWithSymbols ||
254 driver.getDefinition || driver.getSymbolsSources) {
255 Fortran::semantics::Semantics semantics{semanticsContext, parseTree,
256 parsing.cooked(), driver.debugModuleWriter};
258 semantics.EmitMessages(std::cerr);
259 if (driver.dumpSymbols) {
260 semantics.DumpSymbols(std::cout);
262 if (semantics.AnyFatalError()) {
263 std::cerr << driver.prefix << "semantic errors in " << path << '\n';
264 exitStatus = EXIT_FAILURE;
265 if (driver.dumpParseTree) {
266 Fortran::parser::DumpTree(std::cout, parseTree, &asFortran);
270 if (driver.dumpUnparseWithSymbols) {
271 Fortran::semantics::UnparseWithSymbols(
272 std::cout, parseTree, driver.encoding);
275 if (driver.getSymbolsSources) {
276 semantics.DumpSymbolsSources(std::cout);
279 if (driver.getDefinition) {
280 if (auto cb{parsing.cooked().GetCharBlockFromLineAndColumns(
281 driver.getDefinitionArgs.line,
282 driver.getDefinitionArgs.startColumn,
283 driver.getDefinitionArgs.endColumn)}) {
284 std::cerr << "String range: >" << cb->ToString() << "<\n";
285 if (auto symbol{semanticsContext.FindScope(*cb).FindSymbol(*cb)}) {
286 std::cerr << "Found symbol name: " << symbol->name().ToString()
289 parsing.cooked().GetSourcePositionRange(symbol->name())}) {
290 std::cout << symbol->name().ToString() << ": "
291 << sourceInfo->first.file.path() << ", "
292 << sourceInfo->first.line << ", "
293 << sourceInfo->first.column << "-"
294 << sourceInfo->second.column << "\n";
295 exitStatus = EXIT_SUCCESS;
300 std::cerr << "Symbol not found.\n";
301 exitStatus = EXIT_FAILURE;
305 if (driver.dumpParseTree) {
306 Fortran::parser::DumpTree(std::cout, parseTree, &asFortran);
308 if (driver.dumpUnparse) {
309 Unparse(std::cout, parseTree, driver.encoding, true /*capitalize*/,
310 options.features.IsEnabled(
311 Fortran::common::LanguageFeature::BackslashEscapes),
312 nullptr /* action before each statement */, &asFortran);
315 if (driver.dumpPreFirTree) {
316 if (auto ast{Fortran::lower::createPFT(parseTree)}) {
317 Fortran::lower::annotateControl(*ast);
318 Fortran::lower::dumpPFT(llvm::outs(), *ast);
320 std::cerr << "Pre FIR Tree is NULL.\n";
321 exitStatus = EXIT_FAILURE;
324 if (driver.parseOnly) {
328 std::string relo{RelocatableName(driver, path)};
330 char tmpSourcePath[32];
331 std::snprintf(tmpSourcePath, sizeof tmpSourcePath, "/tmp/f18-%lx.f90",
332 static_cast<unsigned long>(getpid()));
334 std::ofstream tmpSource;
335 tmpSource.open(tmpSourcePath);
336 Fortran::evaluate::formatForPGF90 = true;
337 Unparse(tmpSource, parseTree, driver.encoding, true /*capitalize*/,
338 options.features.IsEnabled(
339 Fortran::common::LanguageFeature::BackslashEscapes),
340 nullptr /* action before each statement */,
341 driver.unparseTypedExprsToPGF90 ? &asFortran : nullptr);
342 Fortran::evaluate::formatForPGF90 = false;
345 if (ParentProcess()) {
346 filesToDelete.push_back(tmpSourcePath);
347 if (!driver.compileOnly && driver.outputPath.empty()) {
348 filesToDelete.push_back(relo);
352 RunOtherCompiler(driver, tmpSourcePath, relo.data());
356 std::string CompileOtherLanguage(std::string path, DriverOptions &driver) {
357 std::string relo{RelocatableName(driver, path)};
358 if (ParentProcess()) {
359 if (!driver.compileOnly && driver.outputPath.empty()) {
360 filesToDelete.push_back(relo);
364 RunOtherCompiler(driver, path.data(), relo.data());
368 void Link(std::vector<std::string> &relocatables, DriverOptions &driver) {
369 if (!ParentProcess()) {
370 std::vector<char *> argv;
371 for (size_t j{0}; j < driver.pgf90Args.size(); ++j) {
372 argv.push_back(driver.pgf90Args[j].data());
374 for (auto &relo : relocatables) {
375 argv.push_back(relo.data());
377 if (!driver.outputPath.empty()) {
378 char dashO[3] = "-o";
379 argv.push_back(dashO);
380 argv.push_back(driver.outputPath.data());
382 Exec(argv, driver.verbose);
386 int main(int argc, char *const argv[]) {
388 atexit(CleanUpAtExit);
390 DriverOptions driver;
391 const char *pgf90{getenv("F18_FC")};
392 driver.pgf90Args.push_back(pgf90 ? pgf90 : "pgf90");
393 bool isPGF90{driver.pgf90Args.back().rfind("pgf90") != std::string::npos};
395 std::list<std::string> args{argList(argc, argv)};
396 std::string prefix{args.front()};
399 driver.prefix = prefix.data();
401 Fortran::parser::Options options;
402 options.predefinitions.emplace_back("__F18", "1");
403 options.predefinitions.emplace_back("__F18_MAJOR__", "1");
404 options.predefinitions.emplace_back("__F18_MINOR__", "1");
405 options.predefinitions.emplace_back("__F18_PATCHLEVEL__", "1");
407 options.predefinitions.emplace_back("__x86_64__", "1");
410 Fortran::common::IntrinsicTypeDefaultKinds defaultKinds;
412 std::vector<std::string> fortranSources, otherSources, relocatables;
413 bool anyFiles{false};
415 while (!args.empty()) {
416 std::string arg{std::move(args.front())};
419 } else if (arg.at(0) != '-') {
421 auto dot{arg.rfind(".")};
422 if (dot == std::string::npos) {
423 driver.pgf90Args.push_back(arg);
425 std::string suffix{arg.substr(dot + 1)};
426 if (suffix == "f" || suffix == "F" || suffix == "ff" ||
427 suffix == "f90" || suffix == "F90" || suffix == "ff90" ||
428 suffix == "f95" || suffix == "F95" || suffix == "ff95" ||
429 suffix == "cuf" || suffix == "CUF" || suffix == "f18" ||
430 suffix == "F18" || suffix == "ff18") {
431 fortranSources.push_back(arg);
432 } else if (suffix == "o" || suffix == "a") {
433 relocatables.push_back(arg);
435 otherSources.push_back(arg);
438 } else if (arg == "-") {
439 fortranSources.push_back("-");
440 } else if (arg == "--") {
441 while (!args.empty()) {
442 fortranSources.emplace_back(std::move(args.front()));
446 } else if (arg == "-Mfixed") {
447 driver.forcedForm = true;
448 options.isFixedForm = true;
449 } else if (arg == "-Mfree") {
450 driver.forcedForm = true;
451 options.isFixedForm = false;
452 } else if (arg == "-Mextend") {
453 options.fixedFormColumns = 132;
454 } else if (arg == "-Munlimited") {
455 // For reparsing f18's -E output of fixed-form cooked character stream
456 options.fixedFormColumns = 1000000;
457 } else if (arg == "-Mbackslash") {
458 options.features.Enable(
459 Fortran::common::LanguageFeature::BackslashEscapes, false);
460 } else if (arg == "-Mnobackslash") {
461 options.features.Enable(
462 Fortran::common::LanguageFeature::BackslashEscapes, true);
463 } else if (arg == "-Mstandard") {
464 driver.warnOnNonstandardUsage = true;
465 } else if (arg == "-fopenmp") {
466 options.features.Enable(Fortran::common::LanguageFeature::OpenMP);
467 options.predefinitions.emplace_back("_OPENMP", "201511");
468 } else if (arg == "-Werror") {
469 driver.warningsAreErrors = true;
470 } else if (arg == "-ed") {
471 options.features.Enable(Fortran::common::LanguageFeature::OldDebugLines);
472 } else if (arg == "-E") {
473 driver.dumpCookedChars = true;
474 } else if (arg == "-fbackslash" || arg == "-fno-backslash") {
475 options.features.Enable(
476 Fortran::common::LanguageFeature::BackslashEscapes,
477 arg == "-fbackslash");
478 } else if (arg == "-fxor-operator" || arg == "-fno-xor-operator") {
479 options.features.Enable(Fortran::common::LanguageFeature::XOROperator,
480 arg == "-fxor-operator");
481 } else if (arg == "-flogical-abbreviations" ||
482 arg == "-fno-logical-abbreviations") {
483 options.features.Enable(
484 Fortran::parser::LanguageFeature::LogicalAbbreviations,
485 arg == "-flogical-abbreviations");
486 } else if (arg == "-fdebug-dump-provenance") {
487 driver.dumpProvenance = true;
488 options.needProvenanceRangeToCharBlockMappings = true;
489 } else if (arg == "-fdebug-dump-parse-tree") {
490 driver.dumpParseTree = true;
491 } else if (arg == "-fdebug-pre-fir-tree") {
492 driver.dumpPreFirTree = true;
493 } else if (arg == "-fdebug-dump-symbols") {
494 driver.dumpSymbols = true;
495 } else if (arg == "-fdebug-resolve-names") {
496 driver.debugResolveNames = true;
497 } else if (arg == "-fdebug-module-writer") {
498 driver.debugModuleWriter = true;
499 } else if (arg == "-fdebug-measure-parse-tree") {
500 driver.measureTree = true;
501 } else if (arg == "-fdebug-instrumented-parse") {
502 options.instrumentedParse = true;
503 } else if (arg == "-fdebug-semantics") {
504 } else if (arg == "-fdebug-no-semantics") {
505 driver.debugNoSemantics = true;
506 } else if (arg == "-funparse") {
507 driver.dumpUnparse = true;
508 } else if (arg == "-funparse-with-symbols") {
509 driver.dumpUnparseWithSymbols = true;
510 } else if (arg == "-funparse-typed-exprs-to-pgf90") {
511 driver.unparseTypedExprsToPGF90 = true;
512 } else if (arg == "-fparse-only") {
513 driver.parseOnly = true;
514 } else if (arg == "-c") {
515 driver.compileOnly = true;
516 } else if (arg == "-o") {
517 driver.outputPath = args.front();
519 } else if (arg.substr(0, 2) == "-D") {
520 auto eq{arg.find('=')};
521 if (eq == std::string::npos) {
522 options.predefinitions.emplace_back(arg.substr(2), "1");
524 options.predefinitions.emplace_back(
525 arg.substr(2, eq - 2), arg.substr(eq + 1));
527 } else if (arg.substr(0, 2) == "-U") {
528 options.predefinitions.emplace_back(
529 arg.substr(2), std::optional<std::string>{});
530 } else if (arg == "-r8" || arg == "-fdefault-real-8") {
531 defaultKinds.set_defaultRealKind(8);
532 } else if (arg == "-i8" || arg == "-fdefault-integer-8") {
533 defaultKinds.set_defaultIntegerKind(8);
534 defaultKinds.set_subscriptIntegerKind(8);
535 defaultKinds.set_sizeIntegerKind(8);
536 } else if (arg == "-Mlargearray") {
537 } else if (arg == "-Mnolargearray") {
538 } else if (arg == "-flarge-sizes") {
539 defaultKinds.set_sizeIntegerKind(8);
540 } else if (arg == "-fno-large-sizes") {
541 defaultKinds.set_sizeIntegerKind(4);
542 } else if (arg == "-module") {
543 driver.moduleDirectory = args.front();
545 } else if (arg == "-module-suffix") {
546 driver.moduleFileSuffix = args.front();
548 } else if (arg == "-intrinsic-module-directory") {
549 driver.searchDirectories.push_back(args.front());
551 } else if (arg == "-futf-8") {
552 driver.encoding = Fortran::parser::Encoding::UTF_8;
553 } else if (arg == "-flatin") {
554 driver.encoding = Fortran::parser::Encoding::LATIN_1;
555 } else if (arg == "-fget-definition") {
556 // Receives 3 arguments: line, startColumn, endColumn.
557 options.needProvenanceRangeToCharBlockMappings = true;
558 driver.getDefinition = true;
561 for (int i = 0; i < 3; i++) {
563 std::cerr << "Must provide 3 arguments for -fget-definitions.\n";
566 arguments[i] = std::strtol(args.front().c_str(), &endptr, 10);
567 if (*endptr != '\0') {
568 std::cerr << "Invalid argument to -fget-definitions: " << args.front()
574 driver.getDefinitionArgs = {arguments[0], arguments[1], arguments[2]};
575 } else if (arg == "-fget-symbols-sources") {
576 driver.getSymbolsSources = true;
577 } else if (arg == "-help" || arg == "--help" || arg == "-?") {
580 << " -Mfixed | -Mfree force the source form\n"
581 << " -Mextend 132-column fixed form\n"
582 << " -f[no-]backslash enable[disable] \\escapes in literals\n"
583 << " -M[no]backslash disable[enable] \\escapes in literals\n"
584 << " -Mstandard enable conformance warnings\n"
585 << " -fenable=<feature> enable a language feature\n"
586 << " -fdisable=<feature> disable a language feature\n"
587 << " -r8 | -fdefault-real-8 | -i8 | -fdefault-integer-8 "
588 "change default kinds of intrinsic types\n"
589 << " -Werror treat warnings as errors\n"
590 << " -ed enable fixed form D lines\n"
591 << " -E prescan & preprocess only\n"
592 << " -module dir module output directory (default .)\n"
593 << " -flatin interpret source as Latin-1 (ISO 8859-1) "
594 "rather than UTF-8\n"
595 << " -fparse-only parse only, no output except messages\n"
596 << " -funparse parse & reformat only, no code "
598 << " -funparse-with-symbols parse, resolve symbols, and unparse\n"
599 << " -fdebug-measure-parse-tree\n"
600 << " -fdebug-dump-provenance\n"
601 << " -fdebug-dump-parse-tree\n"
602 << " -fdebug-dump-symbols\n"
603 << " -fdebug-resolve-names\n"
604 << " -fdebug-instrumented-parse\n"
605 << " -fdebug-no-semantics disable semantic checks\n"
606 << " -fget-definition\n"
607 << " -fget-symbols-sources\n"
608 << " -v -c -o -I -D -U have their usual meanings\n"
609 << " -help print this again\n"
610 << "Other options are passed through to the compiler.\n";
612 } else if (arg == "-V") {
613 std::cerr << "\nf18 compiler (under development)\n";
616 driver.pgf90Args.push_back(arg);
618 driver.verbose = true;
619 } else if (arg == "-I") {
620 driver.pgf90Args.push_back(args.front());
621 driver.searchDirectories.push_back(args.front());
623 } else if (arg.substr(0, 2) == "-I") {
624 driver.searchDirectories.push_back(arg.substr(2));
629 if (driver.warnOnNonstandardUsage) {
630 options.features.WarnOnAllNonstandard();
632 if (options.features.IsEnabled(Fortran::common::LanguageFeature::OpenMP)) {
633 driver.pgf90Args.push_back("-mp");
636 if (!options.features.IsEnabled(
637 Fortran::common::LanguageFeature::BackslashEscapes)) {
638 driver.pgf90Args.push_back(
639 "-Mbackslash"); // yes, this *disables* them in pgf90
641 Fortran::parser::useHexadecimalEscapeSequences = false;
643 if (options.features.IsEnabled(
644 Fortran::common::LanguageFeature::BackslashEscapes)) {
645 driver.pgf90Args.push_back("-fbackslash");
647 Fortran::parser::useHexadecimalEscapeSequences = true;
651 driver.measureTree = true;
652 driver.dumpUnparse = true;
653 CompileFortran("-", options, driver, defaultKinds);
656 for (const auto &path : fortranSources) {
657 std::string relo{CompileFortran(path, options, driver, defaultKinds)};
658 if (!driver.compileOnly && !relo.empty()) {
659 relocatables.push_back(relo);
662 for (const auto &path : otherSources) {
663 std::string relo{CompileOtherLanguage(path, driver)};
664 if (!driver.compileOnly && !relo.empty()) {
665 relocatables.push_back(relo);
668 if (!relocatables.empty()) {
669 Link(relocatables, driver);