flang/lib/Semantics/mod-file.cpp

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