[flang] Order Symbols by source provenance

In parser::AllCookedSources, implement a map from CharBlocks to
the CookedSource instances that they cover.  This permits a fast
Find() operation based on std::map::equal_range to map a CharBlock
to its enclosing CookedSource instance.

Add a creation order number to each CookedSource.  This allows
AllCookedSources to provide a Precedes(x,y) predicate that is a
true source stream ordering between two CharBlocks -- x is less
than y if it is in an earlier CookedSource, or in the same
CookedSource at an earlier position.

Add a reference to the singleton SemanticsContext to each Scope.

All of this allows operator< to be implemented on Symbols by
means of a true source ordering.  From a Symbol, we get to
its Scope, then to the SemanticsContext, and then use its
AllCookedSources reference to call Precedes().

Differential Revision: https://reviews.llvm.org/D98743

Author: klausler

flang/include/flang/Parser/char-block.h

@@ -138,6 +138,13 @@ inline bool operator>(const char *left, const CharBlock &right) {
   return right < left;
 }
 
+// An alternative comparator based on pointer values; use with care!
+struct CharBlockPointerComparator {
+  bool operator()(CharBlock x, CharBlock y) const {
+    return x.end() < y.begin();
+  }
+};
+
 llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const CharBlock &x);
 
 } // namespace Fortran::parser

flang/include/flang/Parser/provenance.h

