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