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

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