[flang] New -fdebug-unparse-with-modules option

clang/include/clang/Driver/Options.td

@@ -6644,7 +6644,9 @@ def fdebug_unparse : Flag<["-"], "fdebug-unparse">, Group<Action_Group>,
   DocBrief<[{Run the parser and the semantic checks. Then unparse the
 parse-tree and output the generated Fortran source file.}]>;
 def fdebug_unparse_with_symbols : Flag<["-"], "fdebug-unparse-with-symbols">, Group<Action_Group>,
-  HelpText<"Unparse and stop.">;
+  HelpText<"Unparse with symbols and stop.">;
+def fdebug_unparse_with_modules : Flag<["-"], "fdebug-unparse-with-modules">, Group<Action_Group>,
+  HelpText<"Unparse with dependent modules and stop.">;
 def fdebug_dump_symbols : Flag<["-"], "fdebug-dump-symbols">, Group<Action_Group>,
   HelpText<"Dump symbols after the semantic analysis">;
 def fdebug_dump_parse_tree : Flag<["-"], "fdebug-dump-parse-tree">, Group<Action_Group>,

flang/include/flang/Frontend/FrontendActions.h

@@ -108,6 +108,10 @@ class DebugUnparseWithSymbolsAction : public PrescanAndSemaAction {
   void executeAction() override;
 };
 
+class DebugUnparseWithModulesAction : public PrescanAndSemaAction {
+  void executeAction() override;
+};
+
 class DebugUnparseAction : public PrescanAndSemaAction {
   void executeAction() override;
 };

flang/include/flang/Frontend/FrontendOptions.h

@@ -63,6 +63,10 @@ enum ActionKind {
   /// Fortran source file
   DebugUnparseWithSymbols,
 
+  /// Parse, run semantics, and output a Fortran source file preceded
+  /// by all the necessary modules (transitively)
+  DebugUnparseWithModules,
+
   /// Parse, run semantics and then output symbols from semantics
   DebugDumpSymbols,
 

flang/include/flang/Semantics/unparse-with-symbols.h

@@ -21,8 +21,12 @@ struct Program;
 }
 
 namespace Fortran::semantics {
+class SemanticsContext;
 void UnparseWithSymbols(llvm::raw_ostream &, const parser::Program &,
     parser::Encoding encoding = parser::Encoding::UTF_8);
+void UnparseWithModules(llvm::raw_ostream &, SemanticsContext &,
+    const parser::Program &,
+    parser::Encoding encoding = parser::Encoding::UTF_8);
 }
 
 #endif // FORTRAN_SEMANTICS_UNPARSE_WITH_SYMBOLS_H_

flang/lib/Frontend/CompilerInvocation.cpp

@@ -488,6 +488,9 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args,
     case clang::driver::options::OPT_fdebug_unparse_with_symbols:
       opts.programAction = DebugUnparseWithSymbols;
       break;
+    case clang::driver::options::OPT_fdebug_unparse_with_modules:
+      opts.programAction = DebugUnparseWithModules;
+      break;
     case clang::driver::options::OPT_fdebug_dump_symbols:
       opts.programAction = DebugDumpSymbols;
       break;

flang/lib/Frontend/FrontendActions.cpp

@@ -477,6 +477,15 @@ void DebugUnparseWithSymbolsAction::executeAction() {
   reportFatalSemanticErrors();
 }
 
