From 2f42d6c172d5dd76df0714732bc54616b768ca8b Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Wed, 22 May 2024 12:29:01 -0700 Subject: [PATCH] [flang] Better renaming in module files When a symbol from one module is used in another without an explicit USE association, the module file output code may need to use another name for it -- either with a name that is already available via USE association with renaming, or by means of a new private USE association, possibly with renaming to avoid a clash. Module file output was dealing properly with names of derived types, but wasn't accounting for symbols that appear in expressions other than initializations. This was specifically a problem with an application module that had a call to a NOPASS type-bound procedure in an array bound specification expression, which semantics had resolved to the name of a private module function. This patch implements renaming, when necessary, for all symbols appearing in expressions and type names, and replaces the previous implementation of derived type renaming. It also gets a little smarter about avoiding the creation of compiler-generated names when a name from another module has been brought into scope already by means of USE association with renaming. --- flang/include/flang/Evaluate/constant.h | 3 +- flang/include/flang/Evaluate/expression.h | 3 +- flang/include/flang/Evaluate/type.h | 3 - flang/include/flang/Semantics/semantics.h | 4 + flang/lib/Evaluate/formatting.cpp | 213 +++++++++++----------- flang/lib/Semantics/mod-file.cpp | 153 ++++++++++------ flang/lib/Semantics/mod-file.h | 1 - flang/test/Semantics/modfile03.f90 | 50 ++++- 8 files changed, 261 insertions(+), 169 deletions(-) diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h index 71be7906d2fe2..d9866a08889f3 100644 --- a/flang/include/flang/Evaluate/constant.h +++ b/flang/include/flang/Evaluate/constant.h @@ -126,8 +126,7 @@ class ConstantBase : public ConstantBounds { constexpr Result result() const { return result_; } constexpr DynamicType GetType() const { return result_.GetType(); } - llvm::raw_ostream &AsFortran(llvm::raw_ostream &, - const parser::CharBlock *derivedTypeRename = nullptr) const; + llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; protected: std::vector Reshape(const ConstantSubscripts &) const; diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h index 64db0b88d03e5..642ddf5116847 100644 --- a/flang/include/flang/Evaluate/expression.h +++ b/flang/include/flang/Evaluate/expression.h @@ -735,8 +735,7 @@ class StructureConstructor { StructureConstructor &Add(const semantics::Symbol &, Expr &&); int Rank() const { return 0; } DynamicType GetType() const; - llvm::raw_ostream &AsFortran(llvm::raw_ostream &, - const parser::CharBlock *derivedTypeRename = nullptr) const; + llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; private: std::optional> CreateParentComponent(const Symbol &) const; diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h index 93a0f21fa9145..de19e3d04dea8 100644 --- a/flang/include/flang/Evaluate/type.h +++ b/flang/include/flang/Evaluate/type.h @@ -272,9 +272,6 @@ const semantics::DerivedTypeSpec *GetDerivedTypeSpec( const semantics::DerivedTypeSpec *GetParentTypeSpec( const semantics::DerivedTypeSpec &); -std::string DerivedTypeSpecAsFortran(const semantics::DerivedTypeSpec &, - const parser::CharBlock *derivedTypeRename = nullptr); - template struct TypeBase { static constexpr TypeCategory category{CATEGORY}; static constexpr int kind{KIND}; diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h index 167e613816394..d382663762bc3 100644 --- a/flang/include/flang/Semantics/semantics.h +++ b/flang/include/flang/Semantics/semantics.h @@ -110,6 +110,9 @@ class SemanticsContext { evaluate::FoldingContext &foldingContext() { return foldingContext_; } parser::AllCookedSources &allCookedSources() { return allCookedSources_; } ModuleDependences &moduleDependences() { return moduleDependences_; } + std::map &moduleFileOutputRenamings() { + return moduleFileOutputRenamings_; + } SemanticsContext &set_location( const std::optional &location) { @@ -299,6 +302,7 @@ class SemanticsContext { std::list modFileParseTrees_; std::unique_ptr commonBlockMap_; ModuleDependences moduleDependences_; + std::map moduleFileOutputRenamings_; }; class Semantics { diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp index 20193b006bf2f..0870d56549f74 100644 --- a/flang/lib/Evaluate/formatting.cpp +++ b/flang/lib/Evaluate/formatting.cpp @@ -14,6 +14,7 @@ #include "flang/Evaluate/fold.h" #include "flang/Evaluate/tools.h" #include "flang/Parser/characters.h" +#include "flang/Semantics/semantics.h" #include "flang/Semantics/symbol.h" #include "llvm/Support/raw_ostream.h" @@ -53,7 +54,7 @@ static void ShapeAsFortran(llvm::raw_ostream &o, template llvm::raw_ostream &ConstantBase::AsFortran( - llvm::raw_ostream &o, const parser::CharBlock *derivedTypeRename) const { + llvm::raw_ostream &o) const { bool hasNonDefaultLowerBound{printLbounds && HasNonDefaultLowerBound()}; if (Rank() > 1 || hasNonDefaultLowerBound) { o << "reshape("; @@ -85,8 +86,7 @@ llvm::raw_ostream &ConstantBase::AsFortran( o << ".false." << '_' << Result::kind; } } else { - StructureConstructor{result_.derivedTypeSpec(), value}.AsFortran( - o, derivedTypeRename); + StructureConstructor{result_.derivedTypeSpec(), value}.AsFortran(o); } } if (Rank() > 0) { @@ -124,9 +124,89 @@ llvm::raw_ostream &Constant>::AsFortran( return o; } +llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const Symbol &symbol, + std::optional name = std::nullopt) { + const auto &renamings{symbol.owner().context().moduleFileOutputRenamings()}; + if (auto iter{renamings.find(&symbol)}; iter != renamings.end()) { + return o << iter->second.ToString(); + } else if (name) { + return o << name->ToString(); + } else { + return o << symbol.name().ToString(); + } +} + +llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::string &lit) { + return o << parser::QuoteCharacterLiteral(lit); +} + +llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u16string &lit) { + return o << parser::QuoteCharacterLiteral(lit); +} + +llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u32string &lit) { + return o << parser::QuoteCharacterLiteral(lit); +} + +template +llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const A &x) { + return x.AsFortran(o); +} + +template +llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, common::Reference x) { + return EmitVar(o, *x); +} + +template +llvm::raw_ostream &EmitVar( + llvm::raw_ostream &o, const A *p, const char *kw = nullptr) { + if (p) { + if (kw) { + o << kw; + } + EmitVar(o, *p); + } + return o; +} + +template +llvm::raw_ostream &EmitVar( + llvm::raw_ostream &o, const std::optional &x, const char *kw = nullptr) { + if (x) { + if (kw) { + o << kw; + } + EmitVar(o, *x); + } + return o; +} + +template +llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, + const common::Indirection &p, const char *kw = nullptr) { + if (kw) { + o << kw; + } + EmitVar(o, p.value()); + return o; +} + +template +llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::shared_ptr &p) { + CHECK(p); + return EmitVar(o, *p); +} + +template +llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::variant &u) { + common::visit([&](const auto &x) { EmitVar(o, x); }, u); + return o; +} + llvm::raw_ostream &ActualArgument::AssumedType::AsFortran( llvm::raw_ostream &o) const { - return o << symbol_->name().ToString(); + return EmitVar(o, *symbol_); } llvm::raw_ostream &ActualArgument::AsFortran(llvm::raw_ostream &o) const { @@ -504,15 +584,37 @@ llvm::raw_ostream &ExpressionBase::AsFortran( return o; } -llvm::raw_ostream &StructureConstructor::AsFortran( - llvm::raw_ostream &o, const parser::CharBlock *derivedTypeRename) const { - o << DerivedTypeSpecAsFortran(result_.derivedTypeSpec(), derivedTypeRename); +static std::string DerivedTypeSpecAsFortran( + const semantics::DerivedTypeSpec &spec) { + std::string buf; + llvm::raw_string_ostream ss{buf}; + EmitVar(ss, spec.typeSymbol(), spec.name()); + char ch{'('}; + for (const auto &[name, value] : spec.parameters()) { + ss << ch << name.ToString() << '='; + ch = ','; + if (value.isAssumed()) { + ss << '*'; + } else if (value.isDeferred()) { + ss << ':'; + } else { + value.GetExplicit()->AsFortran(ss); + } + } + if (ch != '(') { + ss << ')'; + } + return ss.str(); +} + +llvm::raw_ostream &StructureConstructor::AsFortran(llvm::raw_ostream &o) const { + o << DerivedTypeSpecAsFortran(result_.derivedTypeSpec()); if (values_.empty()) { o << '('; } else { char ch{'('}; for (const auto &[symbol, value] : values_) { - value.value().AsFortran(o << ch << symbol->name().ToString() << '='); + value.value().AsFortran(EmitVar(o << ch, *symbol) << '='); ch = ','; } } @@ -568,101 +670,6 @@ std::string SomeDerived::AsFortran() const { } } -std::string DerivedTypeSpecAsFortran(const semantics::DerivedTypeSpec &spec, - const parser::CharBlock *derivedTypeRename) { - std::string buf; - llvm::raw_string_ostream ss{buf}; - ss << (derivedTypeRename ? *derivedTypeRename : spec.name()).ToString(); - char ch{'('}; - for (const auto &[name, value] : spec.parameters()) { - ss << ch << name.ToString() << '='; - ch = ','; - if (value.isAssumed()) { - ss << '*'; - } else if (value.isDeferred()) { - ss << ':'; - } else { - value.GetExplicit()->AsFortran(ss); - } - } - if (ch != '(') { - ss << ')'; - } - return ss.str(); -} - -llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const Symbol &symbol) { - return o << symbol.name().ToString(); -} - -llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::string &lit) { - return o << parser::QuoteCharacterLiteral(lit); -} - -llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u16string &lit) { - return o << parser::QuoteCharacterLiteral(lit); -} - -llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::u32string &lit) { - return o << parser::QuoteCharacterLiteral(lit); -} - -template -llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const A &x) { - return x.AsFortran(o); -} - -template -llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, common::Reference x) { - return EmitVar(o, *x); -} - -template -llvm::raw_ostream &EmitVar( - llvm::raw_ostream &o, const A *p, const char *kw = nullptr) { - if (p) { - if (kw) { - o << kw; - } - EmitVar(o, *p); - } - return o; -} - -template -llvm::raw_ostream &EmitVar( - llvm::raw_ostream &o, const std::optional &x, const char *kw = nullptr) { - if (x) { - if (kw) { - o << kw; - } - EmitVar(o, *x); - } - return o; -} - -template -llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, - const common::Indirection &p, const char *kw = nullptr) { - if (kw) { - o << kw; - } - EmitVar(o, p.value()); - return o; -} - -template -llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::shared_ptr &p) { - CHECK(p); - return EmitVar(o, *p); -} - -template -llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const std::variant &u) { - common::visit([&](const auto &x) { EmitVar(o, x); }, u); - return o; -} - llvm::raw_ostream &BaseObject::AsFortran(llvm::raw_ostream &o) const { return EmitVar(o, u); } diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index bb8c6c7567b8d..67523c468f18d 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -46,11 +46,11 @@ struct ModHeader { }; static std::optional GetSubmoduleParent(const parser::Program &); -static void CollectSymbols(const Scope &, SymbolVector &, SymbolVector &, - std::map &, UnorderedSymbolSet &); +static void CollectSymbols( + const Scope &, SymbolVector &, SymbolVector &, UnorderedSymbolSet &); static void PutPassName(llvm::raw_ostream &, const std::optional &); static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &, - const parser::Expr *, const std::map &); + const parser::Expr *); static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &); static void PutBound(llvm::raw_ostream &, const Bound &); static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &); @@ -200,47 +200,102 @@ std::string ModFileWriter::GetAsString(const Symbol &symbol) { return all.str(); } -// Collect symbols from initializations that are being referenced directly -// from other modules; they may require new USE associations. -static void HarvestInitializerSymbols( - SourceOrderedSymbolSet &set, const Scope &scope) { - for (const auto &[_, symbol] : scope) { - if (symbol->has()) { - if (symbol->scope()) { - HarvestInitializerSymbols(set, *symbol->scope()); +// 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); } - } else if (const auto &generic{symbol->detailsIf()}; - generic && generic->derivedType()) { - const Symbol &dtSym{*generic->derivedType()}; - if (dtSym.has()) { - if (dtSym.scope()) { - HarvestInitializerSymbols(set, *dtSym.scope()); - } - } else { - CHECK(dtSym.has() || dtSym.has()); + } + }}; + 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()) { + if (symbol.scope()) { + HarvestSymbolsNeededFromOtherModules(set, *symbol.scope()); + } + } else if (const auto &generic{symbol.detailsIf()}; + generic && generic->derivedType()) { + const Symbol &dtSym{*generic->derivedType()}; + if (dtSym.has()) { + if (dtSym.scope()) { + HarvestSymbolsNeededFromOtherModules(set, *dtSym.scope()); } - } else if (IsNamedConstant(*symbol) || scope.IsDerivedType()) { - if (const auto *object{symbol->detailsIf()}) { - if (object->init()) { - for (SymbolRef ref : evaluate::CollectSymbols(*object->init())) { - set.emplace(*ref); - } - } - } else if (const auto *proc{symbol->detailsIf()}) { - if (proc->init() && *proc->init()) { - set.emplace(**proc->init()); + } else { + CHECK(dtSym.has() || dtSym.has()); + } + } else if (const auto *object{symbol.detailsIf()}) { + 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()}) { + if (proc->init() && *proc->init() && scope.IsDerivedType()) { + set.emplace(**proc->init()); + } + } else if (const auto *subp{symbol.detailsIf()}) { + 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); } } void ModFileWriter::PrepareRenamings(const Scope &scope) { - SourceOrderedSymbolSet symbolsInInits; - HarvestInitializerSymbols(symbolsInInits, scope); - for (SymbolRef s : symbolsInInits) { + // Identify use-associated symbols already in scope under some name + std::map useMap; + for (const auto &[name, symbolRef] : scope) { + const Symbol *symbol{&*symbolRef}; + while (const auto *hostAssoc{symbol->detailsIf()}) { + symbol = &hostAssoc->symbol(); + } + if (const auto *use{symbol->detailsIf()}) { + useMap.emplace(&use->symbol(), symbol); + } + } + // Collect symbols needed from other modules + SourceOrderedSymbolSet symbolsNeeded; + HarvestSymbolsNeededFromOtherModules(symbolsNeeded, 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) { const Scope *sMod{FindModuleContaining(s->owner())}; - if (!sMod) { + if (!sMod || sMod == &scope) { + continue; + } + if (auto iter{useMap.find(&*s)}; iter != useMap.end()) { + renamings.emplace(&*s, iter->second->name()); continue; } SourceName rename{s->name()}; @@ -272,10 +327,10 @@ void ModFileWriter::PrepareRenamings(const Scope &scope) { uses_ << DEREF(sMod->symbol()).name() << ",only:"; if (rename != s->name()) { uses_ << rename << "=>"; + renamings.emplace(&*s, rename); } uses_ << s->name() << '\n'; useExtraAttrs_ << "private::" << rename << '\n'; - renamings_.emplace(&*s, rename); } } @@ -283,9 +338,11 @@ void ModFileWriter::PrepareRenamings(const Scope &scope) { void ModFileWriter::PutSymbols(const Scope &scope) { SymbolVector sorted; SymbolVector uses; + auto &renamings{context_.moduleFileOutputRenamings()}; + auto previousRenamings{std::move(renamings)}; PrepareRenamings(scope); UnorderedSymbolSet modules; - CollectSymbols(scope, sorted, uses, renamings_, modules); + CollectSymbols(scope, sorted, uses, modules); // Write module files for dependencies first so that their // hashes are known. for (auto ref : modules) { @@ -318,6 +375,7 @@ void ModFileWriter::PutSymbols(const Scope &scope) { } } CHECK(typeBindings.str().empty()); + renamings = std::move(previousRenamings); } // Emit components in order @@ -521,7 +579,7 @@ void ModFileWriter::PutDECStructure( } decls_ << ref->name(); PutShape(decls_, object->shape(), '(', ')'); - PutInit(decls_, *ref, object->init(), nullptr, renamings_); + PutInit(decls_, *ref, object->init(), nullptr); emittedDECFields_.insert(*ref); } else if (any) { break; // any later use of this structure will use RECORD/str/ @@ -767,8 +825,7 @@ static inline SourceName NameInModuleFile(const Symbol &symbol) { // 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, std::map &renamings, - UnorderedSymbolSet &modules) { + SymbolVector &uses, UnorderedSymbolSet &modules) { SymbolVector namelist, generics; auto symbols{scope.GetSymbols()}; std::size_t commonSize{scope.commonBlocks().size()}; @@ -878,8 +935,7 @@ void ModFileWriter::PutObjectEntity( getSymbolAttrsToWrite(symbol)); PutShape(os, details.shape(), '(', ')'); PutShape(os, details.coshape(), '[', ']'); - PutInit(os, symbol, details.init(), details.unanalyzedPDTComponentInit(), - renamings_); + PutInit(os, symbol, details.init(), details.unanalyzedPDTComponentInit()); os << '\n'; if (auto tkr{GetIgnoreTKR(symbol)}; !tkr.empty()) { os << "!dir$ ignore_tkr("; @@ -973,25 +1029,12 @@ void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) { } void PutInit(llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init, - const parser::Expr *unanalyzed, - const std::map &renamings) { + const parser::Expr *unanalyzed) { if (IsNamedConstant(symbol) || symbol.owner().IsDerivedType()) { const char *assign{symbol.attrs().test(Attr::POINTER) ? "=>" : "="}; if (unanalyzed) { parser::Unparse(os << assign, *unanalyzed); } else if (init) { - if (const auto *dtConst{ - evaluate::UnwrapExpr>( - *init)}) { - const Symbol &dtSym{dtConst->result().derivedTypeSpec().typeSymbol()}; - if (auto iter{renamings.find(&dtSym)}; iter != renamings.end()) { - // Initializer is a constant whose derived type's name has - // been brought into scope from a module under a new name - // to avoid a conflict. - dtConst->AsFortran(os << assign, &iter->second); - return; - } - } init->AsFortran(os << assign); } } diff --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h index 739add32c2e0e..be44780bef438 100644 --- a/flang/lib/Semantics/mod-file.h +++ b/flang/lib/Semantics/mod-file.h @@ -57,7 +57,6 @@ class ModFileWriter { llvm::raw_string_ostream decls_{declsBuf_}; llvm::raw_string_ostream contains_{containsBuf_}; bool isSubmodule_{false}; - std::map renamings_; void WriteAll(const Scope &); void WriteOne(const Scope &); diff --git a/flang/test/Semantics/modfile03.f90 b/flang/test/Semantics/modfile03.f90 index db0caeab973f8..39f56ca41584d 100644 --- a/flang/test/Semantics/modfile03.f90 +++ b/flang/test/Semantics/modfile03.f90 @@ -135,10 +135,8 @@ module m6d end !Expect: m6d.mod !module m6d -! use m6a,only:t1 ! use m6a,only:t2=>t1 -! private::t1 -! type(t2),parameter::p=t1() +! type(t2),parameter::p=t2() !end module m6e @@ -178,3 +176,49 @@ module m7b ! use m7a,only:x ! private::x !end + +module m8a + private foo + type t + contains + procedure, nopass :: foo + end type + contains + pure integer function foo(n) + integer, intent(in) :: n + foo = n + end +end +!Expect: m8a.mod +!module m8a +!type::t +!contains +!procedure,nopass::foo +!end type +!private::foo +!contains +!pure function foo(n) +!integer(4),intent(in)::n +!integer(4)::foo +!end +!end + +module m8b + use m8a + contains + subroutine foo(x,a) + type(t), intent(in) :: x + real a(x%foo(10)) + end +end +!Expect: m8b.mod +!module m8b +!use m8a,only:m8a$foo=>foo +!use m8a,only:t +!private::m8a$foo +!contains +!subroutine foo(x,a) +!type(t),intent(in)::x +!real(4)::a(1_8:int(m8a$foo(10_4),kind=8)) +!end +!end