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

source code of flang/tools/f18-parse-demo/f18-parse-demo.cpp