Mercurial > hg > CbC > CbC_llvm
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 ¶mValue) { | |
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 |