@@ -47,6 +47,7 @@ namespace Fortran::parser {
 // necessary.)
 
 class AllSources;
+class AllCookedSources;
 
 class Provenance {
 public:
@@ -219,6 +220,9 @@ class AllSources {
 // single instances of CookedSource.
 class CookedSource {
 public:
+  int number() const { return number_; }
+  void set_number(int n) { number_ = n; }
+
   CharBlock AsCharBlock() const { return CharBlock{data_}; }
   std::optional<ProvenanceRange> GetProvenanceRange(CharBlock) const;
   std::optional<CharBlock> GetCharBlock(ProvenanceRange) const;
@@ -242,11 +246,12 @@ class CookedSource {
   }
 
   std::size_t BufferedBytes() const;
-  void Marshal(AllSources &); // marshals text into one contiguous block
+  void Marshal(AllCookedSources &); // marshals text into one contiguous block
   void CompileProvenanceRangeToOffsetMappings(AllSources &);
   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
 
 private:
+  int number_{0}; // for sorting purposes
   CharBuffer buffer_; // before Marshal()
   std::string data_; // all of it, prescanned and preprocessed
   OffsetToProvenanceMappings provenanceMap_;
@@ -263,15 +268,8 @@ class AllCookedSources {
 
   CookedSource &NewCookedSource();
 
-  template <typename A> // const char * or CharBlock
-  const CookedSource *Find(A x) const {
-    for (const auto &c : cooked_) {
-      if (c.AsCharBlock().Contains(x)) {
-        return &c;
-      }
-    }
-    return nullptr;
-  }
+  const CookedSource *Find(CharBlock) const;
+  const CookedSource *Find(const char *p) const { return Find(CharBlock{p}); }
 
   bool IsValid(ProvenanceRange r) const { return allSources_.IsValid(r); }
 
@@ -283,9 +281,30 @@ class AllCookedSources {
   std::optional<CharBlock> GetCharBlock(ProvenanceRange) const;
   void Dump(llvm::raw_ostream &) const;
 
+  // For sorting symbol names without being dependent on pointer values
+  bool Precedes(CharBlock, CharBlock) const;
+
+  // Once a CookedSource is complete, add it to index_ and assign its number_
+  void Register(CookedSource &);
+
 private:
   AllSources &allSources_;
   std::list<CookedSource> cooked_; // owns all CookedSource instances
+  int counter_{0};
+  std::map<CharBlock, const CookedSource &, CharBlockPointerComparator> index_;
 };
+
+// For use as a Comparator for maps, sets, sorting, &c.
+class CharBlockComparator {
+public:
+  explicit CharBlockComparator(const AllCookedSources &all) : all_{all} {}
+  bool operator()(CharBlock x, CharBlock y) const {
+    return all_.Precedes(x, y);
+  }
+
+private:
+  const AllCookedSources &all_;
+};
+
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_PROVENANCE_H_

flang/include/flang/Semantics/scope.h

@@ -62,9 +62,10 @@ class Scope {
   using ImportKind = common::ImportKind;
 
   // Create the Global scope -- the root of the scope tree
-  Scope() : Scope{*this, Kind::Global, nullptr} {}
-  Scope(Scope &parent, Kind kind, Symbol *symbol)
-      : parent_{parent}, kind_{kind}, symbol_{symbol} {
+  explicit Scope(SemanticsContext &context)
+      : Scope{*this, Kind::Global, nullptr, context} {}
+  Scope(Scope &parent, Kind kind, Symbol *symbol, SemanticsContext &context)
+      : parent_{parent}, kind_{kind}, symbol_{symbol}, context_{context} {
     if (symbol) {
       symbol->set_scope(this);
     }
@@ -99,6 +100,7 @@ class Scope {
   }
   Symbol *symbol() { return symbol_; }
   const Symbol *symbol() const { return symbol_; }
+  SemanticsContext &context() const { return context_; }
 
   inline const Symbol *GetSymbol() const;
   const Scope *GetDerivedTypeParent() const;
@@ -107,6 +109,9 @@ class Scope {
   bool Contains(const Scope &) const;
   /// Make a scope nested in this one
   Scope &MakeScope(Kind kind, Symbol *symbol = nullptr);
+  SemanticsContext &GetMutableSemanticsContext() const {
+    return const_cast<SemanticsContext &>(context());
+  }
 
   using size_type = mapType::size_type;
   using iterator = mapType::iterator;
@@ -244,7 +249,7 @@ class Scope {
         symbol_->test(Symbol::Flag::ModFile);
   }
 
-  void InstantiateDerivedTypes(SemanticsContext &);
+  void InstantiateDerivedTypes();
 
   const Symbol *runtimeDerivedTypeDescription() const {
     return runtimeDerivedTypeDescription_;
@@ -273,8 +278,9 @@ class Scope {
   parser::Message::Reference instantiationContext_;
   bool hasSAVE_{false}; // scope has a bare SAVE statement
   const Symbol *runtimeDerivedTypeDescription_{nullptr};
+  SemanticsContext &context_;
   // When additional data members are added to Scope, remember to
-  // copy them, if appropriate, in InstantiateDerivedType().
+  // copy them, if appropriate, in FindOrInstantiateDerivedType().
 
   // Storage for all Symbols. Every Symbol is in allSymbols and every Symbol*
   // or Symbol& points to one in there.

flang/include/flang/Semantics/symbol.h

@@ -18,7 +18,7 @@
 #include <functional>
 #include <list>
 #include <optional>
-#include <unordered_set>
+#include <set>
 #include <vector>
 
 namespace llvm {
@@ -595,10 +595,13 @@ class Symbol {
 
   bool operator==(const Symbol &that) const { return this == &that; }
   bool operator!=(const Symbol &that) const { return !(*this == that); }
-  bool operator<(const Symbol &that) const {
-    // Used to collate symbols by creation order
-    return sortIndex_ < that.sortIndex_;
-  }
+
+  // Symbol comparison is based on the order of cooked source
+  // stream creation and, when both are from the same cooked source,
+  // their positions in that cooked source stream.
+  // (This function is implemented in Evaluate/tools.cpp to
+  // satisfy complicated shared library interdependency.)
+  bool operator<(const Symbol &) const;
 
   int Rank() const {
     return std::visit(
@@ -651,10 +654,11 @@ class Symbol {
   // for a parameterized derived type instantiation with the instance's scope.
   const DerivedTypeSpec *GetParentTypeSpec(const Scope * = nullptr) const;
 
+  SemanticsContext &GetSemanticsContext() const;
+
 private:
   const Scope *owner_;
   SourceName name_;
-  std::size_t sortIndex_; // to implement "operator<" platform independently
   Attrs attrs_;
   Flags flags_;
   Scope *scope_{nullptr};
@@ -689,7 +693,6 @@ template <std::size_t BLOCK_SIZE> class Symbols {
     Symbol &symbol = Get();
     symbol.owner_ = &owner;
     symbol.name_ = name;
-    symbol.sortIndex_ = ++symbolCount_;
     symbol.attrs_ = attrs;
     symbol.details_ = std::move(details);
     return symbol;
@@ -700,7 +703,6 @@ template <std::size_t BLOCK_SIZE> class Symbols {
   std::list<blockType *> blocks_;
   std::size_t nextIndex_{0};
   blockType *currBlock_{nullptr};
-  static inline std::size_t symbolCount_ = 0;
 
   Symbol &Get() {
     if (nextIndex_ == 0) {
@@ -765,17 +767,13 @@ inline const DeclTypeSpec *Symbol::GetType() const {
       details_);
 }
 
-inline bool operator<(SymbolRef x, SymbolRef y) { return *x < *y; }
+inline bool operator<(SymbolRef x, SymbolRef y) {
+  return *x < *y; // name source position ordering
+}
 inline bool operator<(MutableSymbolRef x, MutableSymbolRef y) {
-  return *x < *y;
+  return *x < *y; // name source position ordering
 }
-struct SymbolHash {
-  std::size_t operator()(SymbolRef symRef) const {
-    std::hash<std::string> hasher;
-    return hasher(symRef->name().ToString());
-  }
-};
-using SymbolSet = std::unordered_set<SymbolRef, SymbolHash>;
+using SymbolSet = std::set<SymbolRef>;
 
 } // namespace Fortran::semantics
 

flang/lib/Evaluate/tools.cpp

@@ -1203,4 +1203,16 @@ const Symbol *FindFunctionResult(const Symbol &symbol) {
   return FindFunctionResult(symbol, seen);
 }
 
+// These are here in Evaluate/tools.cpp so that Evaluate can use
+// them; they cannot be defined in symbol.h due to the dependence
+// on Scope.
+
+bool Symbol::operator<(const Symbol &that) const {
+  return GetSemanticsContext().allCookedSources().Precedes(name_, that.name_);
+}
+
+SemanticsContext &Symbol::GetSemanticsContext() const {
+  return DEREF(owner_).context();
+}
+
 } // namespace Fortran::semantics

flang/lib/Parser/parsing.cpp

@@ -88,7 +88,7 @@ const SourceFile *Parsing::Prescan(const std::string &path, Options options) {
     // message about nonstandard usage will have provenance.
     currentCooked_->Put('\n', range.start());
   }
-  currentCooked_->Marshal(allSources);
+  currentCooked_->Marshal(allCooked_);
   if (options.needProvenanceRangeToCharBlockMappings) {
     currentCooked_->CompileProvenanceRangeToOffsetMappings(allSources);
   }

flang/lib/Parser/provenance.cpp

@@ -442,11 +442,13 @@ std::optional<CharBlock> CookedSource::GetCharBlock(
 
 std::size_t CookedSource::BufferedBytes() const { return buffer_.bytes(); }
 
-void CookedSource::Marshal(AllSources &allSources) {
+void CookedSource::Marshal(AllCookedSources &allCookedSources) {
   CHECK(provenanceMap_.SizeInBytes() == buffer_.bytes());
-  provenanceMap_.Put(allSources.AddCompilerInsertion("(after end of source)"));
+  provenanceMap_.Put(allCookedSources.allSources().AddCompilerInsertion(
+      "(after end of source)"));
   data_ = buffer_.Marshal();
   buffer_.clear();
+  allCookedSources.Register(*this);
 }
 
 void CookedSource::CompileProvenanceRangeToOffsetMappings(
@@ -534,6 +536,16 @@ CookedSource &AllCookedSources::NewCookedSource() {
   return cooked_.emplace_back();
 }
 
+const CookedSource *AllCookedSources::Find(CharBlock x) const {
+  auto pair{index_.equal_range(x)};
+  for (auto iter{pair.first}; iter != pair.second; ++iter) {
+    if (iter->second.AsCharBlock().Contains(x)) {
+      return &iter->second;
+    }
+  }
+  return nullptr;
+}
+
 std::optional<ProvenanceRange> AllCookedSources::GetProvenanceRange(
     CharBlock cb) const {
   if (const CookedSource * c{Find(cb)}) {
@@ -589,4 +601,27 @@ void AllCookedSources::Dump(llvm::raw_ostream &o) const {
   }
 }
 
+bool AllCookedSources::Precedes(CharBlock x, CharBlock y) const {
+  const CookedSource *ySource{Find(y)};
+  if (const CookedSource * xSource{Find(x)}) {
+    if (ySource) {
+      int xNum{xSource->number()};
+      int yNum{ySource->number()};
+      return xNum < yNum || (xNum == yNum && x.begin() < y.begin());
+    } else {
+      return true; // by fiat, all cooked source < anything outside
+    }
+  } else if (ySource) {
+    return false;
+  } else {
+    // Both names are compiler-created (SaveTempName).
+    return x < y;
+  }
+}
+
+void AllCookedSources::Register(CookedSource &cooked) {
+  index_.emplace(cooked.AsCharBlock(), cooked);
+  cooked.set_number(static_cast<int>(index_.size()));
+}
+
 } // namespace Fortran::parser

flang/lib/Semantics/check-io.cpp

@@ -930,7 +930,8 @@ void IoChecker::CheckForDefinableVariable(
   if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) {
     if (auto expr{AnalyzeExpr(context_, *var)}) {
       auto at{var->GetSource()};
-      if (auto whyNot{WhyNotModifiable(at, *expr, context_.FindScope(at))}) {
+      if (auto whyNot{WhyNotModifiable(at, *expr, context_.FindScope(at),
+              true /*vectorSubscriptIsOk*/)}) {
         const Symbol *base{GetFirstSymbol(*expr)};
         context_
             .Say(at, "%s variable '%s' must be definable"_err_en_US, s,

flang/lib/Semantics/resolve-names.cpp

@@ -6393,7 +6393,7 @@ void ResolveNamesVisitor::FinishSpecificationPart(
       CheckPossibleBadForwardRef(symbol);
     }
   }
-  currScope().InstantiateDerivedTypes(context());
+  currScope().InstantiateDerivedTypes();
   for (const auto &decl : decls) {
     if (const auto *statement{std::get_if<
             parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>(

flang/lib/Semantics/scope.cpp

@@ -50,7 +50,7 @@ std::string EquivalenceObject::AsFortran() const {
 }
 
 Scope &Scope::MakeScope(Kind kind, Symbol *symbol) {
-  return children_.emplace_back(*this, kind, symbol);
+  return children_.emplace_back(*this, kind, symbol, context_);
 }
 
 template <typename T>
@@ -404,11 +404,11 @@ const Scope &Scope::GetDerivedTypeBase() const {
   return *child;
 }
 
-void Scope::InstantiateDerivedTypes(SemanticsContext &context) {
+void Scope::InstantiateDerivedTypes() {
   for (DeclTypeSpec &type : declTypeSpecs_) {
     if (type.category() == DeclTypeSpec::TypeDerived ||
         type.category() == DeclTypeSpec::ClassDerived) {
-      type.derivedTypeSpec().Instantiate(*this, context);
+      type.derivedTypeSpec().Instantiate(*this, context_);
     }
   }
 }

flang/lib/Semantics/semantics.cpp

@@ -185,8 +185,9 @@ SemanticsContext::SemanticsContext(
     : defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures},
       allCookedSources_{allCookedSources},
       intrinsics_{evaluate::IntrinsicProcTable::Configure(defaultKinds_)},
-      foldingContext_{
-          parser::ContextualMessages{&messages_}, defaultKinds_, intrinsics_} {}
+      globalScope_{*this}, foldingContext_{
+                               parser::ContextualMessages{&messages_},
+                               defaultKinds_, intrinsics_} {}
 
 SemanticsContext::~SemanticsContext() {}
 

flang/test/Semantics/data05.f90

@@ -73,15 +73,15 @@ integer function ifunc2(n)
   end function
   subroutine s11
     real, target, save :: arr(3,4) ! CHECK: arr, SAVE, TARGET size=48 offset=0: ObjectEntity type: REAL(4) shape: 1_8:3_8,1_8:4_8
-    type(t1) :: d1 = t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc) ! CHECK: d1 size=192 offset=48: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","a"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4))
+    type(t1) :: d1 = t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc) ! CHECK: d1 size=184 offset=48: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
     type(t1(4,len=1)) :: d2 = t1(4)(xrp=extrfunc,rp=rfunc,ifptr=ifunc2,xp=arr,c='a&
-      &b',t=.false.,z=(6.,7.),x=reshape([1,2,3,4],[2,2]),j=1) ! CHECK: d2 size=192 offset=240: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","a"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4))
-    type(t1(2+2)) :: d3 ! CHECK: d3 (InDataStmt) size=192 offset=432: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","a"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4))
+      &b',t=.false.,z=(6.,7.),x=reshape([1,2,3,4],[2,2]),j=1) ! CHECK: d2 size=184 offset=232: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
+    type(t1(2+2)) :: d3 ! CHECK: d3 (InDataStmt) size=184 offset=416: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
     data d3/t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc)/
-    type(t1) :: d4 ! CHECK: d4 (InDataStmt) size=192 offset=624: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","a"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4))
+    type(t1) :: d4 ! CHECK: d4 (InDataStmt) size=184 offset=600: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
     data d4/t1(4)(xrp=extrfunc,rp=rfunc,ifptr=ifunc2,xp=arr,c='ab',t=.false.,z=(6&
       &.,7.),x=reshape([1,2,3,4],[2,2]),j=1)/
-    type(t1) :: d5 ! CHECK: d5 (InDataStmt) size=192 offset=816: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","b"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4))
+    type(t1) :: d5 ! CHECK: d5 (InDataStmt) size=184 offset=784: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","b"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
     data d5%j/1/,d5%x/1,2,3,4/,d5%z%re/6./,d5%z%im/7./,d5%t/.false./,d5%c(1:1)/'a'/,d5%c(2:&
       &2)/'b'/,d5%xp/arr/,d5%ifptr/ifunc2/,d5%rp/rfunc/,d5%xrp/extrfunc/
   end subroutine

flang/test/Semantics/modfile21.f90

@@ -26,10 +26,10 @@ module m
 !  real(4)::v
 !  complex(4)::w
 !  real(4)::cb
-!  common//t,w,u,v
 !  common/cb/x,y,z
 !  bind(c, name="CB")::/cb/
 !  common/cb2/a,b,c
 !  bind(c)::/cb2/
 !  common/b/cb
+!  common//t,w,u,v
 !end