+void DebugUnparseWithModulesAction::executeAction() {
+  auto &parseTree{*getInstance().getParsing().parseTree()};
+  CompilerInstance &ci{getInstance()};
+  Fortran::semantics::UnparseWithModules(
+      llvm::outs(), ci.getSemantics().context(), parseTree,
+      /*encoding=*/Fortran::parser::Encoding::UTF_8);
+  reportFatalSemanticErrors();
+}
+
 void DebugDumpSymbolsAction::executeAction() {
   CompilerInstance &ci = this->getInstance();
 

flang/lib/FrontendTool/ExecuteCompilerInvocation.cpp

@@ -59,6 +59,8 @@ createFrontendAction(CompilerInstance &ci) {
     return std::make_unique<DebugUnparseNoSemaAction>();
   case DebugUnparseWithSymbols:
     return std::make_unique<DebugUnparseWithSymbolsAction>();
+  case DebugUnparseWithModules:
+    return std::make_unique<DebugUnparseWithModulesAction>();
   case DebugDumpSymbols:
     return std::make_unique<DebugDumpSymbolsAction>();
   case DebugDumpParseTree:

flang/lib/Semantics/mod-file.cpp

@@ -132,11 +132,11 @@ static std::string ModFileName(const SourceName &name,
 
 // Write the module file for symbol, which must be a module or submodule.
 void ModFileWriter::Write(const Symbol &symbol) {
-  auto &module{symbol.get<ModuleDetails>()};
+  const auto &module{symbol.get<ModuleDetails>()};
   if (module.moduleFileHash()) {
     return; // already written
   }
-  auto *ancestor{module.ancestor()};
+  const auto *ancestor{module.ancestor()};
   isSubmodule_ = ancestor != nullptr;
   auto ancestorName{ancestor ? ancestor->GetName().value().ToString() : ""s};
   auto path{context_.moduleDirectory() + '/' +
@@ -151,6 +151,21 @@ void ModFileWriter::Write(const Symbol &symbol) {
   const_cast<ModuleDetails &>(module).set_moduleFileHash(checkSum);
 }
 
+void ModFileWriter::WriteClosure(llvm::raw_ostream &out, const Symbol &symbol,
+    UnorderedSymbolSet &nonIntrinsicModulesWritten) {
+  if (!symbol.has<ModuleDetails>() || symbol.owner().IsIntrinsicModules() ||
+      !nonIntrinsicModulesWritten.insert(symbol).second) {
+    return;
+  }
+  PutSymbols(DEREF(symbol.scope()));
+  needsBuf_.clear(); // omit module checksums
+  auto str{GetAsString(symbol)};
+  for (auto depRef : std::move(usedNonIntrinsicModules_)) {
+    WriteClosure(out, *depRef, nonIntrinsicModulesWritten);
+  }
+  out << std::move(str);
+}
+
 // Return the entire body of the module file
 // and clear saved uses, decls, and contains.
 std::string ModFileWriter::GetAsString(const Symbol &symbol) {
@@ -710,6 +725,7 @@ void ModFileWriter::PutUse(const Symbol &symbol) {
     uses_ << "use,intrinsic::";
   } else {
     uses_ << "use ";
+    usedNonIntrinsicModules_.insert(module);
   }
   uses_ << module.name() << ",only:";
   PutGenericName(uses_, symbol);

flang/lib/Semantics/mod-file.h

@@ -35,6 +35,8 @@ class ModFileWriter {
 public:
   explicit ModFileWriter(SemanticsContext &context) : context_{context} {}
   bool WriteAll();
+  void WriteClosure(llvm::raw_ostream &, const Symbol &,
+      UnorderedSymbolSet &nonIntrinsicModulesWritten);
 
 private:
   SemanticsContext &context_;
@@ -46,6 +48,7 @@ class ModFileWriter {
   std::string containsBuf_;
   // Tracks nested DEC structures and fields of that type
   UnorderedSymbolSet emittedDECStructures_, emittedDECFields_;
+  UnorderedSymbolSet usedNonIntrinsicModules_;
 
   llvm::raw_string_ostream needs_{needsBuf_};
   llvm::raw_string_ostream uses_{usesBuf_};

flang/lib/Semantics/unparse-with-symbols.cpp

@@ -7,6 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "flang/Semantics/unparse-with-symbols.h"
+#include "mod-file.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Parser/unparse.h"
@@ -98,4 +99,41 @@ void UnparseWithSymbols(llvm::raw_ostream &out, const parser::Program &program,
           int indent) { visitor.PrintSymbols(location, out, indent); }};
   parser::Unparse(out, program, encoding, false, true, &preStatement);
 }
+
+// UnparseWithModules()
+
+class UsedModuleVisitor {
+public:
+  UnorderedSymbolSet &modulesUsed() { return modulesUsed_; }
+  UnorderedSymbolSet &modulesDefined() { return modulesDefined_; }
+  template <typename T> bool Pre(const T &) { return true; }
+  template <typename T> void Post(const T &) {}
+  void Post(const parser::ModuleStmt &module) {
+    if (module.v.symbol) {
+      modulesDefined_.insert(*module.v.symbol);
+    }
+  }
+  void Post(const parser::UseStmt &use) {
+    if (use.moduleName.symbol) {
+      modulesUsed_.insert(*use.moduleName.symbol);
+    }
+  }
+
+private:
+  UnorderedSymbolSet modulesUsed_;
+  UnorderedSymbolSet modulesDefined_;
+};
+
+void UnparseWithModules(llvm::raw_ostream &out, SemanticsContext &context,
+    const parser::Program &program, parser::Encoding encoding) {
+  UsedModuleVisitor visitor;
+  parser::Walk(program, visitor);
+  UnorderedSymbolSet nonIntrinsicModulesWritten{
+      std::move(visitor.modulesDefined())};
+  ModFileWriter writer{context};
+  for (SymbolRef moduleRef : visitor.modulesUsed()) {
+    writer.WriteClosure(out, *moduleRef, nonIntrinsicModulesWritten);
+  }
+  parser::Unparse(out, program, encoding, false, true);
+}
 } // namespace Fortran::semantics

flang/test/Driver/unparse-with-modules.f90

@@ -0,0 +1,34 @@
+! RUN: %flang_fc1 -I %S/Inputs/module-dir -fdebug-unparse-with-modules %s | FileCheck %s
+module m1
+  use iso_fortran_env
+  use BasicTestModuleTwo
+  implicit none
+  type(t2) y
+  real(real32) x
+end
+
+program test
+  use m1
+  use BasicTestModuleTwo
+  implicit none
+  x = 123.
+  y = t2()
+end
+
+!CHECK-NOT: module iso_fortran_env
+!CHECK: module basictestmoduletwo
+!CHECK: type::t2
+!CHECK: end type
+!CHECK: end
+!CHECK: module m1
+!CHECK:  use :: iso_fortran_env
+!CHECK:  implicit none
+!CHECK:  real(kind=real32) x
+!CHECK: end module
+!CHECK: program test
+!CHECK:  use :: m1
+!CHECK:  use :: basictestmoduletwo
+!CHECK:  implicit none
+!CHECK:  x = 123.
+!CHECK:  y = t2()
+!CHECK: end program