[flang] Don't emit needless symbols to hermetic module files

flang/include/flang/Semantics/symbol-set-closure.h

@@ -0,0 +1,34 @@
+//===-- include/flang/Semantics/symbol-set-closure.h ------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_SYMBOLS_SET_CLOSURE_H_
+#define FORTRAN_SEMANTICS_SYMBOLS_SET_CLOSURE_H_
+
+#include "flang/Semantics/symbol.h"
+
+namespace Fortran::semantics {
+
+// For a set or scope of symbols, computes the transitive closure of their
+// dependences due to their types, bounds, specific procedures, interfaces,
+// initialization, storage association, &c. Includes the original symbol
+// or members of the original set.  Does not include dependences from
+// subprogram definitions, only their interfaces.
+enum DependenceCollectionFlags {
+  NoDependenceCollectionFlags = 0,
+  IncludeOriginalSymbols = 1 << 0,
+  FollowUseAssociations = 1 << 1,
+  IncludeSpecificsOfGenerics = 1 << 2,
+  IncludeComponentsInExprs = 1 << 3,
+};
+UnorderedSymbolSet CollectAllDependences(
+    const UnorderedSymbolSet &, int = NoDependenceCollectionFlags);
+UnorderedSymbolSet CollectAllDependences(
+    const Scope &, int = NoDependenceCollectionFlags);
+
+} // namespace Fortran::semantics
+#endif // FORTRAN_SEMANTICS_SYMBOLS_SET_CLOSURE_H_

flang/lib/Semantics/CMakeLists.txt

@@ -46,6 +46,7 @@ add_flang_library(FortranSemantics
   scope.cpp
   semantics.cpp
   symbol.cpp
+  symbol-set-closure.cpp
   tools.cpp
   type.cpp
   unparse-with-symbols.cpp

flang/lib/Semantics/mod-file.cpp

@@ -15,6 +15,7 @@
 #include "flang/Parser/unparse.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/semantics.h"
+#include "flang/Semantics/symbol-set-closure.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/Support/FileSystem.h"
@@ -47,8 +48,8 @@ struct ModHeader {
 };
 
 static std::optional<SourceName> GetSubmoduleParent(const parser::Program &);
-static void CollectSymbols(
-    const Scope &, SymbolVector &, SymbolVector &, SourceOrderedSymbolSet &);
+static void CollectSymbols(const Scope &, SymbolVector &, SymbolVector &,
+    SourceOrderedSymbolSet &, UnorderedSymbolSet *);
 static void PutPassName(llvm::raw_ostream &, const std::optional<SourceName> &);
 static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &,
     const parser::Expr *, SemanticsContext &);
@@ -130,7 +131,7 @@ static std::string ModFileName(const SourceName &name,
   return ancestorName.empty() ? result : ancestorName + '-' + result;
 }
 
