xref: /llvm-project/flang/tools/f18-parse-demo/f18-parse-demo.cpp (revision 34eb0adaa9cd76f5bb0549f5a32d6ef452fe977e) 
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 warningsAreErrors{false}; // -Werror
89   Fortran::parser::Encoding encoding{Fortran::parser::Encoding::LATIN_1};
90   bool syntaxOnly{false};
91   bool dumpProvenance{false};
92   bool dumpCookedChars{false};
93   bool dumpUnparse{false};
94   bool dumpParseTree{false};
95   bool timeParse{false};
96   std::vector<std::string> fcArgs;
97   const char *prefix{nullptr};
98 };
99 
100 void Exec(std::vector<llvm::StringRef> &argv, bool verbose = false) {
101   if (verbose) {
102     for (size_t j{0}; j < argv.size(); ++j) {
103       llvm::errs() << (j > 0 ? " " : "") << argv[j];
104     }
105     llvm::errs() << '\n';
106   }
107   std::string ErrMsg;
108   llvm::ErrorOr<std::string> Program = llvm::sys::findProgramByName(argv[0]);
109   if (!Program)
110     ErrMsg = Program.getError().message();
111   if (!Program ||
112       llvm::sys::ExecuteAndWait(
113           Program.get(), argv, llvm::None, {}, 0, 0, &ErrMsg)) {
114     llvm::errs() << "execvp(" << argv[0] << ") failed: " << ErrMsg << '\n';
115     exit(EXIT_FAILURE);
116   }
117 }
118 
119 void RunOtherCompiler(DriverOptions &driver, char *source, char *relo) {
120   std::vector<llvm::StringRef> argv;
121   for (size_t j{0}; j < driver.fcArgs.size(); ++j) {
122     argv.push_back(driver.fcArgs[j]);
123   }
124   char dashC[3] = "-c", dashO[3] = "-o";
125   argv.push_back(dashC);
126   argv.push_back(dashO);
127   argv.push_back(relo);
128   argv.push_back(source);
129   Exec(argv, driver.verbose);
130 }
131 
132 std::string RelocatableName(const DriverOptions &driver, std::string path) {
133   if (driver.compileOnly && !driver.outputPath.empty()) {
134     return driver.outputPath;
135   }
136   std::string base{path};
137   auto slash{base.rfind("/")};
138   if (slash != std::string::npos) {
139     base = base.substr(slash + 1);
140   }
141   std::string relo{base};
142   auto dot{base.rfind(".")};
143   if (dot != std::string::npos) {
144     relo = base.substr(0, dot);
145   }
146   relo += ".o";
147   return relo;
148 }
149 
150 int exitStatus{EXIT_SUCCESS};
151 
152 std::string CompileFortran(
153     std::string path, Fortran::parser::Options options, DriverOptions &driver) {
154   if (!driver.forcedForm) {
155     auto dot{path.rfind(".")};
156     if (dot != std::string::npos) {
157       std::string suffix{path.substr(dot + 1)};
158       options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff";
159     }
160   }
161   options.searchDirectories = driver.searchDirectories;
162   Fortran::parser::AllSources allSources;
163   Fortran::parser::AllCookedSources allCookedSources{allSources};
164   Fortran::parser::Parsing parsing{allCookedSources};
165 
166   auto start{CPUseconds()};
167   parsing.Prescan(path, options);
168   if (!parsing.messages().empty() &&
169       (driver.warningsAreErrors || parsing.messages().AnyFatalError())) {
170     llvm::errs() << driver.prefix << "could not scan " << path << '\n';
171     parsing.messages().Emit(llvm::errs(), parsing.allCooked());
172     exitStatus = EXIT_FAILURE;
173     return {};
174   }
175   if (driver.dumpProvenance) {
176     parsing.DumpProvenance(llvm::outs());
177     return {};
178   }
179   if (driver.dumpCookedChars) {
180     parsing.DumpCookedChars(llvm::outs());
181     return {};
182   }
183   parsing.Parse(llvm::outs());
184   auto stop{CPUseconds()};
185   if (driver.timeParse) {
186     if (canTime) {
187       llvm::outs() << "parse time for " << path << ": " << (stop - start)
188                    << " CPU seconds\n";
189     } else {
190       llvm::outs() << "no timing information due to lack of clock_gettime()\n";
191     }
192   }
193 
194   parsing.ClearLog();
195   parsing.messages().Emit(llvm::errs(), parsing.allCooked());
196   if (!parsing.consumedWholeFile()) {
197     parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(),
198         "parser FAIL (final position)");
199     exitStatus = EXIT_FAILURE;
200     return {};
201   }
202   if ((!parsing.messages().empty() &&
203           (driver.warningsAreErrors || parsing.messages().AnyFatalError())) ||
204       !parsing.parseTree()) {
205     llvm::errs() << driver.prefix << "could not parse " << path << '\n';
206     exitStatus = EXIT_FAILURE;
207     return {};
208   }
209   auto &parseTree{*parsing.parseTree()};
210   if (driver.dumpParseTree) {
211     Fortran::parser::DumpTree(llvm::outs(), parseTree);
212     return {};
213   }
214   if (driver.dumpUnparse) {
215     Unparse(llvm::outs(), parseTree, driver.encoding, true /*capitalize*/,
216         options.features.IsEnabled(
217             Fortran::common::LanguageFeature::BackslashEscapes));
218     return {};
219   }
220   if (driver.syntaxOnly) {
221     return {};
222   }
223 
224   std::string relo{RelocatableName(driver, path)};
225 
226   llvm::SmallString<32> tmpSourcePath;
227   {
228     int fd;
229     std::error_code EC =
230         llvm::sys::fs::createUniqueFile("f18-%%%%.f90", fd, tmpSourcePath);
231     if (EC) {
232       llvm::errs() << EC.message() << "\n";
233       std::exit(EXIT_FAILURE);
234     }
235     llvm::raw_fd_ostream tmpSource(fd, /*shouldClose*/ true);
236     Unparse(tmpSource, parseTree, driver.encoding, true /*capitalize*/,
237         options.features.IsEnabled(
238             Fortran::common::LanguageFeature::BackslashEscapes));
239   }
240 
241   RunOtherCompiler(driver, tmpSourcePath.data(), relo.data());
242   filesToDelete.emplace_back(tmpSourcePath);
243   if (!driver.compileOnly && driver.outputPath.empty()) {
244     filesToDelete.push_back(relo);
245   }
246   return relo;
247 }
248 
249 std::string CompileOtherLanguage(std::string path, DriverOptions &driver) {
250   std::string relo{RelocatableName(driver, path)};
251   RunOtherCompiler(driver, path.data(), relo.data());
252   if (!driver.compileOnly && driver.outputPath.empty()) {
253     filesToDelete.push_back(relo);
254   }
255   return relo;
256 }
257 
258 void Link(std::vector<std::string> &relocatables, DriverOptions &driver) {
259   std::vector<llvm::StringRef> argv;
260   for (size_t j{0}; j < driver.fcArgs.size(); ++j) {
261     argv.push_back(driver.fcArgs[j].data());
262   }
263   for (auto &relo : relocatables) {
264     argv.push_back(relo.data());
265   }
266   if (!driver.outputPath.empty()) {
267     char dashO[3] = "-o";
268     argv.push_back(dashO);
269     argv.push_back(driver.outputPath.data());
270   }
271   Exec(argv, driver.verbose);
272 }
273 
274 int main(int argc, char *const argv[]) {
275 
276   atexit(CleanUpAtExit);
277 
278   DriverOptions driver;
279   const char *fc{getenv("F18_FC")};
280   driver.fcArgs.push_back(fc ? fc : "gfortran");
281 
282   std::list<std::string> args{argList(argc, argv)};
283   std::string prefix{args.front()};
284   args.pop_front();
285   prefix += ": ";
286   driver.prefix = prefix.data();
287 
288   Fortran::parser::Options options;
289   options.predefinitions.emplace_back("__F18", "1");
290   options.predefinitions.emplace_back("__F18_MAJOR__", "1");
291   options.predefinitions.emplace_back("__F18_MINOR__", "1");
292   options.predefinitions.emplace_back("__F18_PATCHLEVEL__", "1");
293 
294   options.features.Enable(
295       Fortran::common::LanguageFeature::BackslashEscapes, true);
296 
297   Fortran::common::IntrinsicTypeDefaultKinds defaultKinds;
298 
299   std::vector<std::string> fortranSources, otherSources, relocatables;
300   bool anyFiles{false};
301 
302   while (!args.empty()) {
303     std::string arg{std::move(args.front())};
304     args.pop_front();
305     if (arg.empty()) {
306     } else if (arg.at(0) != '-') {
307       anyFiles = true;
308       auto dot{arg.rfind(".")};
309       if (dot == std::string::npos) {
310         driver.fcArgs.push_back(arg);
311       } else {
312         std::string suffix{arg.substr(dot + 1)};
313         if (suffix == "f" || suffix == "F" || suffix == "ff" ||
314             suffix == "f90" || suffix == "F90" || suffix == "ff90" ||
315             suffix == "f95" || suffix == "F95" || suffix == "ff95" ||
316             suffix == "cuf" || suffix == "CUF" || suffix == "f18" ||
317             suffix == "F18" || suffix == "ff18") {
318           fortranSources.push_back(arg);
319         } else if (suffix == "o" || suffix == "a") {
320           relocatables.push_back(arg);
321         } else {
322           otherSources.push_back(arg);
323         }
324       }
325     } else if (arg == "-") {
326       fortranSources.push_back("-");
327     } else if (arg == "--") {
328       while (!args.empty()) {
329         fortranSources.emplace_back(std::move(args.front()));
330         args.pop_front();
331       }
332       break;
333     } else if (arg == "-Mfixed") {
334       driver.forcedForm = true;
335       options.isFixedForm = true;
336     } else if (arg == "-Mfree") {
337       driver.forcedForm = true;
338       options.isFixedForm = false;
339     } else if (arg == "-Mextend") {
340       options.fixedFormColumns = 132;
341     } else if (arg == "-Mbackslash") {
342       options.features.Enable(
343           Fortran::common::LanguageFeature::BackslashEscapes, false);
344     } else if (arg == "-Mnobackslash") {
345       options.features.Enable(
346           Fortran::common::LanguageFeature::BackslashEscapes);
347     } else if (arg == "-Mstandard") {
348       driver.warnOnNonstandardUsage = true;
349     } else if (arg == "-fopenmp") {
350       options.features.Enable(Fortran::common::LanguageFeature::OpenMP);
351       options.predefinitions.emplace_back("_OPENMP", "201511");
352     } else if (arg == "-Werror") {
353       driver.warningsAreErrors = true;
354     } else if (arg == "-ed") {
355       options.features.Enable(Fortran::common::LanguageFeature::OldDebugLines);
356     } else if (arg == "-E" || arg == "-fpreprocess-only") {
357       driver.dumpCookedChars = true;
358     } else if (arg == "-fbackslash") {
359       options.features.Enable(
360           Fortran::common::LanguageFeature::BackslashEscapes);
361     } else if (arg == "-fno-backslash") {
362       options.features.Enable(
363           Fortran::common::LanguageFeature::BackslashEscapes, false);
364     } else if (arg == "-fdump-provenance") {
365       driver.dumpProvenance = true;
366     } else if (arg == "-fdump-parse-tree") {
367       driver.dumpParseTree = true;
368     } else if (arg == "-funparse") {
369       driver.dumpUnparse = true;
370     } else if (arg == "-ftime-parse") {
371       driver.timeParse = true;
372     } else if (arg == "-fparse-only" || arg == "-fsyntax-only") {
373       driver.syntaxOnly = true;
374     } else if (arg == "-c") {
375       driver.compileOnly = true;
376     } else if (arg == "-o") {
377       driver.outputPath = args.front();
378       args.pop_front();
379     } else if (arg.substr(0, 2) == "-D") {
380       auto eq{arg.find('=')};
381       if (eq == std::string::npos) {
382         options.predefinitions.emplace_back(arg.substr(2), "1");
383       } else {
384         options.predefinitions.emplace_back(
385             arg.substr(2, eq - 2), arg.substr(eq + 1));
386       }
387     } else if (arg.substr(0, 2) == "-U") {
388       options.predefinitions.emplace_back(
389           arg.substr(2), std::optional<std::string>{});
390     } else if (arg == "-r8" || arg == "-fdefault-real-8") {
391       defaultKinds.set_defaultRealKind(8);
392     } else if (arg == "-i8" || arg == "-fdefault-integer-8") {
393       defaultKinds.set_defaultIntegerKind(8);
394     } else if (arg == "-help" || arg == "--help" || arg == "-?") {
395       llvm::errs()
396           << "f18-parse-demo options:\n"
397           << "  -Mfixed | -Mfree     force the source form\n"
398           << "  -Mextend             132-column fixed form\n"
399           << "  -f[no-]backslash     enable[disable] \\escapes in literals\n"
400           << "  -M[no]backslash      disable[enable] \\escapes in literals\n"
401           << "  -Mstandard           enable conformance warnings\n"
402           << "  -r8 | -fdefault-real-8 | -i8 | -fdefault-integer-8  "
403              "change default kinds of intrinsic types\n"
404           << "  -Werror              treat warnings as errors\n"
405           << "  -ed                  enable fixed form D lines\n"
406           << "  -E                   prescan & preprocess only\n"
407           << "  -ftime-parse         measure parsing time\n"
408           << "  -fsyntax-only        parse only, no output except messages\n"
409           << "  -funparse            parse & reformat only, no code "
410              "generation\n"
411           << "  -fdump-provenance    dump the provenance table (no code)\n"
412           << "  -fdump-parse-tree    dump the parse tree (no code)\n"
413           << "  -v -c -o -I -D -U    have their usual meanings\n"
414           << "  -help                print this again\n"
415           << "Other options are passed through to the $F18_FC compiler.\n";
416       return exitStatus;
417     } else if (arg == "-V") {
418       llvm::errs() << "\nf18-parse-demo\n";
419       return exitStatus;
420     } else {
421       driver.fcArgs.push_back(arg);
422       if (arg == "-v") {
423         driver.verbose = true;
424       } else if (arg == "-I") {
425         driver.fcArgs.push_back(args.front());
426         driver.searchDirectories.push_back(args.front());
427         args.pop_front();
428       } else if (arg.substr(0, 2) == "-I") {
429         driver.searchDirectories.push_back(arg.substr(2));
430       }
431     }
432   }
433 
434   if (driver.warnOnNonstandardUsage) {
435     options.features.WarnOnAllNonstandard();
436   }
437   if (!options.features.IsEnabled(
438           Fortran::common::LanguageFeature::BackslashEscapes)) {
439     driver.fcArgs.push_back("-fno-backslash"); // PGI "-Mbackslash"
440   }
441 
442   if (!anyFiles) {
443     driver.dumpUnparse = true;
444     CompileFortran("-", options, driver);
445     return exitStatus;
446   }
447   for (const auto &path : fortranSources) {
448     std::string relo{CompileFortran(path, options, driver)};
449     if (!driver.compileOnly && !relo.empty()) {
450       relocatables.push_back(relo);
451     }
452   }
453   for (const auto &path : otherSources) {
454     std::string relo{CompileOtherLanguage(path, driver)};
455     if (!driver.compileOnly && !relo.empty()) {
456       relocatables.push_back(relo);
457     }
458   }
459   if (!relocatables.empty()) {
460     Link(relocatables, driver);
461   }
462   return exitStatus;
463 }
464