comparison flang/lib/Semantics/mod-file.cpp @ 173:0572611fdcc8 llvm10 llvm12

reorgnization done
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 11:55:54 +0900
parents
children 2e18cbf3894f
comparison
equal deleted inserted replaced
172:9fbae9c8bf63 173:0572611fdcc8
1 //===-- lib/Semantics/mod-file.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 #include "mod-file.h"
10 #include "resolve-names.h"
11 #include "flang/Evaluate/tools.h"
12 #include "flang/Parser/message.h"
13 #include "flang/Parser/parsing.h"
14 #include "flang/Semantics/scope.h"
15 #include "flang/Semantics/semantics.h"
16 #include "flang/Semantics/symbol.h"
17 #include "flang/Semantics/tools.h"
18 #include "llvm/Support/FileSystem.h"
19 #include "llvm/Support/MemoryBuffer.h"
20 #include "llvm/Support/raw_ostream.h"
21 #include <algorithm>
22 #include <fstream>
23 #include <set>
24 #include <string_view>
25 #include <vector>
26
27 namespace Fortran::semantics {
28
29 using namespace parser::literals;
30
31 // The first line of a file that identifies it as a .mod file.
32 // The first three bytes are a Unicode byte order mark that ensures
33 // that the module file is decoded as UTF-8 even if source files
34 // are using another encoding.
35 struct ModHeader {
36 static constexpr const char bom[3 + 1]{"\xef\xbb\xbf"};
37 static constexpr int magicLen{13};
38 static constexpr int sumLen{16};
39 static constexpr const char magic[magicLen + 1]{"!mod$ v1 sum:"};
40 static constexpr char terminator{'\n'};
41 static constexpr int len{magicLen + 1 + sumLen};
42 };
43
44 static std::optional<SourceName> GetSubmoduleParent(const parser::Program &);
45 static SymbolVector CollectSymbols(const Scope &);
46 static void PutEntity(llvm::raw_ostream &, const Symbol &);
47 static void PutObjectEntity(llvm::raw_ostream &, const Symbol &);
48 static void PutProcEntity(llvm::raw_ostream &, const Symbol &);
49 static void PutPassName(llvm::raw_ostream &, const std::optional<SourceName> &);
50 static void PutTypeParam(llvm::raw_ostream &, const Symbol &);
51 static void PutEntity(
52 llvm::raw_ostream &, const Symbol &, std::function<void()>, Attrs);
53 static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &);
54 static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &);
55 static void PutBound(llvm::raw_ostream &, const Bound &);
56 static llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs,
57 const MaybeExpr & = std::nullopt, std::string before = ","s,
58 std::string after = ""s);
59
60 static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);
61 static llvm::raw_ostream &PutType(llvm::raw_ostream &, const DeclTypeSpec &);
62 static llvm::raw_ostream &PutLower(llvm::raw_ostream &, const std::string &);
63 static std::error_code WriteFile(
64 const std::string &, const std::string &, bool = true);
65 static bool FileContentsMatch(
66 const std::string &, const std::string &, const std::string &);
67 static std::string CheckSum(const std::string_view &);
68
69 // Collect symbols needed for a subprogram interface
70 class SubprogramSymbolCollector {
71 public:
72 SubprogramSymbolCollector(const Symbol &symbol, const Scope &scope)
73 : symbol_{symbol}, scope_{scope} {}
74 const SymbolVector &symbols() const { return need_; }
75 const std::set<SourceName> &imports() const { return imports_; }
76 void Collect();
77
78 private:
79 const Symbol &symbol_;
80 const Scope &scope_;
81 bool isInterface_{false};
82 SymbolVector need_; // symbols that are needed
83 SymbolSet needSet_; // symbols already in need_
84 SymbolSet useSet_; // use-associations that might be needed
85 std::set<SourceName> imports_; // imports from host that are needed
86
87 void DoSymbol(const Symbol &);
88 void DoSymbol(const SourceName &, const Symbol &);
89 void DoType(const DeclTypeSpec *);
90 void DoBound(const Bound &);
91 void DoParamValue(const ParamValue &);
92 bool NeedImport(const SourceName &, const Symbol &);
93
94 template <typename T> void DoExpr(evaluate::Expr<T> expr) {
95 for (const Symbol &symbol : evaluate::CollectSymbols(expr)) {
96 DoSymbol(symbol);
97 }
98 }
99 };
100
101 bool ModFileWriter::WriteAll() {
102 WriteAll(context_.globalScope());
103 return !context_.AnyFatalError();
104 }
105
106 void ModFileWriter::WriteAll(const Scope &scope) {
107 for (const auto &child : scope.children()) {
108 WriteOne(child);
109 }
110 }
111
112 void ModFileWriter::WriteOne(const Scope &scope) {
113 if (scope.kind() == Scope::Kind::Module) {
114 auto *symbol{scope.symbol()};
115 if (!symbol->test(Symbol::Flag::ModFile)) {
116 Write(*symbol);
117 }
118 WriteAll(scope); // write out submodules
119 }
120 }
121
122 // Construct the name of a module file. Non-empty ancestorName means submodule.
123 static std::string ModFileName(const SourceName &name,
124 const std::string &ancestorName, const std::string &suffix) {
125 std::string result{name.ToString() + suffix};
126 return ancestorName.empty() ? result : ancestorName + '-' + result;
127 }
128
129 // Write the module file for symbol, which must be a module or submodule.
130 void ModFileWriter::Write(const Symbol &symbol) {
131 auto *ancestor{symbol.get<ModuleDetails>().ancestor()};
132 auto ancestorName{ancestor ? ancestor->GetName().value().ToString() : ""s};
133 auto path{context_.moduleDirectory() + '/' +
134 ModFileName(symbol.name(), ancestorName, context_.moduleFileSuffix())};
135 PutSymbols(DEREF(symbol.scope()));
136 if (std::error_code error{
137 WriteFile(path, GetAsString(symbol), context_.debugModuleWriter())}) {
138 context_.Say(
139 symbol.name(), "Error writing %s: %s"_err_en_US, path, error.message());
140 }
141 }
142
143 // Return the entire body of the module file
144 // and clear saved uses, decls, and contains.
145 std::string ModFileWriter::GetAsString(const Symbol &symbol) {
146 std::string buf;
147 llvm::raw_string_ostream all{buf};
148 auto &details{symbol.get<ModuleDetails>()};
149 if (!details.isSubmodule()) {
150 all << "module " << symbol.name();
151 } else {
152 auto *parent{details.parent()->symbol()};
153 auto *ancestor{details.ancestor()->symbol()};
154 all << "submodule(" << ancestor->name();
155 if (parent != ancestor) {
156 all << ':' << parent->name();
157 }
158 all << ") " << symbol.name();
159 }
160 all << '\n' << uses_.str();
161 uses_.str().clear();
162 all << useExtraAttrs_.str();
163 useExtraAttrs_.str().clear();
164 all << decls_.str();
165 decls_.str().clear();
166 auto str{contains_.str()};
167 contains_.str().clear();
168 if (!str.empty()) {
169 all << "contains\n" << str;
170 }
171 all << "end\n";
172 return all.str();
173 }
174
175 // Put out the visible symbols from scope.
176 void ModFileWriter::PutSymbols(const Scope &scope) {
177 std::string buf;
178 llvm::raw_string_ostream typeBindings{
179 buf}; // stuff after CONTAINS in derived type
180 for (const Symbol &symbol : CollectSymbols(scope)) {
181 PutSymbol(typeBindings, symbol);
182 }
183 if (auto str{typeBindings.str()}; !str.empty()) {
184 CHECK(scope.IsDerivedType());
185 decls_ << "contains\n" << str;
186 }
187 }
188
189 // Emit a symbol to decls_, except for bindings in a derived type (type-bound
190 // procedures, type-bound generics, final procedures) which go to typeBindings.
191 void ModFileWriter::PutSymbol(
192 llvm::raw_ostream &typeBindings, const Symbol &symbol) {
193 std::visit(common::visitors{
194 [&](const ModuleDetails &) { /* should be current module */ },
195 [&](const DerivedTypeDetails &) { PutDerivedType(symbol); },
196 [&](const SubprogramDetails &) { PutSubprogram(symbol); },
197 [&](const GenericDetails &x) {
198 if (symbol.owner().IsDerivedType()) {
199 // generic binding
200 for (const Symbol &proc : x.specificProcs()) {
201 typeBindings << "generic::" << symbol.name() << "=>"
202 << proc.name() << '\n';
203 }
204 } else {
205 PutGeneric(symbol);
206 if (x.specific()) {
207 PutSymbol(typeBindings, *x.specific());
208 }
209 if (x.derivedType()) {
210 PutSymbol(typeBindings, *x.derivedType());
211 }
212 }
213 },
214 [&](const UseDetails &) { PutUse(symbol); },
215 [](const UseErrorDetails &) {},
216 [&](const ProcBindingDetails &x) {
217 bool deferred{symbol.attrs().test(Attr::DEFERRED)};
218 typeBindings << "procedure";
219 if (deferred) {
220 typeBindings << '(' << x.symbol().name() << ')';
221 }
222 PutPassName(typeBindings, x.passName());
223 auto attrs{symbol.attrs()};
224 if (x.passName()) {
225 attrs.reset(Attr::PASS);
226 }
227 PutAttrs(typeBindings, attrs);
228 typeBindings << "::" << symbol.name();
229 if (!deferred && x.symbol().name() != symbol.name()) {
230 typeBindings << "=>" << x.symbol().name();
231 }
232 typeBindings << '\n';
233 },
234 [&](const NamelistDetails &x) {
235 decls_ << "namelist/" << symbol.name();
236 char sep{'/'};
237 for (const Symbol &object : x.objects()) {
238 decls_ << sep << object.name();
239 sep = ',';
240 }
241 decls_ << '\n';
242 },
243 [&](const CommonBlockDetails &x) {
244 decls_ << "common/" << symbol.name();
245 char sep = '/';
246 for (const auto &object : x.objects()) {
247 decls_ << sep << object->name();
248 sep = ',';
249 }
250 decls_ << '\n';
251 if (symbol.attrs().test(Attr::BIND_C)) {
252 PutAttrs(decls_, symbol.attrs(), x.bindName(), ""s);
253 decls_ << "::/" << symbol.name() << "/\n";
254 }
255 },
256 [&](const FinalProcDetails &) {
257 typeBindings << "final::" << symbol.name() << '\n';
258 },
259 [](const HostAssocDetails &) {},
260 [](const MiscDetails &) {},
261 [&](const auto &) { PutEntity(decls_, symbol); },
262 },
263 symbol.details());
264 }
265
266 void ModFileWriter::PutDerivedType(const Symbol &typeSymbol) {
267 auto &details{typeSymbol.get<DerivedTypeDetails>()};
268 PutAttrs(decls_ << "type", typeSymbol.attrs());
269 if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
270 decls_ << ",extends(" << extends->name() << ')';
271 }
272 decls_ << "::" << typeSymbol.name();
273 auto &typeScope{*typeSymbol.scope()};
274 if (!details.paramNames().empty()) {
275 char sep{'('};
276 for (const auto &name : details.paramNames()) {
277 decls_ << sep << name;
278 sep = ',';
279 }
280 decls_ << ')';
281 }
282 decls_ << '\n';
283 if (details.sequence()) {
284 decls_ << "sequence\n";
285 }
286 PutSymbols(typeScope);
287 decls_ << "end type\n";
288 }
289
290 // Attributes that may be in a subprogram prefix
291 static const Attrs subprogramPrefixAttrs{Attr::ELEMENTAL, Attr::IMPURE,
292 Attr::MODULE, Attr::NON_RECURSIVE, Attr::PURE, Attr::RECURSIVE};
293
294 void ModFileWriter::PutSubprogram(const Symbol &symbol) {
295 auto attrs{symbol.attrs()};
296 auto &details{symbol.get<SubprogramDetails>()};
297 Attrs bindAttrs{};
298 if (attrs.test(Attr::BIND_C)) {
299 // bind(c) is a suffix, not prefix
300 bindAttrs.set(Attr::BIND_C, true);
301 attrs.set(Attr::BIND_C, false);
302 }
303 Attrs prefixAttrs{subprogramPrefixAttrs & attrs};
304 // emit any non-prefix attributes in an attribute statement
305 attrs &= ~subprogramPrefixAttrs;
306 std::string ssBuf;
307 llvm::raw_string_ostream ss{ssBuf};
308 PutAttrs(ss, attrs);
309 if (!ss.str().empty()) {
310 decls_ << ss.str().substr(1) << "::" << symbol.name() << '\n';
311 }
312 bool isInterface{details.isInterface()};
313 llvm::raw_ostream &os{isInterface ? decls_ : contains_};
314 if (isInterface) {
315 os << "interface\n";
316 }
317 PutAttrs(os, prefixAttrs, std::nullopt, ""s, " "s);
318 os << (details.isFunction() ? "function " : "subroutine ");
319 os << symbol.name() << '(';
320 int n = 0;
321 for (const auto &dummy : details.dummyArgs()) {
322 if (n++ > 0) {
323 os << ',';
324 }
325 os << dummy->name();
326 }
327 os << ')';
328 PutAttrs(os, bindAttrs, details.bindName(), " "s, ""s);
329 if (details.isFunction()) {
330 const Symbol &result{details.result()};
331 if (result.name() != symbol.name()) {
332 os << " result(" << result.name() << ')';
333 }
334 }
335 os << '\n';
336
337 // walk symbols, collect ones needed for interface
338 const Scope &scope{
339 details.entryScope() ? *details.entryScope() : DEREF(symbol.scope())};
340 SubprogramSymbolCollector collector{symbol, scope};
341 collector.Collect();
342 std::string typeBindingsBuf;
343 llvm::raw_string_ostream typeBindings{typeBindingsBuf};
344 ModFileWriter writer{context_};
345 for (const Symbol &need : collector.symbols()) {
346 writer.PutSymbol(typeBindings, need);
347 }
348 CHECK(typeBindings.str().empty());
349 os << writer.uses_.str();
350 for (const SourceName &import : collector.imports()) {
351 decls_ << "import::" << import << "\n";
352 }
353 os << writer.decls_.str();
354 os << "end\n";
355 if (isInterface) {
356 os << "end interface\n";
357 }
358 }
359
360 static bool IsIntrinsicOp(const Symbol &symbol) {
361 if (const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()}) {
362 return details->kind().IsIntrinsicOperator();
363 } else {
364 return false;
365 }
366 }
367
368 static llvm::raw_ostream &PutGenericName(
369 llvm::raw_ostream &os, const Symbol &symbol) {
370 if (IsGenericDefinedOp(symbol)) {
371 return os << "operator(" << symbol.name() << ')';
372 } else {
373 return os << symbol.name();
374 }
375 }
376
377 void ModFileWriter::PutGeneric(const Symbol &symbol) {
378 auto &details{symbol.get<GenericDetails>()};
379 PutGenericName(decls_ << "interface ", symbol) << '\n';
380 for (const Symbol &specific : details.specificProcs()) {
381 decls_ << "procedure::" << specific.name() << '\n';
382 }
383 decls_ << "end interface\n";
384 if (symbol.attrs().test(Attr::PRIVATE)) {
385 PutGenericName(decls_ << "private::", symbol) << '\n';
386 }
387 }
388
389 void ModFileWriter::PutUse(const Symbol &symbol) {
390 auto &details{symbol.get<UseDetails>()};
391 auto &use{details.symbol()};
392 uses_ << "use " << details.module().name();
393 PutGenericName(uses_ << ",only:", symbol);
394 // Can have intrinsic op with different local-name and use-name
395 // (e.g. `operator(<)` and `operator(.lt.)`) but rename is not allowed
396 if (!IsIntrinsicOp(symbol) && use.name() != symbol.name()) {
397 PutGenericName(uses_ << "=>", use);
398 }
399 uses_ << '\n';
400 PutUseExtraAttr(Attr::VOLATILE, symbol, use);
401 PutUseExtraAttr(Attr::ASYNCHRONOUS, symbol, use);
402 }
403
404 // We have "USE local => use" in this module. If attr was added locally
405 // (i.e. on local but not on use), also write it out in the mod file.
406 void ModFileWriter::PutUseExtraAttr(
407 Attr attr, const Symbol &local, const Symbol &use) {
408 if (local.attrs().test(attr) && !use.attrs().test(attr)) {
409 PutAttr(useExtraAttrs_, attr) << "::";
410 useExtraAttrs_ << local.name() << '\n';
411 }
412 }
413
414 // Collect the symbols of this scope sorted by their original order, not name.
415 // Namelists are an exception: they are sorted after other symbols.
416 SymbolVector CollectSymbols(const Scope &scope) {
417 SymbolVector sorted;
418 SymbolVector namelist;
419 std::size_t commonSize{scope.commonBlocks().size()};
420 auto symbols{scope.GetSymbols()};
421 sorted.reserve(symbols.size() + commonSize);
422 for (SymbolRef symbol : symbols) {
423 if (!symbol->test(Symbol::Flag::ParentComp)) {
424 if (symbol->has<NamelistDetails>()) {
425 namelist.push_back(symbol);
426 } else {
427 sorted.push_back(symbol);
428 }
429 }
430 }
431 sorted.insert(sorted.end(), namelist.begin(), namelist.end());
432 for (const auto &pair : scope.commonBlocks()) {
433 sorted.push_back(*pair.second);
434 }
435 std::sort(sorted.end() - commonSize, sorted.end());
436 return sorted;
437 }
438
439 void PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {
440 std::visit(
441 common::visitors{
442 [&](const ObjectEntityDetails &) { PutObjectEntity(os, symbol); },
443 [&](const ProcEntityDetails &) { PutProcEntity(os, symbol); },
444 [&](const TypeParamDetails &) { PutTypeParam(os, symbol); },
445 [&](const auto &) {
446 common::die("PutEntity: unexpected details: %s",
447 DetailsToString(symbol.details()).c_str());
448 },
449 },
450 symbol.details());
451 }
452
453 void PutShapeSpec(llvm::raw_ostream &os, const ShapeSpec &x) {
454 if (x.lbound().isAssumed()) {
455 CHECK(x.ubound().isAssumed());
456 os << "..";
457 } else {
458 if (!x.lbound().isDeferred()) {
459 PutBound(os, x.lbound());
460 }
461 os << ':';
462 if (!x.ubound().isDeferred()) {
463 PutBound(os, x.ubound());
464 }
465 }
466 }
467 void PutShape(
468 llvm::raw_ostream &os, const ArraySpec &shape, char open, char close) {
469 if (!shape.empty()) {
470 os << open;
471 bool first{true};
472 for (const auto &shapeSpec : shape) {
473 if (first) {
474 first = false;
475 } else {
476 os << ',';
477 }
478 PutShapeSpec(os, shapeSpec);
479 }
480 os << close;
481 }
482 }
483
484 void PutObjectEntity(llvm::raw_ostream &os, const Symbol &symbol) {
485 auto &details{symbol.get<ObjectEntityDetails>()};
486 PutEntity(
487 os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); },
488 symbol.attrs());
489 PutShape(os, details.shape(), '(', ')');
490 PutShape(os, details.coshape(), '[', ']');
491 PutInit(os, symbol, details.init());
492 os << '\n';
493 }
494
495 void PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
496 if (symbol.attrs().test(Attr::INTRINSIC)) {
497 os << "intrinsic::" << symbol.name() << '\n';
498 return;
499 }
500 const auto &details{symbol.get<ProcEntityDetails>()};
501 const ProcInterface &interface{details.interface()};
502 Attrs attrs{symbol.attrs()};
503 if (details.passName()) {
504 attrs.reset(Attr::PASS);
505 }
506 PutEntity(
507 os, symbol,
508 [&]() {
509 os << "procedure(";
510 if (interface.symbol()) {
511 os << interface.symbol()->name();
512 } else if (interface.type()) {
513 PutType(os, *interface.type());
514 }
515 os << ')';
516 PutPassName(os, details.passName());
517 },
518 attrs);
519 os << '\n';
520 }
521
522 void PutPassName(
523 llvm::raw_ostream &os, const std::optional<SourceName> &passName) {
524 if (passName) {
525 os << ",pass(" << *passName << ')';
526 }
527 }
528 void PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
529 auto &details{symbol.get<TypeParamDetails>()};
530 PutEntity(
531 os, symbol,
532 [&]() {
533 PutType(os, DEREF(symbol.GetType()));
534 PutLower(os << ',', common::EnumToString(details.attr()));
535 },
536 symbol.attrs());
537 PutInit(os, details.init());
538 os << '\n';
539 }
540
541 void PutInit(
542 llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init) {
543 if (init) {
544 if (symbol.attrs().test(Attr::PARAMETER) ||
545 symbol.owner().IsDerivedType()) {
546 os << (symbol.attrs().test(Attr::POINTER) ? "=>" : "=");
547 init->AsFortran(os);
548 }
549 }
550 }
551
552 void PutInit(llvm::raw_ostream &os, const MaybeIntExpr &init) {
553 if (init) {
554 init->AsFortran(os << '=');
555 }
556 }
557
558 void PutBound(llvm::raw_ostream &os, const Bound &x) {
559 if (x.isAssumed()) {
560 os << '*';
561 } else if (x.isDeferred()) {
562 os << ':';
563 } else {
564 x.GetExplicit()->AsFortran(os);
565 }
566 }
567
568 // Write an entity (object or procedure) declaration.
569 // writeType is called to write out the type.
570 void PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
571 std::function<void()> writeType, Attrs attrs) {
572 writeType();
573 MaybeExpr bindName;
574 std::visit(common::visitors{
575 [&](const SubprogramDetails &x) { bindName = x.bindName(); },
576 [&](const ObjectEntityDetails &x) { bindName = x.bindName(); },
577 [&](const ProcEntityDetails &x) { bindName = x.bindName(); },
578 [&](const auto &) {},
579 },
580 symbol.details());
581 PutAttrs(os, attrs, bindName);
582 os << "::" << symbol.name();
583 }
584
585 // Put out each attribute to os, surrounded by `before` and `after` and
586 // mapped to lower case.
587 llvm::raw_ostream &PutAttrs(llvm::raw_ostream &os, Attrs attrs,
588 const MaybeExpr &bindName, std::string before, std::string after) {
589 attrs.set(Attr::PUBLIC, false); // no need to write PUBLIC
590 attrs.set(Attr::EXTERNAL, false); // no need to write EXTERNAL
591 if (bindName) {
592 bindName->AsFortran(os << before << "bind(c, name=") << ')' << after;
593 attrs.set(Attr::BIND_C, false);
594 }
595 for (std::size_t i{0}; i < Attr_enumSize; ++i) {
596 Attr attr{static_cast<Attr>(i)};
597 if (attrs.test(attr)) {
598 PutAttr(os << before, attr) << after;
599 }
600 }
601 return os;
602 }
603
604 llvm::raw_ostream &PutAttr(llvm::raw_ostream &os, Attr attr) {
605 return PutLower(os, AttrToString(attr));
606 }
607
608 llvm::raw_ostream &PutType(llvm::raw_ostream &os, const DeclTypeSpec &type) {
609 return PutLower(os, type.AsFortran());
610 }
611
612 llvm::raw_ostream &PutLower(llvm::raw_ostream &os, const std::string &str) {
613 for (char c : str) {
614 os << parser::ToLowerCaseLetter(c);
615 }
616 return os;
617 }
618
619 struct Temp {
620 Temp(int fd, std::string path) : fd{fd}, path{path} {}
621 Temp(Temp &&t) : fd{std::exchange(t.fd, -1)}, path{std::move(t.path)} {}
622 ~Temp() {
623 if (fd >= 0) {
624 llvm::sys::fs::file_t native{llvm::sys::fs::convertFDToNativeFile(fd)};
625 llvm::sys::fs::closeFile(native);
626 llvm::sys::fs::remove(path.c_str());
627 }
628 }
629 int fd;
630 std::string path;
631 };
632
633 // Create a temp file in the same directory and with the same suffix as path.
634 // Return an open file descriptor and its path.
635 static llvm::ErrorOr<Temp> MkTemp(const std::string &path) {
636 auto length{path.length()};
637 auto dot{path.find_last_of("./")};
638 std::string suffix{
639 dot < length && path[dot] == '.' ? path.substr(dot + 1) : ""};
640 CHECK(length > suffix.length() &&
641 path.substr(length - suffix.length()) == suffix);
642 auto prefix{path.substr(0, length - suffix.length())};
643 int fd;
644 llvm::SmallString<16> tempPath;
645 if (std::error_code err{llvm::sys::fs::createUniqueFile(
646 prefix + "%%%%%%" + suffix, fd, tempPath)}) {
647 return err;
648 }
649 return Temp{fd, tempPath.c_str()};
650 }
651
652 // Write the module file at path, prepending header. If an error occurs,
653 // return errno, otherwise 0.
654 static std::error_code WriteFile(
655 const std::string &path, const std::string &contents, bool debug) {
656 auto header{std::string{ModHeader::bom} + ModHeader::magic +
657 CheckSum(contents) + ModHeader::terminator};
658 if (debug) {
659 llvm::dbgs() << "Processing module " << path << ": ";
660 }
661 if (FileContentsMatch(path, header, contents)) {
662 if (debug) {
663 llvm::dbgs() << "module unchanged, not writing\n";
664 }
665 return {};
666 }
667 llvm::ErrorOr<Temp> temp{MkTemp(path)};
668 if (!temp) {
669 return temp.getError();
670 }
671 llvm::raw_fd_ostream writer(temp->fd, /*shouldClose=*/false);
672 writer << header;
673 writer << contents;
674 writer.flush();
675 if (writer.has_error()) {
676 return writer.error();
677 }
678 if (debug) {
679 llvm::dbgs() << "module written\n";
680 }
681 return llvm::sys::fs::rename(temp->path, path);
682 }
683
684 // Return true if the stream matches what we would write for the mod file.
685 static bool FileContentsMatch(const std::string &path,
686 const std::string &header, const std::string &contents) {
687 std::size_t hsize{header.size()};
688 std::size_t csize{contents.size()};
689 auto buf_or{llvm::MemoryBuffer::getFile(path)};
690 if (!buf_or) {
691 return false;
692 }
693 auto buf = std::move(buf_or.get());
694 if (buf->getBufferSize() != hsize + csize) {
695 return false;
696 }
697 if (!std::equal(header.begin(), header.end(), buf->getBufferStart(),
698 buf->getBufferStart() + hsize)) {
699 return false;
700 }
701
702 return std::equal(contents.begin(), contents.end(),
703 buf->getBufferStart() + hsize, buf->getBufferEnd());
704 }
705
706 // Compute a simple hash of the contents of a module file and
707 // return it as a string of hex digits.
708 // This uses the Fowler-Noll-Vo hash function.
709 static std::string CheckSum(const std::string_view &contents) {
710 std::uint64_t hash{0xcbf29ce484222325ull};
711 for (char c : contents) {
712 hash ^= c & 0xff;
713 hash *= 0x100000001b3;
714 }
715 static const char *digits = "0123456789abcdef";
716 std::string result(ModHeader::sumLen, '0');
717 for (size_t i{ModHeader::sumLen}; hash != 0; hash >>= 4) {
718 result[--i] = digits[hash & 0xf];
719 }
720 return result;
721 }
722
723 static bool VerifyHeader(llvm::ArrayRef<char> content) {
724 std::string_view sv{content.data(), content.size()};
725 if (sv.substr(0, ModHeader::magicLen) != ModHeader::magic) {
726 return false;
727 }
728 std::string_view expectSum{sv.substr(ModHeader::magicLen, ModHeader::sumLen)};
729 std::string actualSum{CheckSum(sv.substr(ModHeader::len))};
730 return expectSum == actualSum;
731 }
732
733 Scope *ModFileReader::Read(const SourceName &name, Scope *ancestor) {
734 std::string ancestorName; // empty for module
735 if (ancestor) {
736 if (auto *scope{ancestor->FindSubmodule(name)}) {
737 return scope;
738 }
739 ancestorName = ancestor->GetName().value().ToString();
740 } else {
741 auto it{context_.globalScope().find(name)};
742 if (it != context_.globalScope().end()) {
743 return it->second->scope();
744 }
745 }
746 parser::Parsing parsing{context_.allSources()};
747 parser::Options options;
748 options.isModuleFile = true;
749 options.features.Enable(common::LanguageFeature::BackslashEscapes);
750 options.searchDirectories = context_.searchDirectories();
751 auto path{ModFileName(name, ancestorName, context_.moduleFileSuffix())};
752 const auto *sourceFile{parsing.Prescan(path, options)};
753 if (parsing.messages().AnyFatalError()) {
754 for (auto &msg : parsing.messages().messages()) {
755 std::string str{msg.ToString()};
756 Say(name, ancestorName, parser::MessageFixedText{str.c_str(), str.size()},
757 path);
758 }
759 return nullptr;
760 }
761 CHECK(sourceFile);
762 if (!VerifyHeader(sourceFile->content())) {
763 Say(name, ancestorName, "File has invalid checksum: %s"_en_US,
764 sourceFile->path());
765 return nullptr;
766 }
767 llvm::raw_null_ostream NullStream;
768 parsing.Parse(NullStream);
769 auto &parseTree{parsing.parseTree()};
770 if (!parsing.messages().empty() || !parsing.consumedWholeFile() ||
771 !parseTree) {
772 Say(name, ancestorName, "Module file is corrupt: %s"_err_en_US,
773 sourceFile->path());
774 return nullptr;
775 }
776 Scope *parentScope; // the scope this module/submodule goes into
777 if (!ancestor) {
778 parentScope = &context_.globalScope();
779 } else if (std::optional<SourceName> parent{GetSubmoduleParent(*parseTree)}) {
780 parentScope = Read(*parent, ancestor);
781 } else {
782 parentScope = ancestor;
783 }
784 ResolveNames(context_, *parseTree);
785 const auto &it{parentScope->find(name)};
786 if (it == parentScope->end()) {
787 return nullptr;
788 }
789 auto &modSymbol{*it->second};
790 modSymbol.set(Symbol::Flag::ModFile);
791 modSymbol.scope()->set_chars(parsing.cooked());
792 return modSymbol.scope();
793 }
794
795 parser::Message &ModFileReader::Say(const SourceName &name,
796 const std::string &ancestor, parser::MessageFixedText &&msg,
797 const std::string &arg) {
798 return context_
799 .Say(name,
800 ancestor.empty()
801 ? "Error reading module file for module '%s'"_err_en_US
802 : "Error reading module file for submodule '%s' of module '%s'"_err_en_US,
803 name, ancestor)
804 .Attach(name, std::move(msg), arg);
805 }
806
807 // program was read from a .mod file for a submodule; return the name of the
808 // submodule's parent submodule, nullptr if none.
809 static std::optional<SourceName> GetSubmoduleParent(
810 const parser::Program &program) {
811 CHECK(program.v.size() == 1);
812 auto &unit{program.v.front()};
813 auto &submod{std::get<common::Indirection<parser::Submodule>>(unit.u)};
814 auto &stmt{
815 std::get<parser::Statement<parser::SubmoduleStmt>>(submod.value().t)};
816 auto &parentId{std::get<parser::ParentIdentifier>(stmt.statement.t)};
817 if (auto &parent{std::get<std::optional<parser::Name>>(parentId.t)}) {
818 return parent->source;
819 } else {
820 return std::nullopt;
821 }
822 }
823
824 void SubprogramSymbolCollector::Collect() {
825 const auto &details{symbol_.get<SubprogramDetails>()};
826 isInterface_ = details.isInterface();
827 for (const Symbol *dummyArg : details.dummyArgs()) {
828 DoSymbol(DEREF(dummyArg));
829 }
830 if (details.isFunction()) {
831 DoSymbol(details.result());
832 }
833 for (const auto &pair : scope_) {
834 const Symbol &symbol{*pair.second};
835 if (const auto *useDetails{symbol.detailsIf<UseDetails>()}) {
836 if (useSet_.count(useDetails->symbol().GetUltimate()) > 0) {
837 need_.push_back(symbol);
838 }
839 }
840 }
841 }
842
843 void SubprogramSymbolCollector::DoSymbol(const Symbol &symbol) {
844 DoSymbol(symbol.name(), symbol);
845 }
846
847 // Do symbols this one depends on; then add to need_
848 void SubprogramSymbolCollector::DoSymbol(
849 const SourceName &name, const Symbol &symbol) {
850 const auto &scope{symbol.owner()};
851 if (scope != scope_ && !scope.IsDerivedType()) {
852 if (scope != scope_.parent()) {
853 useSet_.insert(symbol);
854 }
855 if (NeedImport(name, symbol)) {
856 imports_.insert(name);
857 }
858 return;
859 }
860 if (!needSet_.insert(symbol).second) {
861 return; // already done
862 }
863 std::visit(common::visitors{
864 [this](const ObjectEntityDetails &details) {
865 for (const ShapeSpec &spec : details.shape()) {
866 DoBound(spec.lbound());
867 DoBound(spec.ubound());
868 }
869 for (const ShapeSpec &spec : details.coshape()) {
870 DoBound(spec.lbound());
871 DoBound(spec.ubound());
872 }
873 if (const Symbol * commonBlock{details.commonBlock()}) {
874 DoSymbol(*commonBlock);
875 }
876 },
877 [this](const CommonBlockDetails &details) {
878 for (const auto &object : details.objects()) {
879 DoSymbol(*object);
880 }
881 },
882 [](const auto &) {},
883 },
884 symbol.details());
885 if (!symbol.has<UseDetails>()) {
886 DoType(symbol.GetType());
887 }
888 if (!scope.IsDerivedType()) {
889 need_.push_back(symbol);
890 }
891 }
892
893 void SubprogramSymbolCollector::DoType(const DeclTypeSpec *type) {
894 if (!type) {
895 return;
896 }
897 switch (type->category()) {
898 case DeclTypeSpec::Numeric:
899 case DeclTypeSpec::Logical:
900 break; // nothing to do
901 case DeclTypeSpec::Character:
902 DoParamValue(type->characterTypeSpec().length());
903 break;
904 default:
905 if (const DerivedTypeSpec * derived{type->AsDerived()}) {
906 const auto &typeSymbol{derived->typeSymbol()};
907 if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
908 DoSymbol(extends->name(), extends->typeSymbol());
909 }
910 for (const auto &pair : derived->parameters()) {
911 DoParamValue(pair.second);
912 }
913 for (const auto &pair : *typeSymbol.scope()) {
914 const Symbol &comp{*pair.second};
915 DoSymbol(comp);
916 }
917 DoSymbol(derived->name(), derived->typeSymbol());
918 }
919 }
920 }
921
922 void SubprogramSymbolCollector::DoBound(const Bound &bound) {
923 if (const MaybeSubscriptIntExpr & expr{bound.GetExplicit()}) {
924 DoExpr(*expr);
925 }
926 }
927 void SubprogramSymbolCollector::DoParamValue(const ParamValue &paramValue) {
928 if (const auto &expr{paramValue.GetExplicit()}) {
929 DoExpr(*expr);
930 }
931 }
932
933 // Do we need a IMPORT of this symbol into an interface block?
934 bool SubprogramSymbolCollector::NeedImport(
935 const SourceName &name, const Symbol &symbol) {
936 if (!isInterface_) {
937 return false;
938 } else if (symbol.owner() != scope_.parent()) {
939 // detect import from parent of use-associated symbol
940 // can be null in the case of a use-associated derived type's parent type
941 const auto *found{scope_.FindSymbol(name)};
942 CHECK(found || symbol.has<DerivedTypeDetails>());
943 return found && found->has<UseDetails>() && found->owner() != scope_;
944 } else {
945 return true;
946 }
947 }
948
949 } // namespace Fortran::semantics