-// Write the module file for symbol, which must be a module or submodule.
+// Writes the module file for symbol, which must be a module or submodule.
 void ModFileWriter::Write(const Symbol &symbol) {
   const auto &module{symbol.get<ModuleDetails>()};
   if (symbol.test(Symbol::Flag::ModFile) || module.moduleFileHash()) {
@@ -142,21 +143,30 @@ void ModFileWriter::Write(const Symbol &symbol) {
   std::string path{context_.moduleDirectory() + '/' +
       ModFileName(symbol.name(), ancestorName, context_.moduleFileSuffix())};
 
-  std::set<std::string> hermeticModuleNames;
-  hermeticModuleNames.insert(symbol.name().ToString());
   UnorderedSymbolSet additionalModules;
+  UnorderedSymbolSet dependenceClosure;
+  if (hermeticModuleFileOutput_) {
+    dependenceClosure = CollectAllDependences(
+        DEREF(symbol.scope()), IncludeOriginalSymbols | FollowUseAssociations);
+  }
   PutSymbols(DEREF(symbol.scope()),
-      hermeticModuleFileOutput_ ? &additionalModules : nullptr);
+      hermeticModuleFileOutput_ ? &additionalModules : nullptr,
+      hermeticModuleFileOutput_ ? &dependenceClosure : nullptr);
+  std::set<std::string> emittedModuleNames;
+  emittedModuleNames.insert(symbol.name().ToString());
   auto asStr{GetAsString(symbol)};
+
+  // Emit additional modules for a hermetic module file
   while (!additionalModules.empty()) {
     UnorderedSymbolSet nextPass{std::move(additionalModules)};
     additionalModules.clear();
     for (const Symbol &modSym : nextPass) {
       if (!modSym.owner().IsIntrinsicModules() &&
-          hermeticModuleNames.find(modSym.name().ToString()) ==
-              hermeticModuleNames.end()) {
-        hermeticModuleNames.insert(modSym.name().ToString());
-        PutSymbols(DEREF(modSym.scope()), &additionalModules);
+          emittedModuleNames.find(modSym.name().ToString()) ==
+              emittedModuleNames.end()) {
+        emittedModuleNames.insert(modSym.name().ToString());
+        PutSymbols(
+            DEREF(modSym.scope()), &additionalModules, &dependenceClosure);
         asStr += GetAsString(modSym);
       }
     }
@@ -177,7 +187,8 @@ void ModFileWriter::WriteClosure(llvm::raw_ostream &out, const Symbol &symbol,
       !nonIntrinsicModulesWritten.insert(symbol).second) {
     return;
   }
-  PutSymbols(DEREF(symbol.scope()), /*hermeticModules=*/nullptr);
+  PutSymbols(DEREF(symbol.scope()), /*hermeticModules=*/nullptr,
+      /*dependenceClosure=*/nullptr);
   needsBuf_.clear(); // omit module checksums
   auto str{GetAsString(symbol)};
   for (auto depRef : std::move(usedNonIntrinsicModules_)) {
@@ -223,78 +234,18 @@ std::string ModFileWriter::GetAsString(const Symbol &symbol) {
 // Collect symbols from constant and specification expressions that are being
 // referenced directly from other modules; they may require new USE
 // associations.
-static void HarvestSymbolsNeededFromOtherModules(
-    SourceOrderedSymbolSet &, const Scope &);
-static void HarvestSymbolsNeededFromOtherModules(
-    SourceOrderedSymbolSet &set, const Symbol &symbol, const Scope &scope) {
-  auto HarvestBound{[&](const Bound &bound) {
-    if (const auto &expr{bound.GetExplicit()}) {
-      for (SymbolRef ref : evaluate::CollectSymbols(*expr)) {
-        set.emplace(*ref);
-      }
-    }
-  }};
-  auto HarvestShapeSpec{[&](const ShapeSpec &shapeSpec) {
-    HarvestBound(shapeSpec.lbound());
-    HarvestBound(shapeSpec.ubound());
-  }};
-  auto HarvestArraySpec{[&](const ArraySpec &arraySpec) {
-    for (const auto &shapeSpec : arraySpec) {
-      HarvestShapeSpec(shapeSpec);
-    }
-  }};
-
-  if (symbol.has<DerivedTypeDetails>()) {
-    if (symbol.scope()) {
-      HarvestSymbolsNeededFromOtherModules(set, *symbol.scope());
-    }
-  } else if (const auto &generic{symbol.detailsIf<GenericDetails>()};
-             generic && generic->derivedType()) {
-    const Symbol &dtSym{*generic->derivedType()};
-    if (dtSym.has<DerivedTypeDetails>()) {
-      if (dtSym.scope()) {
-        HarvestSymbolsNeededFromOtherModules(set, *dtSym.scope());
-      }
-    } else {
-      CHECK(dtSym.has<UseDetails>() || dtSym.has<UseErrorDetails>());
-    }
-  } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
-    HarvestArraySpec(object->shape());
-    HarvestArraySpec(object->coshape());
-    if (IsNamedConstant(symbol) || scope.IsDerivedType()) {
-      if (object->init()) {
-        for (SymbolRef ref : evaluate::CollectSymbols(*object->init())) {
-          set.emplace(*ref);
-        }
-      }
-    }
-  } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
-    if (proc->init() && *proc->init() && scope.IsDerivedType()) {
-      set.emplace(**proc->init());
-    }
-  } else if (const auto *subp{symbol.detailsIf<SubprogramDetails>()}) {
-    for (const Symbol *dummy : subp->dummyArgs()) {
-      if (dummy) {
-        HarvestSymbolsNeededFromOtherModules(set, *dummy, scope);
-      }
-    }
-    if (subp->isFunction()) {
-      HarvestSymbolsNeededFromOtherModules(set, subp->result(), scope);
-    }
-  }
-}
-
 static void HarvestSymbolsNeededFromOtherModules(
     SourceOrderedSymbolSet &set, const Scope &scope) {
-  for (const auto &[_, symbol] : scope) {
-    HarvestSymbolsNeededFromOtherModules(set, *symbol, scope);
+  for (const Symbol &symbol : CollectAllDependences(scope)) {
+    set.insert(symbol);
   }
 }
 
-void ModFileWriter::PrepareRenamings(const Scope &scope) {
+void ModFileWriter::PrepareRenamings(
+    const Scope &scope, const UnorderedSymbolSet *dependenceClosure) {
   // Identify use-associated symbols already in scope under some name
   std::map<const Symbol *, const Symbol *> useMap;
-  for (const auto &[name, symbolRef] : scope) {
+  for (const auto &[_, symbolRef] : scope) {
     const Symbol *symbol{&*symbolRef};
     while (const auto *hostAssoc{symbol->detailsIf<HostAssocDetails>()}) {
       symbol = &hostAssoc->symbol();
@@ -309,38 +260,42 @@ void ModFileWriter::PrepareRenamings(const Scope &scope) {
   // Establish any necessary renamings of symbols in other modules
   // to their names in this scope, creating those new names when needed.
   auto &renamings{context_.moduleFileOutputRenamings()};
-  for (SymbolRef s : symbolsNeeded) {
-    if (s->owner().kind() != Scope::Kind::Module) {
+  for (const Symbol &sym : symbolsNeeded) {
+    if (sym.owner().kind() != Scope::Kind::Module) {
       // Not a USE'able name from a module's top scope;
       // component, binding, dummy argument, &c.
       continue;
     }
-    const Scope *sMod{FindModuleContaining(s->owner())};
+    const Scope *sMod{FindModuleContaining(sym.owner())};
     if (!sMod || sMod == &scope) {
       continue;
     }
-    if (auto iter{useMap.find(&*s)}; iter != useMap.end()) {
-      renamings.emplace(&*s, iter->second->name());
+    if (dependenceClosure &&
+        dependenceClosure->find(sym) == dependenceClosure->end()) {
       continue;
     }
-    SourceName rename{s->name()};
-    if (const Symbol * found{scope.FindSymbol(s->name())}) {
-      if (found == &*s) {
+    if (auto iter{useMap.find(&sym)}; iter != useMap.end()) {
+      renamings.emplace(&sym, iter->second->name());
+      continue;
+    }
+    SourceName rename{sym.name()};
+    if (const Symbol *found{scope.FindSymbol(sym.name())}) {
+      if (found == &sym) {
         continue; // available in scope
       }
       if (const auto *generic{found->detailsIf<GenericDetails>()}) {
-        if (generic->derivedType() == &*s || generic->specific() == &*s) {
+        if (generic->derivedType() == &sym || generic->specific() == &sym) {
           continue;
         }
       } else if (found->has<UseDetails>()) {
-        if (&found->GetUltimate() == &*s) {
+        if (&found->GetUltimate() == &sym) {
           continue; // already use-associated with same name
         }
       }
-      if (&s->owner() != &found->owner()) { // Symbol needs renaming
+      if (&sym.owner() != &found->owner()) { // Symbol needs renaming
         rename = scope.context().SaveTempName(
             DEREF(sMod->symbol()).name().ToString() + "$" +
-            s->name().ToString());
+            sym.name().ToString());
       }
     }
     // Symbol is used in this scope but not visible under its name
@@ -350,26 +305,27 @@ void ModFileWriter::PrepareRenamings(const Scope &scope) {
       uses_ << "use ";
     }
     uses_ << DEREF(sMod->symbol()).name() << ",only:";
-    if (rename != s->name()) {
+    if (rename != sym.name()) {
       uses_ << rename << "=>";
-      renamings.emplace(&s->GetUltimate(), rename);
+      renamings.emplace(&sym.GetUltimate(), rename);
     }
-    uses_ << s->name() << '\n';
+    uses_ << sym.name() << '\n';
     useExtraAttrs_ << "private::" << rename << '\n';
   }
 }
 
 // Put out the visible symbols from scope.
-void ModFileWriter::PutSymbols(
-    const Scope &scope, UnorderedSymbolSet *hermeticModules) {
+void ModFileWriter::PutSymbols(const Scope &scope,
+    UnorderedSymbolSet *hermeticModules,
+    UnorderedSymbolSet *dependenceClosure) {
   SymbolVector sorted;
   SymbolVector uses;
   auto &renamings{context_.moduleFileOutputRenamings()};
   auto previousRenamings{std::move(renamings)};
-  PrepareRenamings(scope);
+  PrepareRenamings(scope, dependenceClosure);
   SourceOrderedSymbolSet modules;
-  CollectSymbols(scope, sorted, uses, modules);
-  // Write module files for dependencies first so that their
+  CollectSymbols(scope, sorted, uses, modules, dependenceClosure);
+  // Write module files for dependences first so that their
   // hashes are known.
   for (const Symbol &mod : modules) {
     if (hermeticModules) {
@@ -852,12 +808,17 @@ void ModFileWriter::PutUseExtraAttr(
 // Collect the symbols of this scope sorted by their original order, not name.
 // Generics and namelists are exceptions: they are sorted after other symbols.
 void CollectSymbols(const Scope &scope, SymbolVector &sorted,
-    SymbolVector &uses, SourceOrderedSymbolSet &modules) {
+    SymbolVector &uses, SourceOrderedSymbolSet &modules,
+    UnorderedSymbolSet *dependenceClosure) {
   SymbolVector namelist, generics;
   auto symbols{scope.GetSymbols()};
   std::size_t commonSize{scope.commonBlocks().size()};
   sorted.reserve(symbols.size() + commonSize);
   for (const Symbol &symbol : symbols) {
+    if (dependenceClosure &&
+        dependenceClosure->find(symbol) == dependenceClosure->end()) {
+      continue; // needless for the main module
+    }
     const auto *generic{symbol.detailsIf<GenericDetails>()};
     if (generic) {
       uses.insert(uses.end(), generic->uses().begin(), generic->uses().end());

flang/lib/Semantics/mod-file.h

@@ -67,8 +67,9 @@ class ModFileWriter {
   void WriteOne(const Scope &);
   void Write(const Symbol &);
   std::string GetAsString(const Symbol &);
-  void PrepareRenamings(const Scope &);
-  void PutSymbols(const Scope &, UnorderedSymbolSet *hermetic);
+  void PrepareRenamings(const Scope &, const UnorderedSymbolSet *);
+  void PutSymbols(const Scope &, UnorderedSymbolSet *hermetic,
+      UnorderedSymbolSet *dependenceClosure);
   // Returns true if a derived type with bindings and "contains" was emitted
   bool PutComponents(const Symbol &);
   void PutSymbol(llvm::raw_ostream &, const Symbol &);

flang/lib/Semantics/resolve-names.cpp

@@ -7416,7 +7416,8 @@ void DeclarationVisitor::SetType(
 std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
     const parser::Name &name) {
   Scope &outer{NonDerivedTypeScope()};
-  Symbol *symbol{FindSymbol(outer, name)};
+  Symbol *original{FindSymbol(outer, name)};
+  Symbol *symbol{original};
   Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr};
   auto *generic{ultimate ? ultimate->detailsIf<GenericDetails>() : nullptr};
   if (generic) {
@@ -7429,11 +7430,12 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
       (generic && &ultimate->owner() == &outer)) {
     if (allowForwardReferenceToDerivedType()) {
       if (!symbol) {
-        symbol = &MakeSymbol(outer, name.source, Attrs{});
+        symbol = original = &MakeSymbol(outer, name.source, Attrs{});
         Resolve(name, *symbol);
       } else if (generic) {
         // forward ref to type with later homonymous generic
-        symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{});
+        symbol = original =
+            &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{});
         generic->set_derivedType(*symbol);
         name.symbol = symbol;
       }
@@ -7453,7 +7455,7 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
   if (CheckUseError(name)) {
     return std::nullopt;
   } else if (symbol->GetUltimate().has<DerivedTypeDetails>()) {
-    return DerivedTypeSpec{name.source, *symbol};
+    return DerivedTypeSpec{name.source, *original};
   } else {
     Say(name, "'%s' is not a derived type"_err_en_US);
     return std::nullopt;