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/Common/restorer.h"
12	#include "flang/Evaluate/tools.h"
13	#include "flang/Parser/message.h"
14	#include "flang/Parser/parsing.h"
15	#include "flang/Parser/unparse.h"
16	#include "flang/Semantics/scope.h"
17	#include "flang/Semantics/semantics.h"
18	#include "flang/Semantics/symbol.h"
19	#include "flang/Semantics/tools.h"
20	#include "llvm/Support/FileSystem.h"
21	#include "llvm/Support/MemoryBuffer.h"
22	#include "llvm/Support/raw_ostream.h"
23	#include <algorithm>
24	#include <fstream>
25	#include <set>
26	#include <string_view>
27	#include <variant>
28	#include <vector>
29
30	namespace Fortran::semantics {
31
32	using namespace parser::literals;
33
34	// The first line of a file that identifies it as a .mod file.
35	// The first three bytes are a Unicode byte order mark that ensures
36	// that the module file is decoded as UTF-8 even if source files
37	// are using another encoding.
38	struct ModHeader {
39	static constexpr const char bom[3 + 1]{"\xef\xbb\xbf"};
40	static constexpr int magicLen{13};
41	static constexpr int sumLen{16};
42	static constexpr const char magic[magicLen + 1]{"!mod$ v1 sum:"};
43	static constexpr char terminator{'\n'};
44	static constexpr int len{magicLen + 1 + sumLen};
45	static constexpr int needLen{7};
46	static constexpr const char need[needLen + 1]{"!need$ "};
47	};
48
49	static std::optional<SourceName> GetSubmoduleParent(const parser::Program &);
50	static void CollectSymbols(
51	const Scope &, SymbolVector &, SymbolVector &, SourceOrderedSymbolSet &);
52	static void PutPassName(llvm::raw_ostream &, const std::optional<SourceName> &);
53	static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &,
54	const parser::Expr *, SemanticsContext &);
55	static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &);
56	static void PutBound(llvm::raw_ostream &, const Bound &);
57	static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &);
58	static void PutShape(
59	llvm::raw_ostream &, const ArraySpec &, char open, char close);
60
61	static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);
62	static llvm::raw_ostream &PutType(llvm::raw_ostream &, const DeclTypeSpec &);
63	static llvm::raw_ostream &PutLower(llvm::raw_ostream &, std::string_view);
64	static std::error_code WriteFile(const std::string &, const std::string &,
65	ModuleCheckSumType &, bool debug = true);
66	static bool FileContentsMatch(
67	const std::string &, const std::string &, const std::string &);
68	static ModuleCheckSumType ComputeCheckSum(const std::string_view &);
69	static std::string CheckSumString(ModuleCheckSumType);
70
71	// Collect symbols needed for a subprogram interface
72	class SubprogramSymbolCollector {
73	public:
74	SubprogramSymbolCollector(const Symbol &symbol, const Scope &scope)
75	: symbol_{symbol}, scope_{scope} {}
76	const SymbolVector &symbols() const { return need_; }
77	const std::set<SourceName> &imports() const { return imports_; }
78	void Collect();
79
80	private:
81	const Symbol &symbol_;
82	const Scope &scope_;
83	bool isInterface_{false};
84	SymbolVector need_; // symbols that are needed
85	UnorderedSymbolSet needSet_; // symbols already in need_
86	UnorderedSymbolSet useSet_; // use-associations that might be needed
87	std::set<SourceName> imports_; // imports from host that are needed
88
89	void DoSymbol(const Symbol &);
90	void DoSymbol(const SourceName &, const Symbol &);
91	void DoType(const DeclTypeSpec *);
92	void DoBound(const Bound &);
93	void DoParamValue(const ParamValue &);
94	bool NeedImport(const SourceName &, const Symbol &);
95
96	template <typename T> void DoExpr(evaluate::Expr<T> expr) {
97	for (const Symbol &symbol : evaluate::CollectSymbols(expr)) {
98	DoSymbol(symbol);
99	}
100	}
101	};
102
103	bool ModFileWriter::WriteAll() {
104	// this flag affects character literals: force it to be consistent
105	auto restorer{
106	common::ScopedSet(parser::useHexadecimalEscapeSequences, false)};
107	WriteAll(context_.globalScope());
108	return !context_.AnyFatalError();
109	}
110
111	void ModFileWriter::WriteAll(const Scope &scope) {
112	for (const auto &child : scope.children()) {
113	WriteOne(child);
114	}
115	}
116
117	void ModFileWriter::WriteOne(const Scope &scope) {
118	if (scope.kind() == Scope::Kind::Module) {
119	auto *symbol{scope.symbol()};
120	if (!symbol->test(Symbol::Flag::ModFile)) {
121	Write(*symbol);
122	}
123	WriteAll(scope); // write out submodules
124	}
125	}
126
127	// Construct the name of a module file. Non-empty ancestorName means submodule.
128	static std::string ModFileName(const SourceName &name,
129	const std::string &ancestorName, const std::string &suffix) {
130	std::string result{name.ToString() + suffix};
131	return ancestorName.empty() ? result : ancestorName + '-' + result;
132	}
133
134	// Write the module file for symbol, which must be a module or submodule.
135	void ModFileWriter::Write(const Symbol &symbol) {
136	const auto &module{symbol.get<ModuleDetails>()};
137	if (module.moduleFileHash()) {
138	return; // already written
139	}
140	const auto *ancestor{module.ancestor()};
141	isSubmodule_ = ancestor != nullptr;
142	auto ancestorName{ancestor ? ancestor->GetName().value().ToString() : ""s};
143	std::string path{context_.moduleDirectory() + '/' +
144	ModFileName(symbol.name(), ancestorName, context_.moduleFileSuffix())};
145
146	std::set<std::string> hermeticModuleNames;
147	hermeticModuleNames.insert(symbol.name().ToString());
148	UnorderedSymbolSet additionalModules;
149	PutSymbols(DEREF(symbol.scope()),
150	hermeticModuleFileOutput_ ? &additionalModules : nullptr);
151	auto asStr{GetAsString(symbol)};
152	while (!additionalModules.empty()) {
153	UnorderedSymbolSet nextPass{std::move(additionalModules)};
154	additionalModules.clear();
155	for (const Symbol &modSym : nextPass) {
156	if (!modSym.owner().IsIntrinsicModules() &&
157	hermeticModuleNames.find(modSym.name().ToString()) ==
158	hermeticModuleNames.end()) {
159	hermeticModuleNames.insert(modSym.name().ToString());
160	PutSymbols(DEREF(modSym.scope()), &additionalModules);
161	asStr += GetAsString(modSym);
162	}
163	}
164	}
165
166	ModuleCheckSumType checkSum;
167	if (std::error_code error{
168	WriteFile(path, asStr, checkSum, context_.debugModuleWriter())}) {
169	context_.Say(
170	symbol.name(), "Error writing %s: %s"_err_en_US, path, error.message());
171	}
172	const_cast<ModuleDetails &>(module).set_moduleFileHash(checkSum);
173	}
174
175	void ModFileWriter::WriteClosure(llvm::raw_ostream &out, const Symbol &symbol,
176	UnorderedSymbolSet &nonIntrinsicModulesWritten) {
177	if (!symbol.has<ModuleDetails>() || symbol.owner().IsIntrinsicModules() ||
178	!nonIntrinsicModulesWritten.insert(symbol).second) {
179	return;
180	}
181	PutSymbols(DEREF(symbol.scope()), /*hermeticModules=*/nullptr);
182	needsBuf_.clear(); // omit module checksums
183	auto str{GetAsString(symbol)};
184	for (auto depRef : std::move(usedNonIntrinsicModules_)) {
185	WriteClosure(out, *depRef, nonIntrinsicModulesWritten);
186	}
187	out << std::move(str);
188	}
189
190	// Return the entire body of the module file
191	// and clear saved uses, decls, and contains.
192	std::string ModFileWriter::GetAsString(const Symbol &symbol) {
193	std::string buf;
194	llvm::raw_string_ostream all{buf};
195	all << needs_.str();
196	needs_.str().clear();
197	auto &details{symbol.get<ModuleDetails>()};
198	if (!details.isSubmodule()) {
199	all << "module " << symbol.name();
200	} else {
201	auto *parent{details.parent()->symbol()};
202	auto *ancestor{details.ancestor()->symbol()};
203	all << "submodule(" << ancestor->name();
204	if (parent != ancestor) {
205	all << ':' << parent->name();
206	}
207	all << ") " << symbol.name();
208	}
209	all << '\n' << uses_.str();
210	uses_.str().clear();
211	all << useExtraAttrs_.str();
212	useExtraAttrs_.str().clear();
213	all << decls_.str();
214	decls_.str().clear();
215	auto str{contains_.str()};
216	contains_.str().clear();
217	if (!str.empty()) {
218	all << "contains\n" << str;
219	}
220	all << "end\n";
221	return all.str();
222	}
223
224	// Collect symbols from constant and specification expressions that are being
225	// referenced directly from other modules; they may require new USE
226	// associations.
227	static void HarvestSymbolsNeededFromOtherModules(
228	SourceOrderedSymbolSet &, const Scope &);
229	static void HarvestSymbolsNeededFromOtherModules(
230	SourceOrderedSymbolSet &set, const Symbol &symbol, const Scope &scope) {
231	auto HarvestBound{[&](const Bound &bound) {
232	if (const auto &expr{bound.GetExplicit()}) {
233	for (SymbolRef ref : evaluate::CollectSymbols(*expr)) {
234	set.emplace(*ref);
235	}
236	}
237	}};
238	auto HarvestShapeSpec{[&](const ShapeSpec &shapeSpec) {
239	HarvestBound(shapeSpec.lbound());
240	HarvestBound(shapeSpec.ubound());
241	}};
242	auto HarvestArraySpec{[&](const ArraySpec &arraySpec) {
243	for (const auto &shapeSpec : arraySpec) {
244	HarvestShapeSpec(shapeSpec);
245	}
246	}};
247
248	if (symbol.has<DerivedTypeDetails>()) {
249	if (symbol.scope()) {
250	HarvestSymbolsNeededFromOtherModules(set, *symbol.scope());
251	}
252	} else if (const auto &generic{symbol.detailsIf<GenericDetails>()};
253	generic && generic->derivedType()) {
254	const Symbol &dtSym{*generic->derivedType()};
255	if (dtSym.has<DerivedTypeDetails>()) {
256	if (dtSym.scope()) {
257	HarvestSymbolsNeededFromOtherModules(set, *dtSym.scope());
258	}
259	} else {
260	CHECK(dtSym.has<UseDetails>() || dtSym.has<UseErrorDetails>());
261	}
262	} else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
263	HarvestArraySpec(object->shape());
264	HarvestArraySpec(object->coshape());
265	if (IsNamedConstant(symbol) || scope.IsDerivedType()) {
266	if (object->init()) {
267	for (SymbolRef ref : evaluate::CollectSymbols(*object->init())) {
268	set.emplace(*ref);
269	}
270	}
271	}
272	} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
273	if (proc->init() && *proc->init() && scope.IsDerivedType()) {
274	set.emplace(**proc->init());
275	}
276	} else if (const auto *subp{symbol.detailsIf<SubprogramDetails>()}) {
277	for (const Symbol *dummy : subp->dummyArgs()) {
278	if (dummy) {
279	HarvestSymbolsNeededFromOtherModules(set, *dummy, scope);
280	}
281	}
282	if (subp->isFunction()) {
283	HarvestSymbolsNeededFromOtherModules(set, subp->result(), scope);
284	}
285	}
286	}
287
288	static void HarvestSymbolsNeededFromOtherModules(
289	SourceOrderedSymbolSet &set, const Scope &scope) {
290	for (const auto &[_, symbol] : scope) {
291	HarvestSymbolsNeededFromOtherModules(set, *symbol, scope);
292	}
293	}
294
295	void ModFileWriter::PrepareRenamings(const Scope &scope) {
296	// Identify use-associated symbols already in scope under some name
297	std::map<const Symbol *, const Symbol *> useMap;
298	for (const auto &[name, symbolRef] : scope) {
299	const Symbol *symbol{&*symbolRef};
300	while (const auto *hostAssoc{symbol->detailsIf<HostAssocDetails>()}) {
301	symbol = &hostAssoc->symbol();
302	}
303	if (const auto *use{symbol->detailsIf<UseDetails>()}) {
304	useMap.emplace(&use->symbol(), symbol);
305	}
306	}
307	// Collect symbols needed from other modules
308	SourceOrderedSymbolSet symbolsNeeded;
309	HarvestSymbolsNeededFromOtherModules(symbolsNeeded, scope);
310	// Establish any necessary renamings of symbols in other modules
311	// to their names in this scope, creating those new names when needed.
312	auto &renamings{context_.moduleFileOutputRenamings()};
313	for (SymbolRef s : symbolsNeeded) {
314	if (s->owner().kind() != Scope::Kind::Module) {
315	// Not a USE'able name from a module's top scope;
316	// component, binding, dummy argument, &c.
317	continue;
318	}
319	const Scope *sMod{FindModuleContaining(s->owner())};
320	if (!sMod || sMod == &scope) {
321	continue;
322	}
323	if (auto iter{useMap.find(&*s)}; iter != useMap.end()) {
324	renamings.emplace(&*s, iter->second->name());
325	continue;
326	}
327	SourceName rename{s->name()};
328	if (const Symbol * found{scope.FindSymbol(s->name())}) {
329	if (found == &*s) {
330	continue; // available in scope
331	}
332	if (const auto *generic{found->detailsIf<GenericDetails>()}) {
333	if (generic->derivedType() == &*s || generic->specific() == &*s) {
334	continue;
335	}
336	} else if (found->has<UseDetails>()) {
337	if (&found->GetUltimate() == &*s) {
338	continue; // already use-associated with same name
339	}
340	}
341	if (&s->owner() != &found->owner()) { // Symbol needs renaming
342	rename = scope.context().SaveTempName(
343	DEREF(sMod->symbol()).name().ToString() + "$" +
344	s->name().ToString());
345	}
346	}
347	// Symbol is used in this scope but not visible under its name
348	if (sMod->parent().IsIntrinsicModules()) {
349	uses_ << "use,intrinsic::";
350	} else {
351	uses_ << "use ";
352	}
353	uses_ << DEREF(sMod->symbol()).name() << ",only:";
354	if (rename != s->name()) {
355	uses_ << rename << "=>";
356	renamings.emplace(&s->GetUltimate(), rename);
357	}
358	uses_ << s->name() << '\n';
359	useExtraAttrs_ << "private::" << rename << '\n';
360	}
361	}
362
363	// Put out the visible symbols from scope.
364	void ModFileWriter::PutSymbols(
365	const Scope &scope, UnorderedSymbolSet *hermeticModules) {
366	SymbolVector sorted;
367	SymbolVector uses;
368	auto &renamings{context_.moduleFileOutputRenamings()};
369	auto previousRenamings{std::move(renamings)};
370	PrepareRenamings(scope);
371	SourceOrderedSymbolSet modules;
372	CollectSymbols(scope, sorted, uses, modules);
373	// Write module files for dependencies first so that their
374	// hashes are known.
375	for (auto ref : modules) {
376	if (hermeticModules) {
377	hermeticModules->insert(*ref);
378	} else {
379	Write(*ref);
380	needs_ << ModHeader::need
381	<< CheckSumString(
382	ref->get<ModuleDetails>().moduleFileHash().value())
383	<< (ref->owner().IsIntrinsicModules() ? " i " : " n ")
384	<< ref->name().ToString() << '\n';
385	}
386	}
387	std::string buf; // stuff after CONTAINS in derived type
388	llvm::raw_string_ostream typeBindings{buf};
389	for (const Symbol &symbol : sorted) {
390	if (!symbol.test(Symbol::Flag::CompilerCreated)) {
391	PutSymbol(typeBindings, symbol);
392	}
393	}
394	for (const Symbol &symbol : uses) {
395	PutUse(symbol);
396	}
397	for (const auto &set : scope.equivalenceSets()) {
398	if (!set.empty() &&
399	!set.front().symbol.test(Symbol::Flag::CompilerCreated)) {
400	char punctuation{'('};
401	decls_ << "equivalence";
402	for (const auto &object : set) {
403	decls_ << punctuation << object.AsFortran();
404	punctuation = ',';
405	}
406	decls_ << ")\n";
407	}
408	}
409	CHECK(typeBindings.str().empty());
410	renamings = std::move(previousRenamings);
411	}
412
413	// Emit components in order
414	bool ModFileWriter::PutComponents(const Symbol &typeSymbol) {
415	const auto &scope{DEREF(typeSymbol.scope())};
416	std::string buf; // stuff after CONTAINS in derived type
417	llvm::raw_string_ostream typeBindings{buf};
418	UnorderedSymbolSet emitted;
419	SymbolVector symbols{scope.GetSymbols()};
420	// Emit type parameter declarations first, in order
421	const auto &details{typeSymbol.get<DerivedTypeDetails>()};
422	for (const Symbol &symbol : details.paramDeclOrder()) {
423	CHECK(symbol.has<TypeParamDetails>());
424	PutSymbol(typeBindings, symbol);
425	emitted.emplace(symbol);
426	}
427	// Emit actual components in component order.
428	for (SourceName name : details.componentNames()) {
429	auto iter{scope.find(name)};
430	if (iter != scope.end()) {
431	const Symbol &component{*iter->second};
432	if (!component.test(Symbol::Flag::ParentComp)) {
433	PutSymbol(typeBindings, component);
434	}
435	emitted.emplace(component);
436	}
437	}
438	// Emit remaining symbols from the type's scope
439	for (const Symbol &symbol : symbols) {
440	if (emitted.find(symbol) == emitted.end()) {
441	PutSymbol(typeBindings, symbol);
442	}
443	}
444	if (auto str{typeBindings.str()}; !str.empty()) {
445	CHECK(scope.IsDerivedType());
446	decls_ << "contains\n" << str;
447	return true;
448	} else {
449	return false;
450	}
451	}
452
453	// Return the symbol's attributes that should be written
454	// into the mod file.
455	static Attrs getSymbolAttrsToWrite(const Symbol &symbol) {
456	// Is SAVE attribute is implicit, it should be omitted
457	// to not violate F202x C862 for a common block member.
458	return symbol.attrs() & ~(symbol.implicitAttrs() & Attrs{Attr::SAVE});
459	}
460
461	static llvm::raw_ostream &PutGenericName(
462	llvm::raw_ostream &os, const Symbol &symbol) {
463	if (IsGenericDefinedOp(symbol)) {
464	return os << "operator(" << symbol.name() << ')';
465	} else {
466	return os << symbol.name();
467	}
468	}
469
470	// Emit a symbol to decls_, except for bindings in a derived type (type-bound
471	// procedures, type-bound generics, final procedures) which go to typeBindings.
472	void ModFileWriter::PutSymbol(
473	llvm::raw_ostream &typeBindings, const Symbol &symbol) {
474	common::visit(
475	common::visitors{
476	[&](const ModuleDetails &) { /* should be current module */ },
477	[&](const DerivedTypeDetails &) { PutDerivedType(symbol); },
478	[&](const SubprogramDetails &) { PutSubprogram(symbol); },
479	[&](const GenericDetails &x) {
480	if (symbol.owner().IsDerivedType()) {
481	// generic binding
482	for (const Symbol &proc : x.specificProcs()) {
483	PutGenericName(typeBindings << "generic::", symbol)
484	<< "=>" << proc.name() << '\n';
485	}
486	} else {
487	PutGeneric(symbol);
488	}
489	},
490	[&](const UseDetails &) { PutUse(symbol); },
491	[](const UseErrorDetails &) {},
492	[&](const ProcBindingDetails &x) {
493	bool deferred{symbol.attrs().test(Attr::DEFERRED)};
494	typeBindings << "procedure";
495	if (deferred) {
496	typeBindings << '(' << x.symbol().name() << ')';
497	}
498	PutPassName(typeBindings, x.passName());
499	auto attrs{symbol.attrs()};
500	if (x.passName()) {
501	attrs.reset(Attr::PASS);
502	}
503	PutAttrs(typeBindings, attrs);
504	typeBindings << "::" << symbol.name();
505	if (!deferred && x.symbol().name() != symbol.name()) {
506	typeBindings << "=>" << x.symbol().name();
507	}
508	typeBindings << '\n';
509	},
510	[&](const NamelistDetails &x) {
511	decls_ << "namelist/" << symbol.name();
512	char sep{'/'};
513	for (const Symbol &object : x.objects()) {
514	decls_ << sep << object.name();
515	sep = ',';
516	}
517	decls_ << '\n';
518	if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
519	decls_ << "private::" << symbol.name() << '\n';
520	}
521	},
522	[&](const CommonBlockDetails &x) {
523	decls_ << "common/" << symbol.name();
524	char sep = '/';
525	for (const auto &object : x.objects()) {
526	decls_ << sep << object->name();
527	sep = ',';
528	}
529	decls_ << '\n';
530	if (symbol.attrs().test(Attr::BIND_C)) {
531	PutAttrs(decls_, getSymbolAttrsToWrite(symbol), x.bindName(),
532	x.isExplicitBindName(), ""s);
533	decls_ << "::/" << symbol.name() << "/\n";
534	}
535	},
536	[](const HostAssocDetails &) {},
537	[](const MiscDetails &) {},
538	[&](const auto &) {
539	PutEntity(decls_, symbol);
540	PutDirective(decls_, symbol);
541	},
542	},
543	symbol.details());
544	}
545
546	void ModFileWriter::PutDerivedType(
547	const Symbol &typeSymbol, const Scope *scope) {
548	auto &details{typeSymbol.get<DerivedTypeDetails>()};
549	if (details.isDECStructure()) {
550	PutDECStructure(typeSymbol, scope);
551	return;
552	}
553	PutAttrs(decls_ << "type", typeSymbol.attrs());
554	if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
555	decls_ << ",extends(" << extends->name() << ')';
556	}
557	decls_ << "::" << typeSymbol.name();
558	if (!details.paramNameOrder().empty()) {
559	char sep{'('};
560	for (const SymbolRef &ref : details.paramNameOrder()) {
561	decls_ << sep << ref->name();
562	sep = ',';
563	}
564	decls_ << ')';
565	}
566	decls_ << '\n';
567	if (details.sequence()) {
568	decls_ << "sequence\n";
569	}
570	bool contains{PutComponents(typeSymbol)};
571	if (!details.finals().empty()) {
572	const char *sep{contains ? "final::" : "contains\nfinal::"};
573	for (const auto &pair : details.finals()) {
574	decls_ << sep << pair.second->name();
575	sep = ",";
576	}
577	if (*sep == ',') {
578	decls_ << '\n';
579	}
580	}
581	decls_ << "end type\n";
582	}
583
584	void ModFileWriter::PutDECStructure(
585	const Symbol &typeSymbol, const Scope *scope) {
586	if (emittedDECStructures_.find(typeSymbol) != emittedDECStructures_.end()) {
587	return;
588	}
589	if (!scope && context_.IsTempName(typeSymbol.name().ToString())) {
590	return; // defer until used
591	}
592	emittedDECStructures_.insert(typeSymbol);
593	decls_ << "structure ";
594	if (!context_.IsTempName(typeSymbol.name().ToString())) {
595	decls_ << typeSymbol.name();
596	}
597	if (scope && scope->kind() == Scope::Kind::DerivedType) {
598	// Nested STRUCTURE: emit entity declarations right now
599	// on the STRUCTURE statement.
600	bool any{false};
601	for (const auto &ref : scope->GetSymbols()) {
602	const auto *object{ref->detailsIf<ObjectEntityDetails>()};
603	if (object && object->type() &&
604	object->type()->category() == DeclTypeSpec::TypeDerived &&
605	&object->type()->derivedTypeSpec().typeSymbol() == &typeSymbol) {
606	if (any) {
607	decls_ << ',';
608	} else {
609	any = true;
610	}
611	decls_ << ref->name();
612	PutShape(decls_, object->shape(), '(', ')');
613	PutInit(decls_, *ref, object->init(), nullptr, context_);
614	emittedDECFields_.insert(*ref);
615	} else if (any) {
616	break; // any later use of this structure will use RECORD/str/
617	}
618	}
619	}
620	decls_ << '\n';
621	PutComponents(typeSymbol);
622	decls_ << "end structure\n";
623	}
624
625	// Attributes that may be in a subprogram prefix
626	static const Attrs subprogramPrefixAttrs{Attr::ELEMENTAL, Attr::IMPURE,
627	Attr::MODULE, Attr::NON_RECURSIVE, Attr::PURE, Attr::RECURSIVE};
628
629	static void PutOpenACCDeviceTypeRoutineInfo(
630	llvm::raw_ostream &os, const OpenACCRoutineDeviceTypeInfo &info) {
631	if (info.isSeq()) {
632	os << " seq";
633	}
634	if (info.isGang()) {
635	os << " gang";
636	if (info.gangDim() > 0) {
637	os << "(dim: " << info.gangDim() << ")";
638	}
639	}
640	if (info.isVector()) {
641	os << " vector";
642	}
643	if (info.isWorker()) {
644	os << " worker";
645	}
646	if (const std::variant<std::string, SymbolRef> *bindName{info.bindName()}) {
647	os << " bind(";
648	if (std::holds_alternative<std::string>(*bindName)) {
649	os << "\"" << std::get<std::string>(*bindName) << "\"";
650	} else {
651	os << std::get<SymbolRef>(*bindName)->name();
652	}
653	os << ")";
654	}
655	}
656
657	static void PutOpenACCRoutineInfo(
658	llvm::raw_ostream &os, const SubprogramDetails &details) {
659	for (auto info : details.openACCRoutineInfos()) {
660	os << "!$acc routine";
661
662	PutOpenACCDeviceTypeRoutineInfo(os, info);
663
664	if (info.isNohost()) {
665	os << " nohost";
666	}
667
668	for (auto dtype : info.deviceTypeInfos()) {
669	os << " device_type(";
670	if (dtype.dType() == common::OpenACCDeviceType::Star) {
671	os << "*";
672	} else {
673	os << parser::ToLowerCaseLetters(common::EnumToString(dtype.dType()));
674	}
675	os << ")";
676
677	PutOpenACCDeviceTypeRoutineInfo(os, dtype);
678	}
679
680	os << "\n";
681	}
682	}
683
684	void ModFileWriter::PutSubprogram(const Symbol &symbol) {
685	auto &details{symbol.get<SubprogramDetails>()};
686	if (const Symbol * interface{details.moduleInterface()}) {
687	const Scope *module{FindModuleContaining(interface->owner())};
688	if (module && module != &symbol.owner()) {
689	// Interface is in ancestor module
690	} else {
691	PutSubprogram(symbol: *interface);
692	}
693	}
694	auto attrs{symbol.attrs()};
695	Attrs bindAttrs{};
696	if (attrs.test(Attr::BIND_C)) {
697	// bind(c) is a suffix, not prefix
698	bindAttrs.set(Attr::BIND_C, true);
699	attrs.set(Attr::BIND_C, false);
700	}
701	bool isAbstract{attrs.test(Attr::ABSTRACT)};
702	if (isAbstract) {
703	attrs.set(Attr::ABSTRACT, false);
704	}
705	Attrs prefixAttrs{subprogramPrefixAttrs & attrs};
706	// emit any non-prefix attributes in an attribute statement
707	attrs &= ~subprogramPrefixAttrs;
708	std::string ssBuf;
709	llvm::raw_string_ostream ss{ssBuf};
710	PutAttrs(ss, attrs);
711	if (!ss.str().empty()) {
712	decls_ << ss.str().substr(pos: 1) << "::" << symbol.name() << '\n';
713	}
714	bool isInterface{details.isInterface()};
715	llvm::raw_ostream &os{isInterface ? decls_ : contains_};
716	if (isInterface) {
717	os << (isAbstract ? "abstract " : "") << "interface\n";
718	}
719	PutAttrs(os, prefixAttrs, nullptr, false, ""s, " "s);
720	if (auto attrs{details.cudaSubprogramAttrs()}) {
721	if (*attrs == common::CUDASubprogramAttrs::HostDevice) {
722	os << "attributes(host,device) ";
723	} else {
724	PutLower(os << "attributes(", common::EnumToString(*attrs)) << ") ";
725	}
726	if (!details.cudaLaunchBounds().empty()) {
727	os << "launch_bounds";
728	char sep{'('};
729	for (auto x : details.cudaLaunchBounds()) {
730	os << sep << x;
731	sep = ',';
732	}
733	os << ") ";
734	}
735	if (!details.cudaClusterDims().empty()) {
736	os << "cluster_dims";
737	char sep{'('};
738	for (auto x : details.cudaClusterDims()) {
739	os << sep << x;
740	sep = ',';
741	}
742	os << ") ";
743	}
744	}
745	os << (details.isFunction() ? "function " : "subroutine ");
746	os << symbol.name() << '(';
747	int n = 0;
748	for (const auto &dummy : details.dummyArgs()) {
749	if (n++ > 0) {
750	os << ',';
751	}
752	if (dummy) {
753	os << dummy->name();
754	} else {
755	os << "*";
756	}
757	}
758	os << ')';
759	PutAttrs(os, bindAttrs, details.bindName(), details.isExplicitBindName(),
760	" "s, ""s);
761	if (details.isFunction()) {
762	const Symbol &result{details.result()};
763	if (result.name() != symbol.name()) {
764	os << " result(" << result.name() << ')';
765	}
766	}
767	os << '\n';
768	// walk symbols, collect ones needed for interface
769	const Scope &scope{
770	details.entryScope() ? *details.entryScope() : DEREF(symbol.scope())};
771	SubprogramSymbolCollector collector{symbol, scope};
772	collector.Collect();
773	std::string typeBindingsBuf;
774	llvm::raw_string_ostream typeBindings{typeBindingsBuf};
775	ModFileWriter writer{context_};
776	for (const Symbol &need : collector.symbols()) {
777	writer.PutSymbol(typeBindings, need);
778	}
779	CHECK(typeBindings.str().empty());
780	os << writer.uses_.str();
781	for (const SourceName &import : collector.imports()) {
782	decls_ << "import::" << import << "\n";
783	}
784	os << writer.decls_.str();
785	PutOpenACCRoutineInfo(os, details);
786	os << "end\n";
787	if (isInterface) {
788	os << "end interface\n";
789	}
790	}
791
792	static bool IsIntrinsicOp(const Symbol &symbol) {
793	if (const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()}) {
794	return details->kind().IsIntrinsicOperator();
795	} else {
796	return false;
797	}
798	}
799
800	void ModFileWriter::PutGeneric(const Symbol &symbol) {
801	const auto &genericOwner{symbol.owner()};
802	auto &details{symbol.get<GenericDetails>()};
803	PutGenericName(os&: decls_ << "interface ", symbol) << '\n';
804	for (const Symbol &specific : details.specificProcs()) {
805	if (specific.owner() == genericOwner) {
806	decls_ << "procedure::" << specific.name() << '\n';
807	}
808	}
809	decls_ << "end interface\n";
810	if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
811	PutGenericName(os&: decls_ << "private::", symbol) << '\n';
812	}
813	}
814
815	void ModFileWriter::PutUse(const Symbol &symbol) {
816	auto &details{symbol.get<UseDetails>()};
817	auto &use{details.symbol()};
818	const Symbol &module{GetUsedModule(details)};
819	if (use.owner().parent().IsIntrinsicModules()) {
820	uses_ << "use,intrinsic::";
821	} else {
822	uses_ << "use ";
823	usedNonIntrinsicModules_.insert(module);
824	}
825	uses_ << module.name() << ",only:";
826	PutGenericName(os&: uses_, symbol);
827	// Can have intrinsic op with different local-name and use-name
828	// (e.g. `operator(<)` and `operator(.lt.)`) but rename is not allowed
829	if (!IsIntrinsicOp(symbol) && use.name() != symbol.name()) {
830	PutGenericName(uses_ << "=>", use);
831	}
832	uses_ << '\n';
833	PutUseExtraAttr(Attr::VOLATILE, symbol, use);
834	PutUseExtraAttr(Attr::ASYNCHRONOUS, symbol, use);
835	if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
836	PutGenericName(os&: useExtraAttrs_ << "private::", symbol) << '\n';
837	}
838	}
839
840	// We have "USE local => use" in this module. If attr was added locally
841	// (i.e. on local but not on use), also write it out in the mod file.
842	void ModFileWriter::PutUseExtraAttr(
843	Attr attr, const Symbol &local, const Symbol &use) {
844	if (local.attrs().test(attr) && !use.attrs().test(attr)) {
845	PutAttr(useExtraAttrs_, attr) << "::";
846	useExtraAttrs_ << local.name() << '\n';
847	}
848	}
849
850	// Collect the symbols of this scope sorted by their original order, not name.
851	// Generics and namelists are exceptions: they are sorted after other symbols.
852	void CollectSymbols(const Scope &scope, SymbolVector &sorted,
853	SymbolVector &uses, SourceOrderedSymbolSet &modules) {
854	SymbolVector namelist, generics;
855	auto symbols{scope.GetSymbols()};
856	std::size_t commonSize{scope.commonBlocks().size()};
857	sorted.reserve(symbols.size() + commonSize);
858	for (SymbolRef symbol : symbols) {
859	const auto *generic{symbol->detailsIf<GenericDetails>()};
860	if (generic) {
861	uses.insert(uses.end(), generic->uses().begin(), generic->uses().end());
862	for (auto ref : generic->uses()) {
863	modules.insert(GetUsedModule(ref->get<UseDetails>()));
864	}
865	} else if (const auto *use{symbol->detailsIf<UseDetails>()}) {
866	modules.insert(GetUsedModule(*use));
867	}
868	if (symbol->test(Symbol::Flag::ParentComp)) {
869	} else if (symbol->has<NamelistDetails>()) {
870	namelist.push_back(symbol);
871	} else if (generic) {
872	if (generic->specific() &&
873	&generic->specific()->owner() == &symbol->owner()) {
874	sorted.push_back(*generic->specific());
875	} else if (generic->derivedType() &&
876	&generic->derivedType()->owner() == &symbol->owner()) {
877	sorted.push_back(*generic->derivedType());
878	}
879	generics.push_back(symbol);
880	} else {
881	sorted.push_back(symbol);
882	}
883	}
884	std::sort(sorted.begin(), sorted.end(), SymbolSourcePositionCompare{});
885	std::sort(generics.begin(), generics.end(), SymbolSourcePositionCompare{});
886	sorted.insert(sorted.end(), generics.begin(), generics.end());
887	sorted.insert(sorted.end(), namelist.begin(), namelist.end());
888	for (const auto &pair : scope.commonBlocks()) {
889	sorted.push_back(*pair.second);
890	}
891	std::sort(
892	sorted.end() - commonSize, sorted.end(), SymbolSourcePositionCompare{});
893	}
894
895	void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {
896	common::visit(
897	common::visitors{
898	[&](const ObjectEntityDetails &) { PutObjectEntity(os, symbol); },
899	[&](const ProcEntityDetails &) { PutProcEntity(os, symbol); },
900	[&](const TypeParamDetails &) { PutTypeParam(os, symbol); },
901	[&](const UserReductionDetails &) { PutUserReduction(os, symbol); },
902	[&](const auto &) {
903	common::die("PutEntity: unexpected details: %s",
904	DetailsToString(symbol.details()).c_str());
905	},
906	},
907	symbol.details());
908	}
909
910	void PutShapeSpec(llvm::raw_ostream &os, const ShapeSpec &x) {
911	if (x.lbound().isStar()) {
912	CHECK(x.ubound().isStar());
913	os << ".."; // assumed rank
914	} else {
915	if (!x.lbound().isColon()) {
916	PutBound(os, x.lbound());
917	}
918	os << ':';
919	if (!x.ubound().isColon()) {
920	PutBound(os, x.ubound());
921	}
922	}
923	}
924	void PutShape(
925	llvm::raw_ostream &os, const ArraySpec &shape, char open, char close) {
926	if (!shape.empty()) {
927	os << open;
928	bool first{true};
929	for (const auto &shapeSpec : shape) {
930	if (first) {
931	first = false;
932	} else {
933	os << ',';
934	}
935	PutShapeSpec(os, shapeSpec);
936	}
937	os << close;
938	}
939	}
940
941	void ModFileWriter::PutObjectEntity(
942	llvm::raw_ostream &os, const Symbol &symbol) {
943	auto &details{symbol.get<ObjectEntityDetails>()};
944	if (details.type() &&
945	details.type()->category() == DeclTypeSpec::TypeDerived) {
946	const Symbol &typeSymbol{details.type()->derivedTypeSpec().typeSymbol()};
947	if (typeSymbol.get<DerivedTypeDetails>().isDECStructure()) {
948	PutDerivedType(typeSymbol, scope: &symbol.owner());
949	if (emittedDECFields_.find(symbol) != emittedDECFields_.end()) {
950	return; // symbol was emitted on STRUCTURE statement
951	}
952	}
953	}
954	PutEntity(
955	os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); },
956	getSymbolAttrsToWrite(symbol));
957	PutShape(os, details.shape(), '(', ')');
958	PutShape(os, details.coshape(), '[', ']');
959	PutInit(os, symbol, details.init(), details.unanalyzedPDTComponentInit(),
960	context_);
961	os << '\n';
962	if (auto tkr{GetIgnoreTKR(symbol)}; !tkr.empty()) {
963	os << "!dir$ ignore_tkr(";
964	tkr.IterateOverMembers([&](common::IgnoreTKR tkr) {
965	switch (tkr) {
966	SWITCH_COVERS_ALL_CASES
967	case common::IgnoreTKR::Type:
968	os << 't';
969	break;
970	case common::IgnoreTKR::Kind:
971	os << 'k';
972	break;
973	case common::IgnoreTKR::Rank:
974	os << 'r';
975	break;
976	case common::IgnoreTKR::Device:
977	os << 'd';
978	break;
979	case common::IgnoreTKR::Managed:
980	os << 'm';
981	break;
982	case common::IgnoreTKR::Contiguous:
983	os << 'c';
984	break;
985	}
986	});
987	os << ") " << symbol.name() << '\n';
988	}
989	if (auto attr{details.cudaDataAttr()}) {
990	PutLower(os << "attributes(", common::EnumToString(*attr))
991	<< ") " << symbol.name() << '\n';
992	}
993	if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointer)) {
994	for (const auto &[pointee, pointer] : symbol.owner().crayPointers()) {
995	if (pointer == symbol) {
996	os << "pointer(" << symbol.name() << "," << pointee << ")\n";
997	}
998	}
999	}
1000	}
1001
1002	void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
1003	if (symbol.attrs().test(Attr::INTRINSIC)) {
1004	os << "intrinsic::" << symbol.name() << '\n';
1005	if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
1006	os << "private::" << symbol.name() << '\n';
1007	}
1008	return;
1009	}
1010	const auto &details{symbol.get<ProcEntityDetails>()};
1011	Attrs attrs{symbol.attrs()};
1012	if (details.passName()) {
1013	attrs.reset(Attr::PASS);
1014	}
1015	PutEntity(
1016	os, symbol,
1017	[&]() {
1018	os << "procedure(";
1019	if (details.rawProcInterface()) {
1020	os << details.rawProcInterface()->name();
1021	} else if (details.type()) {
1022	PutType(os, *details.type());
1023	}
1024	os << ')';
1025	PutPassName(os, details.passName());
1026	},
1027	attrs);
1028	os << '\n';
1029	}
1030
1031	void PutPassName(
1032	llvm::raw_ostream &os, const std::optional<SourceName> &passName) {
1033	if (passName) {
1034	os << ",pass(" << *passName << ')';
1035	}
1036	}
1037
1038	void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
1039	auto &details{symbol.get<TypeParamDetails>()};
1040	PutEntity(
1041	os, symbol,
1042	[&]() {
1043	PutType(os, DEREF(symbol.GetType()));
1044	PutLower(os << ',', common::EnumToString(details.attr().value()));
1045	},
1046	symbol.attrs());
1047	PutInit(os, details.init());
1048	os << '\n';
1049	}
1050
1051	void ModFileWriter::PutUserReduction(
1052	llvm::raw_ostream &os, const Symbol &symbol) {
1053	const auto &details{symbol.get<UserReductionDetails>()};
1054	// The module content for a OpenMP Declare Reduction is the OpenMP
1055	// declaration. There may be multiple declarations.
1056	// Decls are pointers, so do not use a reference.
1057	for (const auto decl : details.GetDeclList()) {
1058	common::visit( //
1059	common::visitors{//
1060	[&](const parser::OpenMPDeclareReductionConstruct *d) {
1061	Unparse(os, *d, context_.langOptions());
1062	},
1063	[&](const parser::OmpMetadirectiveDirective *m) {
1064	Unparse(os, *m, context_.langOptions());
1065	},
1066	[&](const auto &) {
1067	DIE("Unknown OpenMP DECLARE REDUCTION content");
1068	}},
1069	decl);
1070	}
1071	}
1072
1073	void PutInit(llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init,
1074	const parser::Expr *unanalyzed, SemanticsContext &context) {
1075	if (IsNamedConstant(symbol) || symbol.owner().IsDerivedType()) {
1076	const char *assign{symbol.attrs().test(Attr::POINTER) ? "=>" : "="};
1077	if (unanalyzed) {
1078	parser::Unparse(os << assign, *unanalyzed, context.langOptions());
1079	} else if (init) {
1080	init->AsFortran(os << assign);
1081	}
1082	}
1083	}
1084
1085	void PutInit(llvm::raw_ostream &os, const MaybeIntExpr &init) {
1086	if (init) {
1087	init->AsFortran(os << '=');
1088	}
1089	}
1090
1091	void PutBound(llvm::raw_ostream &os, const Bound &x) {
1092	if (x.isStar()) {
1093	os << '*';
1094	} else if (x.isColon()) {
1095	os << ':';
1096	} else {
1097	x.GetExplicit()->AsFortran(os);
1098	}
1099	}
1100
1101	// Write an entity (object or procedure) declaration.
1102	// writeType is called to write out the type.
1103	void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
1104	std::function<void()> writeType, Attrs attrs) {
1105	writeType();
1106	PutAttrs(os, attrs, symbol.GetBindName(), symbol.GetIsExplicitBindName());
1107	if (symbol.owner().kind() == Scope::Kind::DerivedType &&
1108	context_.IsTempName(symbol.name().ToString())) {
1109	os << "::%FILL";
1110	} else {
1111	os << "::" << symbol.name();
1112	}
1113	}
1114
1115	// Put out each attribute to os, surrounded by `before` and `after` and
1116	// mapped to lower case.
1117	llvm::raw_ostream &ModFileWriter::PutAttrs(llvm::raw_ostream &os, Attrs attrs,
1118	const std::string *bindName, bool isExplicitBindName, std::string before,
1119	std::string after) const {
1120	attrs.set(Attr::PUBLIC, false); // no need to write PUBLIC
1121	attrs.set(Attr::EXTERNAL, false); // no need to write EXTERNAL
1122	if (isSubmodule_) {
1123	attrs.set(Attr::PRIVATE, false);
1124	}
1125	if (bindName || isExplicitBindName) {
1126	os << before << "bind(c";
1127	if (isExplicitBindName) {
1128	os << ",name=\"" << (bindName ? *bindName : ""s) << '"';
1129	}
1130	os << ')' << after;
1131	attrs.set(Attr::BIND_C, false);
1132	}
1133	for (std::size_t i{0}; i < Attr_enumSize; ++i) {
1134	Attr attr{static_cast<Attr>(i)};
1135	if (attrs.test(attr)) {
1136	PutAttr(os << before, attr) << after;
1137	}
1138	}
1139	return os;
1140	}
1141
1142	llvm::raw_ostream &PutAttr(llvm::raw_ostream &os, Attr attr) {
1143	return PutLower(os, AttrToString(attr));
1144	}
1145
1146	llvm::raw_ostream &PutType(llvm::raw_ostream &os, const DeclTypeSpec &type) {
1147	return PutLower(os, type.AsFortran());
1148	}
1149
1150	llvm::raw_ostream &PutLower(llvm::raw_ostream &os, std::string_view str) {
1151	for (char c : str) {
1152	os << parser::ToLowerCaseLetter(c);
1153	}
1154	return os;
1155	}
1156
1157	void PutOpenACCDirective(llvm::raw_ostream &os, const Symbol &symbol) {
1158	if (symbol.test(Symbol::Flag::AccDeclare)) {
1159	os << "!$acc declare ";
1160	if (symbol.test(Symbol::Flag::AccCopy)) {
1161	os << "copy";
1162	} else if (symbol.test(Symbol::Flag::AccCopyIn) ||
1163	symbol.test(Symbol::Flag::AccCopyInReadOnly)) {
1164	os << "copyin";
1165	} else if (symbol.test(Symbol::Flag::AccCopyOut)) {
1166	os << "copyout";
1167	} else if (symbol.test(Symbol::Flag::AccCreate)) {
1168	os << "create";
1169	} else if (symbol.test(Symbol::Flag::AccPresent)) {
1170	os << "present";
1171	} else if (symbol.test(Symbol::Flag::AccDevicePtr)) {
1172	os << "deviceptr";
1173	} else if (symbol.test(Symbol::Flag::AccDeviceResident)) {
1174	os << "device_resident";
1175	} else if (symbol.test(Symbol::Flag::AccLink)) {
1176	os << "link";
1177	}
1178	os << "(";
1179	if (symbol.test(Symbol::Flag::AccCopyInReadOnly)) {
1180	os << "readonly: ";
1181	}
1182	os << symbol.name() << ")\n";
1183	}
1184	}
1185
1186	void PutOpenMPDirective(llvm::raw_ostream &os, const Symbol &symbol) {
1187	if (symbol.test(Symbol::Flag::OmpThreadprivate)) {
1188	os << "!$omp threadprivate(" << symbol.name() << ")\n";
1189	}
1190	}
1191
1192	void ModFileWriter::PutDirective(llvm::raw_ostream &os, const Symbol &symbol) {
1193	PutOpenACCDirective(os, symbol);
1194	PutOpenMPDirective(os, symbol);
1195	}
1196
1197	struct Temp {
1198	Temp(int fd, std::string path) : fd{fd}, path{path} {}
1199	Temp(Temp &&t) : fd{std::exchange(obj&: t.fd, new_val: -1)}, path{std::move(t.path)} {}
1200	~Temp() {
1201	if (fd >= 0) {
1202	llvm::sys::fs::file_t native{llvm::sys::fs::convertFDToNativeFile(FD: fd)};
1203	llvm::sys::fs::closeFile(F&: native);
1204	llvm::sys::fs::remove(path: path.c_str());
1205	}
1206	}
1207	int fd;
1208	std::string path;
1209	};
1210
1211	// Create a temp file in the same directory and with the same suffix as path.
1212	// Return an open file descriptor and its path.
1213	static llvm::ErrorOr<Temp> MkTemp(const std::string &path) {
1214	auto length{path.length()};
1215	auto dot{path.find_last_of(s: "./")};
1216	std::string suffix{
1217	dot < length && path[dot] == '.' ? path.substr(pos: dot + 1) : ""};
1218	CHECK(length > suffix.length() &&
1219	path.substr(pos: length - suffix.length()) == suffix);
1220	auto prefix{path.substr(pos: 0, n: length - suffix.length())};
1221	int fd;
1222	llvm::SmallString<16> tempPath;
1223	if (std::error_code err{llvm::sys::fs::createUniqueFile(
1224	Model: prefix + "%%%%%%" + suffix, ResultFD&: fd, ResultPath&: tempPath)}) {
1225	return err;
1226	}
1227	return Temp{fd, tempPath.c_str()};
1228	}
1229
1230	// Write the module file at path, prepending header. If an error occurs,
1231	// return errno, otherwise 0.
1232	static std::error_code WriteFile(const std::string &path,
1233	const std::string &contents, ModuleCheckSumType &checkSum, bool debug) {
1234	checkSum = ComputeCheckSum(contents);
1235	auto header{std::string{ModHeader::bom} + ModHeader::magic +
1236	CheckSumString(checkSum) + ModHeader::terminator};
1237	if (debug) {
1238	llvm::dbgs() << "Processing module " << path << ": ";
1239	}
1240	if (FileContentsMatch(path, header, contents)) {
1241	if (debug) {
1242	llvm::dbgs() << "module unchanged, not writing\n";
1243	}
1244	return {};
1245	}
1246	llvm::ErrorOr<Temp> temp{MkTemp(path)};
1247	if (!temp) {
1248	return temp.getError();
1249	}
1250	llvm::raw_fd_ostream writer(temp->fd, /*shouldClose=*/false);
1251	writer << header;
1252	writer << contents;
1253	writer.flush();
1254	if (writer.has_error()) {
1255	return writer.error();
1256	}
1257	if (debug) {
1258	llvm::dbgs() << "module written\n";
1259	}
1260	return llvm::sys::fs::rename(from: temp->path, to: path);
1261	}
1262
1263	// Return true if the stream matches what we would write for the mod file.
1264	static bool FileContentsMatch(const std::string &path,
1265	const std::string &header, const std::string &contents) {
1266	std::size_t hsize{header.size()};
1267	std::size_t csize{contents.size()};
1268	auto buf_or{llvm::MemoryBuffer::getFile(Filename: path)};
1269	if (!buf_or) {
1270	return false;
1271	}
1272	auto buf = std::move(buf_or.get());
1273	if (buf->getBufferSize() != hsize + csize) {
1274	return false;
1275	}
1276	if (!std::equal(first1: header.begin(), last1: header.end(), first2: buf->getBufferStart(),
1277	last2: buf->getBufferStart() + hsize)) {
1278	return false;
1279	}
1280
1281	return std::equal(first1: contents.begin(), last1: contents.end(),
1282	first2: buf->getBufferStart() + hsize, last2: buf->getBufferEnd());
1283	}
1284
1285	// Compute a simple hash of the contents of a module file and
1286	// return it as a string of hex digits.
1287	// This uses the Fowler-Noll-Vo hash function.
1288	static ModuleCheckSumType ComputeCheckSum(const std::string_view &contents) {
1289	ModuleCheckSumType hash{0xcbf29ce484222325ull};
1290	for (char c : contents) {
1291	hash ^= c & 0xff;
1292	hash *= 0x100000001b3;
1293	}
1294	return hash;
1295	}
1296
1297	static std::string CheckSumString(ModuleCheckSumType hash) {
1298	static const char *digits = "0123456789abcdef";
1299	std::string result(ModHeader::sumLen, '0');
1300	for (size_t i{ModHeader::sumLen}; hash != 0; hash >>= 4) {
1301	result[--i] = digits[hash & 0xf];
1302	}
1303	return result;
1304	}
1305
1306	std::optional<ModuleCheckSumType> ExtractCheckSum(const std::string_view &str) {
1307	if (str.size() == ModHeader::sumLen) {
1308	ModuleCheckSumType hash{0};
1309	for (size_t j{0}; j < ModHeader::sumLen; ++j) {
1310	hash <<= 4;
1311	char ch{str.at(pos: j)};
1312	if (ch >= '0' && ch <= '9') {
1313	hash += ch - '0';
1314	} else if (ch >= 'a' && ch <= 'f') {
1315	hash += ch - 'a' + 10;
1316	} else {
1317	return std::nullopt;
1318	}
1319	}
1320	return hash;
1321	}
1322	return std::nullopt;
1323	}
1324
1325	static std::optional<ModuleCheckSumType> VerifyHeader(
1326	llvm::ArrayRef<char> content) {
1327	std::string_view sv{content.data(), content.size()};
1328	if (sv.substr(pos: 0, n: ModHeader::magicLen) != ModHeader::magic) {
1329	return std::nullopt;
1330	}
1331	ModuleCheckSumType checkSum{ComputeCheckSum(sv.substr(ModHeader::len))};
1332	std::string_view expectSum{sv.substr(pos: ModHeader::magicLen, n: ModHeader::sumLen)};
1333	if (auto extracted{ExtractCheckSum(expectSum)};
1334	extracted && *extracted == checkSum) {
1335	return checkSum;
1336	} else {
1337	return std::nullopt;
1338	}
1339	}
1340
1341	static void GetModuleDependences(
1342	ModuleDependences &dependences, llvm::ArrayRef<char> content) {
1343	std::size_t limit{content.size()};
1344	std::string_view str{content.data(), limit};
1345	for (std::size_t j{ModHeader::len};
1346	str.substr(pos: j, n: ModHeader::needLen) == ModHeader::need; ++j) {
1347	j += 7;
1348	auto checkSum{ExtractCheckSum(str.substr(j, ModHeader::sumLen))};
1349	if (!checkSum) {
1350	break;
1351	}
1352	j += ModHeader::sumLen;
1353	bool intrinsic{false};
1354	if (str.substr(pos: j, n: 3) == " i ") {
1355	intrinsic = true;
1356	} else if (str.substr(pos: j, n: 3) != " n ") {
1357	break;
1358	}
1359	j += 3;
1360	std::size_t start{j};
1361	for (; j < limit && str.at(pos: j) != '\n'; ++j) {
1362	}
1363	if (j > start && j < limit && str.at(pos: j) == '\n') {
1364	std::string depModName{str.substr(pos: start, n: j - start)};
1365	dependences.AddDependence(std::move(depModName), intrinsic, *checkSum);
1366	} else {
1367	break;
1368	}
1369	}
1370	}
1371
1372	Scope *ModFileReader::Read(SourceName name, std::optional<bool> isIntrinsic,
1373	Scope *ancestor, bool silent) {
1374	std::string ancestorName; // empty for module
1375	const Symbol *notAModule{nullptr};
1376	bool fatalError{false};
1377	if (ancestor) {
1378	if (auto *scope{ancestor->FindSubmodule(name)}) {
1379	return scope;
1380	}
1381	ancestorName = ancestor->GetName().value().ToString();
1382	}
1383	auto requiredHash{context_.moduleDependences().GetRequiredHash(
1384	name.ToString(), isIntrinsic.value_or(u: false))};
1385	if (!isIntrinsic.value_or(u: false) && !ancestor) {
1386	// Already present in the symbol table as a usable non-intrinsic module?
1387	if (Scope * hermeticScope{context_.currentHermeticModuleFileScope()}) {
1388	auto it{hermeticScope->find(name)};
1389	if (it != hermeticScope->end()) {
1390	return it->second->scope();
1391	}
1392	}
1393	auto it{context_.globalScope().find(name)};
1394	if (it != context_.globalScope().end()) {
1395	Scope *scope{it->second->scope()};
1396	if (scope->kind() == Scope::Kind::Module) {
1397	for (const Symbol *found{scope->symbol()}; found;) {
1398	if (const auto *module{found->detailsIf<ModuleDetails>()}) {
1399	if (!requiredHash ||
1400	*requiredHash ==
1401	module->moduleFileHash().value_or(*requiredHash)) {
1402	return const_cast<Scope *>(found->scope());
1403	}
1404	found = module->previous(); // same name, distinct hash
1405	} else {
1406	notAModule = found;
1407	break;
1408	}
1409	}
1410	} else {
1411	notAModule = scope->symbol();
1412	}
1413	}
1414	}
1415	if (notAModule) {
1416	// USE, NON_INTRINSIC global name isn't a module?
1417	fatalError = isIntrinsic.has_value();
1418	}
1419	std::string path{
1420	ModFileName(name, ancestorName, context_.moduleFileSuffix())};
1421	parser::Parsing parsing{context_.allCookedSources()};
1422	parser::Options options;
1423	options.isModuleFile = true;
1424	options.features.Enable(common::LanguageFeature::BackslashEscapes);
1425	if (context_.languageFeatures().IsEnabled(common::LanguageFeature::OpenACC)) {
1426	options.features.Enable(common::LanguageFeature::OpenACC);
1427	}
1428	options.features.Enable(common::LanguageFeature::OpenMP);
1429	options.features.Enable(common::LanguageFeature::CUDA);
1430	if (!isIntrinsic.value_or(u: false) && !notAModule) {
1431	// The search for this module file will scan non-intrinsic module
1432	// directories. If a directory is in both the intrinsic and non-intrinsic
1433	// directory lists, the intrinsic module directory takes precedence.
1434	options.searchDirectories = context_.searchDirectories();
1435	for (const auto &dir : context_.intrinsicModuleDirectories()) {
1436	options.searchDirectories.erase(
1437	std::remove(options.searchDirectories.begin(),
1438	options.searchDirectories.end(), dir),
1439	options.searchDirectories.end());
1440	}
1441	options.searchDirectories.insert(options.searchDirectories.begin(), "."s);
1442	}
1443	bool foundNonIntrinsicModuleFile{false};
1444	if (!isIntrinsic) {
1445	std::list<std::string> searchDirs;
1446	for (const auto &d : options.searchDirectories) {
1447	searchDirs.push_back(d);
1448	}
1449	foundNonIntrinsicModuleFile =
1450	parser::LocateSourceFile(path, searchDirs).has_value();
1451	}
1452	if (isIntrinsic.value_or(u: !foundNonIntrinsicModuleFile)) {
1453	// Explicitly intrinsic, or not specified and not found in the search
1454	// path; see whether it's already in the symbol table as an intrinsic
1455	// module.
1456	auto it{context_.intrinsicModulesScope().find(name)};
1457	if (it != context_.intrinsicModulesScope().end()) {
1458	return it->second->scope();
1459	}
1460	}
1461	// We don't have this module in the symbol table yet.
1462	// Find its module file and parse it. Define or extend the search
1463	// path with intrinsic module directories, if appropriate.
1464	if (isIntrinsic.value_or(u: true)) {
1465	for (const auto &dir : context_.intrinsicModuleDirectories()) {
1466	options.searchDirectories.push_back(dir);
1467	}
1468	if (!requiredHash) {
1469	requiredHash =
1470	context_.moduleDependences().GetRequiredHash(name.ToString(), true);
1471	}
1472	}
1473
1474	// Look for the right module file if its hash is known
1475	if (requiredHash && !fatalError) {
1476	for (const std::string &maybe :
1477	parser::LocateSourceFileAll(path, options.searchDirectories)) {
1478	if (const auto *srcFile{context_.allCookedSources().allSources().OpenPath(
1479	maybe, llvm::errs())}) {
1480	if (auto checkSum{VerifyHeader(srcFile->content())};
1481	checkSum && *checkSum == *requiredHash) {
1482	path = maybe;
1483	break;
1484	}
1485	}
1486	}
1487	}
1488	const auto *sourceFile{fatalError ? nullptr : parsing.Prescan(path, options)};
1489	if (fatalError || parsing.messages().AnyFatalError()) {
1490	if (!silent) {
1491	if (notAModule) {
1492	// Module is not explicitly INTRINSIC, and there's already a global
1493	// symbol of the same name that is not a module.
1494	context_.SayWithDecl(
1495	*notAModule, name, "'%s' is not a module"_err_en_US, name);
1496	} else {
1497	for (auto &msg : parsing.messages().messages()) {
1498	std::string str{msg.ToString()};
1499	Say("parse", name, ancestorName,
1500	parser::MessageFixedText{str.c_str(), str.size(), msg.severity()},
1501	path);
1502	}
1503	}
1504	}
1505	return nullptr;
1506	}
1507	CHECK(sourceFile);
1508	std::optional<ModuleCheckSumType> checkSum{
1509	VerifyHeader(sourceFile->content())};
1510	if (!checkSum) {
1511	Say("use", name, ancestorName, "File has invalid checksum: %s"_err_en_US,
1512	sourceFile->path());
1513	return nullptr;
1514	} else if (requiredHash && *requiredHash != *checkSum) {
1515	Say("use", name, ancestorName,
1516	"File is not the right module file for %s"_err_en_US,
1517	"'"s + name.ToString() + "': "s + sourceFile->path());
1518	return nullptr;
1519	}
1520	llvm::raw_null_ostream NullStream;
1521	parsing.Parse(NullStream);
1522	std::optional<parser::Program> &parsedProgram{parsing.parseTree()};
1523	if (!parsing.messages().empty() || !parsing.consumedWholeFile() ||
1524	!parsedProgram) {
1525	Say("parse", name, ancestorName, "Module file is corrupt: %s"_err_en_US,
1526	sourceFile->path());
1527	return nullptr;
1528	}
1529	parser::Program &parseTree{context_.SaveParseTree(std::move(*parsedProgram))};
1530	Scope *parentScope; // the scope this module/submodule goes into
1531	if (!isIntrinsic.has_value()) {
1532	for (const auto &dir : context_.intrinsicModuleDirectories()) {
1533	if (sourceFile->path().size() > dir.size() &&
1534	sourceFile->path().find(dir) == 0) {
1535	isIntrinsic = true;
1536	break;
1537	}
1538	}
1539	}
1540	Scope &topScope{isIntrinsic.value_or(u: false) ? context_.intrinsicModulesScope()
1541	: context_.globalScope()};
1542	Symbol *moduleSymbol{nullptr};
1543	const Symbol *previousModuleSymbol{nullptr};
1544	if (!ancestor) { // module, not submodule
1545	parentScope = &topScope;
1546	auto pair{parentScope->try_emplace(name, UnknownDetails{})};
1547	if (!pair.second) {
1548	// There is already a global symbol or intrinsic module of the same name.
1549	previousModuleSymbol = &*pair.first->second;
1550	if (const auto *details{
1551	previousModuleSymbol->detailsIf<ModuleDetails>()}) {
1552	if (!details->moduleFileHash().has_value()) {
1553	return nullptr;
1554	}
1555	} else {
1556	return nullptr;
1557	}
1558	CHECK(parentScope->erase(name) != 0);
1559	pair = parentScope->try_emplace(name, UnknownDetails{});
1560	CHECK(pair.second);
1561	}
1562	moduleSymbol = &*pair.first->second;
1563	moduleSymbol->set(Symbol::Flag::ModFile);
1564	} else if (std::optional<SourceName> parent{GetSubmoduleParent(parseTree)}) {
1565	// submodule with submodule parent
1566	parentScope = Read(*parent, false /*not intrinsic*/, ancestor, silent);
1567	} else {
1568	// submodule with module parent
1569	parentScope = ancestor;
1570	}
1571	// Process declarations from the module file
1572	auto wasModuleFileName{context_.foldingContext().moduleFileName()};
1573	context_.foldingContext().set_moduleFileName(name);
1574	// Are there multiple modules in the module file due to it having been
1575	// created under -fhermetic-module-files? If so, process them first in
1576	// their own nested scope that will be visible only to USE statements
1577	// within the module file.
1578	Scope *previousHermetic{context_.currentHermeticModuleFileScope()};
1579	if (parseTree.v.size() > 1) {
1580	parser::Program hermeticModules{std::move(parseTree.v)};
1581	parseTree.v.emplace_back(std::move(hermeticModules.v.front()));
1582	hermeticModules.v.pop_front();
1583	Scope &hermeticScope{topScope.MakeScope(Scope::Kind::Global)};
1584	context_.set_currentHermeticModuleFileScope(&hermeticScope);
1585	ResolveNames(context_, hermeticModules, hermeticScope);
1586	for (auto &[_, ref] : hermeticScope) {
1587	CHECK(ref->has<ModuleDetails>());
1588	ref->set(Symbol::Flag::ModFile);
1589	}
1590	}
1591	GetModuleDependences(context_.moduleDependences(), sourceFile->content());
1592	ResolveNames(context_, parseTree, top&: topScope);
1593	context_.foldingContext().set_moduleFileName(wasModuleFileName);
1594	context_.set_currentHermeticModuleFileScope(previousHermetic);
1595	if (!moduleSymbol) {
1596	// Submodule symbols' storage are owned by their parents' scopes,
1597	// but their names are not in their parents' dictionaries -- we
1598	// don't want to report bogus errors about clashes between submodule
1599	// names and other objects in the parent scopes.
1600	if (Scope * submoduleScope{ancestor->FindSubmodule(name)}) {
1601	moduleSymbol = submoduleScope->symbol();
1602	if (moduleSymbol) {
1603	moduleSymbol->set(Symbol::Flag::ModFile);
1604	}
1605	}
1606	}
1607	if (moduleSymbol) {
1608	CHECK(moduleSymbol->test(Symbol::Flag::ModFile));
1609	auto &details{moduleSymbol->get<ModuleDetails>()};
1610	details.set_moduleFileHash(checkSum.value());
1611	details.set_previous(previousModuleSymbol);
1612	if (isIntrinsic.value_or(u: false)) {
1613	moduleSymbol->attrs().set(Attr::INTRINSIC);
1614	}
1615	return moduleSymbol->scope();
1616	} else {
1617	return nullptr;
1618	}
1619	}
1620
1621	parser::Message &ModFileReader::Say(const char *verb, SourceName name,
1622	const std::string &ancestor, parser::MessageFixedText &&msg,
1623	const std::string &arg) {
1624	return context_.Say(name, "Cannot %s module file for %s: %s"_err_en_US, verb,
1625	parser::MessageFormattedText{ancestor.empty()
1626	? "module '%s'"_en_US
1627	: "submodule '%s' of module '%s'"_en_US,
1628	name, ancestor}
1629	.MoveString(),
1630	parser::MessageFormattedText{std::move(msg), arg}.MoveString());
1631	}
1632
1633	// program was read from a .mod file for a submodule; return the name of the
1634	// submodule's parent submodule, nullptr if none.
1635	static std::optional<SourceName> GetSubmoduleParent(
1636	const parser::Program &program) {
1637	CHECK(program.v.size() == 1);
1638	auto &unit{program.v.front()};
1639	auto &submod{std::get<common::Indirection<parser::Submodule>>(unit.u)};
1640	auto &stmt{
1641	std::get<parser::Statement<parser::SubmoduleStmt>>(submod.value().t)};
1642	auto &parentId{std::get<parser::ParentIdentifier>(stmt.statement.t)};
1643	if (auto &parent{std::get<std::optional<parser::Name>>(parentId.t)}) {
1644	return parent->source;
1645	} else {
1646	return std::nullopt;
1647	}
1648	}
1649
1650	void SubprogramSymbolCollector::Collect() {
1651	const auto &details{symbol_.get<SubprogramDetails>()};
1652	isInterface_ = details.isInterface();
1653	for (const Symbol *dummyArg : details.dummyArgs()) {
1654	if (dummyArg) {
1655	DoSymbol(*dummyArg);
1656	}
1657	}
1658	if (details.isFunction()) {
1659	DoSymbol(details.result());
1660	}
1661	for (const auto &pair : scope_) {
1662	const Symbol &symbol{*pair.second};
1663	if (const auto *useDetails{symbol.detailsIf<UseDetails>()}) {
1664	const Symbol &ultimate{useDetails->symbol().GetUltimate()};
1665	bool needed{useSet_.count(ultimate) > 0};
1666	if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
1667	// The generic may not be needed itself, but the specific procedure
1668	// &/or derived type that it shadows may be needed.
1669	const Symbol *spec{generic->specific()};
1670	const Symbol *dt{generic->derivedType()};
1671	needed = needed || (spec && useSet_.count(spec->GetUltimate()) > 0) ||
1672	(dt && useSet_.count(dt->GetUltimate()) > 0);
1673	} else if (const auto *subp{ultimate.detailsIf<SubprogramDetails>()}) {
1674	const Symbol *interface { subp->moduleInterface() };
1675	needed = needed || (interface && useSet_.count(*interface) > 0);
1676	}
1677	if (needed) {
1678	need_.push_back(symbol);
1679	}
1680	} else if (symbol.has<SubprogramDetails>()) {
1681	// An internal subprogram is needed if it is used as interface
1682	// for a dummy or return value procedure.
1683	bool needed{false};
1684	const auto hasInterface{[&symbol](const Symbol *s) -> bool {
1685	// Is 's' a procedure with interface 'symbol'?
1686	if (s) {
1687	if (const auto *sDetails{s->detailsIf<ProcEntityDetails>()}) {
1688	if (sDetails->procInterface() == &symbol) {
1689	return true;
1690	}
1691	}
1692	}
1693	return false;
1694	}};
1695	for (const Symbol *dummyArg : details.dummyArgs()) {
1696	needed = needed || hasInterface(dummyArg);
1697	}
1698	needed =
1699	needed || (details.isFunction() && hasInterface(&details.result()));
1700	if (needed && needSet_.insert(symbol).second) {
1701	need_.push_back(symbol);
1702	}
1703	}
1704	}
1705	}
1706
1707	void SubprogramSymbolCollector::DoSymbol(const Symbol &symbol) {
1708	DoSymbol(symbol.name(), symbol);
1709	}
1710
1711	// Do symbols this one depends on; then add to need_
1712	void SubprogramSymbolCollector::DoSymbol(
1713	const SourceName &name, const Symbol &symbol) {
1714	const auto &scope{symbol.owner()};
1715	if (scope != scope_ && !scope.IsDerivedType()) {
1716	if (scope != scope_.parent()) {
1717	useSet_.insert(symbol);
1718	}
1719	if (NeedImport(name, symbol)) {
1720	imports_.insert(x: name);
1721	}
1722	return;
1723	}
1724	if (!needSet_.insert(symbol).second) {
1725	return; // already done
1726	}
1727	common::visit(common::visitors{
1728	[this](const ObjectEntityDetails &details) {
1729	for (const ShapeSpec &spec : details.shape()) {
1730	DoBound(spec.lbound());
1731	DoBound(spec.ubound());
1732	}
1733	for (const ShapeSpec &spec : details.coshape()) {
1734	DoBound(spec.lbound());
1735	DoBound(spec.ubound());
1736	}
1737	if (const Symbol * commonBlock{details.commonBlock()}) {
1738	DoSymbol(*commonBlock);
1739	}
1740	},
1741	[this](const CommonBlockDetails &details) {
1742	for (const auto &object : details.objects()) {
1743	DoSymbol(*object);
1744	}
1745	},
1746	[this](const ProcEntityDetails &details) {
1747	if (details.rawProcInterface()) {
1748	DoSymbol(*details.rawProcInterface());
1749	} else {
1750	DoType(details.type());
1751	}
1752	},
1753	[this](const ProcBindingDetails &details) {
1754	DoSymbol(details.symbol());
1755	},
1756	[](const auto &) {},
1757	},
1758	symbol.details());
1759	if (!symbol.has<UseDetails>()) {
1760	DoType(symbol.GetType());
1761	}
1762	if (!scope.IsDerivedType()) {
1763	need_.push_back(symbol);
1764	}
1765	if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointer)) {
1766	for (const auto &[pointee, pointer] : symbol.owner().crayPointers()) {
1767	if (&*pointer == &symbol) {
1768	auto iter{symbol.owner().find(pointee)};
1769	CHECK(iter != symbol.owner().end());
1770	DoSymbol(*iter->second);
1771	}
1772	}
1773	} else if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
1774	DoSymbol(GetCrayPointer(symbol));
1775	}
1776	}
1777
1778	void SubprogramSymbolCollector::DoType(const DeclTypeSpec *type) {
1779	if (!type) {
1780	return;
1781	}
1782	switch (type->category()) {
1783	case DeclTypeSpec::Numeric:
1784	case DeclTypeSpec::Logical:
1785	break; // nothing to do
1786	case DeclTypeSpec::Character:
1787	DoParamValue(type->characterTypeSpec().length());
1788	break;
1789	default:
1790	if (const DerivedTypeSpec * derived{type->AsDerived()}) {
1791	const auto &typeSymbol{derived->typeSymbol()};
1792	for (const auto &pair : derived->parameters()) {
1793	DoParamValue(pair.second);
1794	}
1795	// The components of the type (including its parent component, if
1796	// any) matter to IMPORT symbol collection only for derived types
1797	// defined in the subprogram.
1798	if (typeSymbol.owner() == scope_) {
1799	if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
1800	DoSymbol(extends->name(), extends->typeSymbol());
1801	}
1802	for (const auto &pair : *typeSymbol.scope()) {
1803	DoSymbol(*pair.second);
1804	}
1805	}
1806	DoSymbol(derived->name(), typeSymbol);
1807	}
1808	}
1809	}
1810
1811	void SubprogramSymbolCollector::DoBound(const Bound &bound) {
1812	if (const MaybeSubscriptIntExpr & expr{bound.GetExplicit()}) {
1813	DoExpr(*expr);
1814	}
1815	}
1816	void SubprogramSymbolCollector::DoParamValue(const ParamValue &paramValue) {
1817	if (const auto &expr{paramValue.GetExplicit()}) {
1818	DoExpr(*expr);
1819	}
1820	}
1821
1822	// Do we need a IMPORT of this symbol into an interface block?
1823	bool SubprogramSymbolCollector::NeedImport(
1824	const SourceName &name, const Symbol &symbol) {
1825	if (!isInterface_) {
1826	return false;
1827	} else if (IsSeparateModuleProcedureInterface(&symbol_)) {
1828	return false; // IMPORT needed only for external and dummy procedure
1829	// interfaces
1830	} else if (&symbol == scope_.symbol()) {
1831	return false;
1832	} else if (symbol.owner().Contains(scope_)) {
1833	return true;
1834	} else if (const Symbol *found{scope_.FindSymbol(name)}) {
1835	// detect import from ancestor of use-associated symbol
1836	return found->has<UseDetails>() && found->owner() != scope_;
1837	} else {
1838	// "found" can be null in the case of a use-associated derived type's
1839	// parent type, and also in the case of an object (like a dummy argument)
1840	// used to define a length or bound of a nested interface.
1841	return false;
1842	}
1843	}
1844
1845	} // namespace Fortran::semantics
1846