[flang] Rework how DeclTypeSpecs are stored

Now DeclTypeSpecs are stored in the scope so that they remain available
as long as the scope exists. DeclTypeSpecs for intrinsic types are
stored in the global scope; those for derived types are in the current
scope. They can contains type parameter values so they can't be reused.

Add `Semantics::MakeIntrinsicTypeSpec` to simplify creating
DeclTypeSpecs for intrinsic types.

Replace `std::optional<DeclTypeSpec>` with `DeclTypeSpec *` as they do
not need to be copied around.

Also fix a small bug with writing `class(t(...))` to the module file --
the type parameters were missing.

Original-commit: flang-compiler/f18@e4744418fc1cdc9728bba4b9ecde51cb5bdd2efa
Reviewed-on: https://github.com/flang-compiler/f18/pull/247
Tree-same-pre-rewrite: false

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 01b7c6e..526b238 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -22,6 +22,7 @@
 #include "semantics.h"
 #include "symbol.h"
 #include "type.h"
+#include "../common/fortran.h"
 #include "../common/indirection.h"
 #include "../evaluate/common.h"
 #include "../evaluate/fold.h"
@@ -65,7 +66,7 @@ public:
   void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; }
   void set_inheritFromParent(bool x) { inheritFromParent_ = x; }
   // Get the implicit type for identifiers starting with ch. May be null.
-  std::optional<const DeclTypeSpec> GetType(char ch) const;
+  const DeclTypeSpec *GetType(char ch) const;
   // Record the implicit type for this range of characters.
   void SetType(const DeclTypeSpec &type, parser::Location lo, parser::Location,
       bool isDefault = false);
@@ -79,7 +80,7 @@ private:
   bool inheritFromParent_;  // look in parent if not specified here
   SemanticsContext *context_{nullptr};
   // map initial character of identifier to nullptr or its default type
-  std::map<char, const DeclTypeSpec> map_;
+  std::map<char, const DeclTypeSpec *> map_;
 
   friend std::ostream &operator<<(std::ostream &, const ImplicitRules &);
   friend void ShowImplicitRule(std::ostream &, const ImplicitRules &, char);
@@ -218,28 +219,25 @@ public:
   void Post(const parser::IntrinsicTypeSpec::DoublePrecision &);
   void Post(const parser::IntrinsicTypeSpec::DoubleComplex &);
   void Post(const parser::IntrinsicTypeSpec::Character &);
-  bool Pre(const parser::DeclarationTypeSpec::ClassStar &);
-  bool Pre(const parser::DeclarationTypeSpec::TypeStar &);
-  bool Pre(const parser::DeclarationTypeSpec::Record &);
+  void Post(const parser::DeclarationTypeSpec::ClassStar &);
+  void Post(const parser::DeclarationTypeSpec::TypeStar &);
   void Post(const parser::TypeParamSpec &);
   bool Pre(const parser::TypeGuardStmt &);
   void Post(const parser::TypeGuardStmt &);
 
 protected:
-  std::unique_ptr<DeclTypeSpec> &GetDeclTypeSpec();
+  DeclTypeSpec *GetDeclTypeSpec();
   void BeginDeclTypeSpec();
   void EndDeclTypeSpec();
-  void BeginDerivedTypeSpec(const parser::Name &, DerivedTypeSpec &);
-  bool IsDerivedTypeSpec() const { return derivedTypeSpec_ != nullptr; }
-  const parser::Name &SetDerivedDeclTypeSpec(DeclTypeSpec::Category);
+  const parser::Name *derivedTypeName() const { return derivedTypeName_; }
+  void SetDeclTypeSpec(const parser::Name &, DeclTypeSpec &);
 
 private:
   bool expectDeclTypeSpec_{false};  // should only see decl-type-spec when true
-  std::unique_ptr<DeclTypeSpec> declTypeSpec_;
-  DerivedTypeSpec *derivedTypeSpec_{nullptr};
+  DeclTypeSpec *declTypeSpec_{nullptr};
   const parser::Name *derivedTypeName_{nullptr};
 
-  void SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec);
+  void SetDeclTypeSpec(DeclTypeSpec &declTypeSpec);
   void MakeIntrinsic(TypeCategory, const std::optional<parser::KindSelector> &);
   void MakeIntrinsic(TypeCategory, int kind);
   int GetKindParamValue(
@@ -425,7 +423,7 @@ protected:
 
   // Apply the implicit type rules to this symbol.
   void ApplyImplicitRules(Symbol &);
-  std::optional<const DeclTypeSpec> GetImplicitType(Symbol &);
+  const DeclTypeSpec *GetImplicitType(Symbol &);
   bool ConvertToObjectEntity(Symbol &);
   bool ConvertToProcEntity(Symbol &);
 
@@ -583,9 +581,10 @@ public:
   void Post(const parser::DimensionStmt::Declaration &);
   bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
   void Post(const parser::TypeDeclarationStmt &) { EndDecl(); }
-  void Post(const parser::DeclarationTypeSpec::Type &);
   void Post(const parser::DeclarationTypeSpec::Class &);
+  bool Pre(const parser::DeclarationTypeSpec::Record &);
   bool Pre(const parser::DerivedTypeSpec &);
+  void Post(const parser::DerivedTypeSpec &);
   void Post(const parser::DerivedTypeDef &x);
   bool Pre(const parser::DerivedTypeStmt &x);
   void Post(const parser::DerivedTypeStmt &x);
@@ -644,8 +643,7 @@ private:
   Symbol &DeclareObjectEntity(const parser::Name &, Attrs);
   Symbol &DeclareProcEntity(const parser::Name &, Attrs, const ProcInterface &);
   void SetType(const parser::Name &, const DeclTypeSpec &);
-  const Symbol *ResolveDerivedType(DeclTypeSpec::Category);
-  const Symbol *ResolveDerivedType(const parser::Name &);
+  const Symbol *ResolveDerivedType(const parser::Name * = nullptr);
   bool CanBeTypeBoundProc(const Symbol &);
   Symbol *FindExplicitInterface(const parser::Name &);
   bool MakeTypeSymbol(const parser::Name &, Details &&);
@@ -861,19 +859,17 @@ bool ImplicitRules::isImplicitNoneExternal() const {
   }
 }
 
-std::optional<const DeclTypeSpec> ImplicitRules::GetType(char ch) const {
+const DeclTypeSpec *ImplicitRules::GetType(char ch) const {
   if (auto it{map_.find(ch)}; it != map_.end()) {
     return it->second;
   } else if (inheritFromParent_ && parent_->context_) {
     return parent_->GetType(ch);
   } else if (ch >= 'i' && ch <= 'n') {
-    return DeclTypeSpec{IntrinsicTypeSpec{TypeCategory::Integer,
-        context_->defaultKinds().GetDefaultKind(TypeCategory::Integer)}};
+    return &context_->MakeIntrinsicTypeSpec(TypeCategory::Integer);
   } else if (ch >= 'a' && ch <= 'z') {
-    return DeclTypeSpec{IntrinsicTypeSpec{TypeCategory::Real,
-        context_->defaultKinds().GetDefaultKind(TypeCategory::Real)}};
+    return &context_->MakeIntrinsicTypeSpec(TypeCategory::Real);
   } else {
-    return std::nullopt;
+    return nullptr;
   }
 }
 
@@ -882,7 +878,7 @@ std::optional<const DeclTypeSpec> ImplicitRules::GetType(char ch) const {
 void ImplicitRules::SetType(const DeclTypeSpec &type, parser::Location lo,
     parser::Location hi, bool isDefault) {
   for (char ch = *lo; ch; ch = ImplicitRules::Incr(ch)) {
-    auto res{map_.emplace(ch, type)};
+    auto res{map_.emplace(ch, &type)};
     if (!res.second && !isDefault) {
       context_->Say(lo,
           "More than one implicit type specified for '%s'"_err_en_US,
@@ -919,7 +915,7 @@ void ShowImplicitRule(
     std::ostream &o, const ImplicitRules &implicitRules, char ch) {
   auto it{implicitRules.map_.find(ch)};
   if (it != implicitRules.map_.end()) {
-    o << "  " << ch << ": " << it->second << '\n';
+    o << "  " << ch << ": " << *it->second << '\n';
   }
 }
 
@@ -972,37 +968,27 @@ bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
 
 // DeclTypeSpecVisitor implementation
 
-std::unique_ptr<DeclTypeSpec> &DeclTypeSpecVisitor::GetDeclTypeSpec() {
-  return declTypeSpec_;
-}
+DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() { return declTypeSpec_; }
+
 void DeclTypeSpecVisitor::BeginDeclTypeSpec() {
   CHECK(!expectDeclTypeSpec_);
-  CHECK(!derivedTypeSpec_);
+  CHECK(!declTypeSpec_);
   expectDeclTypeSpec_ = true;
 }
 void DeclTypeSpecVisitor::EndDeclTypeSpec() {
   CHECK(expectDeclTypeSpec_);
   expectDeclTypeSpec_ = false;
-  declTypeSpec_.reset();
-  derivedTypeSpec_ = nullptr;
+  declTypeSpec_ = nullptr;
   derivedTypeName_ = nullptr;
 }
 
-bool DeclTypeSpecVisitor::Pre(const parser::DeclarationTypeSpec::ClassStar &x) {
-  SetDeclTypeSpec(DeclTypeSpec{DeclTypeSpec::ClassStar});
-  return false;
-}
-bool DeclTypeSpecVisitor::Pre(const parser::DeclarationTypeSpec::TypeStar &x) {
-  SetDeclTypeSpec(DeclTypeSpec{DeclTypeSpec::TypeStar});
-  return false;
-}
-
 void DeclTypeSpecVisitor::Post(const parser::TypeParamSpec &x) {
+  DerivedTypeSpec &derivedTypeSpec{declTypeSpec_->derivedTypeSpec()};
   const auto &value{std::get<parser::TypeParamValue>(x.t)};
   if (const auto &keyword{std::get<std::optional<parser::Keyword>>(x.t)}) {
-    derivedTypeSpec_->AddParamValue(keyword->v.source, GetParamValue(value));
+    derivedTypeSpec.AddParamValue(keyword->v.source, GetParamValue(value));
   } else {
-    derivedTypeSpec_->AddParamValue(GetParamValue(value));
+    derivedTypeSpec.AddParamValue(GetParamValue(value));
   }
 }
 
@@ -1020,11 +1006,6 @@ ParamValue DeclTypeSpecVisitor::GetParamValue(const parser::TypeParamValue &x) {
       x.u);
 }
 
-bool DeclTypeSpecVisitor::Pre(const parser::DeclarationTypeSpec::Record &x) {
-  // TODO
-  return true;
-}
-
 bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
   BeginDeclTypeSpec();
   return true;
@@ -1032,7 +1013,7 @@ bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
 void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
   // TODO: TypeGuardStmt
   EndDeclTypeSpec();
-  derivedTypeSpec_ = nullptr;
+  declTypeSpec_ = nullptr;
   derivedTypeName_ = nullptr;
 }
 
@@ -1066,32 +1047,30 @@ void DeclTypeSpecVisitor::MakeIntrinsic(
   MakeIntrinsic(category, GetKindParamValue(category, kind));
 }
 void DeclTypeSpecVisitor::MakeIntrinsic(TypeCategory category, int kind) {
-  if (kind == 0) {
-    kind = context().defaultKinds().GetDefaultKind(category);
-  }
-  SetDeclTypeSpec(DeclTypeSpec{IntrinsicTypeSpec{category, kind}});
+  SetDeclTypeSpec(context().MakeIntrinsicTypeSpec(category, kind));
 }
 
-const parser::Name &DeclTypeSpecVisitor::SetDerivedDeclTypeSpec(
-    DeclTypeSpec::Category category) {
-  CHECK(derivedTypeSpec_);
-  SetDeclTypeSpec(DeclTypeSpec{category, *derivedTypeSpec_});
-  return *derivedTypeName_;
+void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) {
+  SetDeclTypeSpec(
+      context().globalScope().MakeDeclTypeSpec(DeclTypeSpec::ClassStar));
 }
-
-void DeclTypeSpecVisitor::BeginDerivedTypeSpec(
-    const parser::Name &name, DerivedTypeSpec &derivedTypeSpec) {
-  CHECK(!derivedTypeSpec_);
-  derivedTypeSpec_ = &derivedTypeSpec;
-  derivedTypeName_ = &name;
+void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) {
+  SetDeclTypeSpec(
+      context().globalScope().MakeDeclTypeSpec(DeclTypeSpec::TypeStar));
 }
 
 // Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet)
 // and save it in declTypeSpec_.
-void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
+void DeclTypeSpecVisitor::SetDeclTypeSpec(DeclTypeSpec &declTypeSpec) {
   CHECK(expectDeclTypeSpec_);
   CHECK(!declTypeSpec_);
-  declTypeSpec_ = std::make_unique<DeclTypeSpec>(declTypeSpec);
+  declTypeSpec_ = &declTypeSpec;
+}
+// Set both the derived type name and corresponding DeclTypeSpec.
+void DeclTypeSpecVisitor::SetDeclTypeSpec(
+    const parser::Name &name, DeclTypeSpec &declTypeSpec) {
+  derivedTypeName_ = &name;
+  SetDeclTypeSpec(declTypeSpec);
 }
 
 int DeclTypeSpecVisitor::GetKindParamValue(
@@ -1465,15 +1444,14 @@ void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
   if (NeedsType(symbol)) {
     if (isImplicitNoneType()) {
       Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
-    } else if (const auto type{GetImplicitType(symbol)}) {
+    } else if (const auto *type{GetImplicitType(symbol)}) {
       symbol.SetType(*type);
     }
   }
 }
-std::optional<const DeclTypeSpec> ScopeHandler::GetImplicitType(
-    Symbol &symbol) {
+const DeclTypeSpec *ScopeHandler::GetImplicitType(Symbol &symbol) {
   auto &name{symbol.name()};
-  const auto type{implicitRules().GetType(name.begin()[0])};
+  const auto *type{implicitRules().GetType(name.begin()[0])};
   if (type) {
     symbol.set(Symbol::Flag::Implicit);
   } else {
@@ -1911,7 +1889,7 @@ void SubprogramVisitor::Post(const parser::StmtFunctionStmt &x) {
 // Return false if it is actually an assignment statement.
 bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
   const auto &name{std::get<parser::Name>(x.t)};
-  std::optional<DeclTypeSpec> resultType;
+  const DeclTypeSpec *resultType{nullptr};
   // Look up name: provides return type or tells us if it's an array
   if (auto *symbol{FindSymbol(name)}) {
     auto *details{symbol->detailsIf<EntityDetails>()};
@@ -2044,7 +2022,7 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   }
   // add function result to function scope
   EntityDetails funcResultDetails;
-  if (auto &type{GetDeclTypeSpec()}) {
+  if (auto *type{GetDeclTypeSpec()}) {
     funcResultDetails.set_type(*type);
   }
   EndDeclTypeSpec();
@@ -2317,7 +2295,7 @@ Symbol &DeclarationVisitor::DeclareUnknownEntity(
     return DeclareObjectEntity(name, attrs);
   } else {
     Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)};
-    if (auto &type{GetDeclTypeSpec()}) {
+    if (auto *type{GetDeclTypeSpec()}) {
       SetType(name, *type);
     }
     if (symbol.attrs().test(Attr::EXTERNAL)) {
@@ -2347,7 +2325,7 @@ Symbol &DeclarationVisitor::DeclareObjectEntity(
     const parser::Name &name, Attrs attrs) {
   Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)};
   if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
-    if (auto &type{GetDeclTypeSpec()}) {
+    if (auto *type{GetDeclTypeSpec()}) {
       SetType(name, *type);
     }
     if (!arraySpec().empty()) {
@@ -2363,23 +2341,27 @@ Symbol &DeclarationVisitor::DeclareObjectEntity(
   return symbol;
 }
 
-void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &x) {
-  if (const auto *symbol{ResolveDerivedType(DeclTypeSpec::TypeDerived)}) {
-    GetDeclTypeSpec()->derivedTypeSpec().set_scope(*symbol->scope());
-  }
-}
 void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Class &x) {
-  if (const auto *symbol{ResolveDerivedType(DeclTypeSpec::ClassDerived)}) {
-    GetDeclTypeSpec()->derivedTypeSpec().set_scope(*symbol->scope());
-  }
+  // created by default with TypeDerived; change to ClassDerived
+  GetDeclTypeSpec()->set_category(DeclTypeSpec::ClassDerived);
+}
+
+bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Record &) {
+  return true;  // TODO
 }
 
 bool DeclarationVisitor::Pre(const parser::DerivedTypeSpec &x) {
-  auto &name{std::get<parser::Name>(x.t)};
-  auto &derivedTypeSpec{currScope().MakeDerivedTypeSpec(name.source)};
-  BeginDerivedTypeSpec(name, derivedTypeSpec);
+  const auto &name{std::get<parser::Name>(x.t)};
+  SetDeclTypeSpec(name,
+      currScope().MakeDeclTypeSpec(DeclTypeSpec::TypeDerived, name.source));
   return true;
 }
+void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
+  if (const auto *symbol{ResolveDerivedType()}) {
+    GetDeclTypeSpec()->derivedTypeSpec().set_scope(*symbol->scope());
+  }
+}
+
 void DeclarationVisitor::Post(const parser::DerivedTypeDef &x) {
   std::set<SourceName> paramNames;
   auto &scope{currScope()};
@@ -2433,24 +2415,24 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
   auto &symbol{MakeSymbol(name, GetAttrs(), DerivedTypeDetails{})};
   PushScope(Scope::Kind::DerivedType, &symbol);
   if (auto *extendsName{derivedTypeInfo_.extends}) {
-    if (auto *extends{ResolveDerivedType(*extendsName)}) {
+    if (auto *extends{ResolveDerivedType(extendsName)}) {
       symbol.get<DerivedTypeDetails>().set_extends(extends);
       // Declare the "parent component"; private if the type is
       if (OkToAddComponent(*extendsName, true)) {
         auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})};
         comp.attrs().set(Attr::PRIVATE, extends->attrs().test(Attr::PRIVATE));
         comp.set(Symbol::Flag::ParentComp);
-        auto &derivedTypeSpec{
-            currScope().MakeDerivedTypeSpec(extendsName->source)};
-        derivedTypeSpec.set_scope(currScope());
-        comp.SetType(DeclTypeSpec{DeclTypeSpec::TypeDerived, derivedTypeSpec});
+        auto &type{currScope().MakeDeclTypeSpec(
+            DeclTypeSpec::TypeDerived, extendsName->source)};
+        type.derivedTypeSpec().set_scope(currScope());
+        comp.SetType(type);
       }
     }
   }
   EndAttrs();
 }
 void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {
-  auto &type{GetDeclTypeSpec()};
+  auto *type{GetDeclTypeSpec()};
   auto attr{std::get<common::TypeParamAttr>(x.t)};
   for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) {
     auto &name{std::get<parser::Name>(decl.t)};
@@ -2534,7 +2516,7 @@ void DeclarationVisitor::Post(const parser::ProcDecl &x) {
     if (auto *symbol{FindExplicitInterface(*interfaceName_)}) {
       interface.set_symbol(*symbol);
     }
-  } else if (auto &type{GetDeclTypeSpec()}) {
+  } else if (auto *type{GetDeclTypeSpec()}) {
     interface.set_type(*type);
   }
   auto attrs{GetAttrs()};
@@ -2601,9 +2583,7 @@ bool DeclarationVisitor::Pre(const parser::AllocateStmt &) {
   return true;
 }
 void DeclarationVisitor::Post(const parser::AllocateStmt &) {
-  if (IsDerivedTypeSpec()) {
-    ResolveDerivedType(DeclTypeSpec::TypeDerived);
-  }
+  ResolveDerivedType();
   EndDeclTypeSpec();
 }
 
@@ -2612,7 +2592,7 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &) {
   return true;
 }
 void DeclarationVisitor::Post(const parser::StructureConstructor &) {
-  ResolveDerivedType(DeclTypeSpec::TypeDerived);
+  ResolveDerivedType();
   EndDeclTypeSpec();
 }
 
@@ -2661,19 +2641,20 @@ void DeclarationVisitor::SetType(
   }
 }
 
-const Symbol *DeclarationVisitor::ResolveDerivedType(
-    DeclTypeSpec::Category category) {
-  return ResolveDerivedType(SetDerivedDeclTypeSpec(category));
-}
-
-// Find the Symbol for this derived type.
-const Symbol *DeclarationVisitor::ResolveDerivedType(const parser::Name &name) {
-  const auto *symbol{FindSymbol(name)};
+// Find the Symbol for this derived type; derivedTypeName if not specified.
+const Symbol *DeclarationVisitor::ResolveDerivedType(const parser::Name *name) {
+  if (name == nullptr) {
+    name = derivedTypeName();
+    if (name == nullptr) {
+      return nullptr;
+    }
+  }
+  const auto *symbol{FindSymbol(*name)};
   if (!symbol) {
-    Say(name, "Derived type '%s' not found"_err_en_US);
+    Say(*name, "Derived type '%s' not found"_err_en_US);
     return nullptr;
   }
-  if (CheckUseError(name)) {
+  if (CheckUseError(*name)) {
     return nullptr;
   }
   if (auto *details{symbol->detailsIf<UseDetails>()}) {
@@ -2685,7 +2666,7 @@ const Symbol *DeclarationVisitor::ResolveDerivedType(const parser::Name &name) {
     }
   }
   if (!symbol->has<DerivedTypeDetails>()) {
-    Say(name, "'%s' is not a derived type"_err_en_US);
+    Say(*name, "'%s' is not a derived type"_err_en_US);
     return nullptr;
   }
   return symbol;

diff --git a/flang/lib/semantics/scope.cc b/flang/lib/semantics/scope.cc
index 44eaf62..a9f2100 100644 (file)
--- a/flang/lib/semantics/scope.cc
+++ b/flang/lib/semantics/scope.cc
@@ -14,6 +14,7 @@
 
 #include "scope.h"
 #include "symbol.h"
+#include <algorithm>
 #include <memory>
 
 namespace Fortran::semantics {
@@ -68,6 +69,30 @@ Scope *Scope::FindSubmodule(const SourceName &name) const {
 bool Scope::AddSubmodule(const SourceName &name, Scope &submodule) {
   return submodules_.emplace(name, &submodule).second;
 }
+DeclTypeSpec &Scope::MakeDeclTypeSpec(TypeCategory category, int kind) {
+  DeclTypeSpec type{IntrinsicTypeSpec{category, kind}};
+  auto it{std::find(declTypeSpecs_.begin(), declTypeSpecs_.end(), type)};
+  if (it != declTypeSpecs_.end()) {
+    return *it;
+  } else {
+    declTypeSpecs_.push_back(type);
+    return declTypeSpecs_.back();
+  }
+}
+DeclTypeSpec &Scope::MakeDeclTypeSpec(
+    DeclTypeSpec::Category category, const SourceName &name) {
+  CHECK(category == DeclTypeSpec::TypeDerived ||
+      category == DeclTypeSpec::ClassDerived);
+  derivedTypeSpecs_.emplace_back(name);
+  declTypeSpecs_.emplace_back(category, derivedTypeSpecs_.back());
+  return declTypeSpecs_.back();
+}
+DeclTypeSpec &Scope::MakeDeclTypeSpec(DeclTypeSpec::Category category) {
+  CHECK(category == DeclTypeSpec::TypeStar ||
+      category == DeclTypeSpec::ClassStar);
+  declTypeSpecs_.emplace_back(category);
+  return declTypeSpecs_.back();
+}
 DerivedTypeSpec &Scope::MakeDerivedTypeSpec(const SourceName &name) {
   derivedTypeSpecs_.emplace_back(name);
   return derivedTypeSpecs_.back();

diff --git a/flang/lib/semantics/scope.h b/flang/lib/semantics/scope.h
index 8892fb7..9809b30 100644 (file)
--- a/flang/lib/semantics/scope.h
+++ b/flang/lib/semantics/scope.h
@@ -121,6 +121,9 @@ public:
   Scope *FindSubmodule(const SourceName &) const;
   bool AddSubmodule(const SourceName &, Scope &);
 
+  DeclTypeSpec &MakeDeclTypeSpec(TypeCategory, int kind);
+  DeclTypeSpec &MakeDeclTypeSpec(DeclTypeSpec::Category, const SourceName &);
+  DeclTypeSpec &MakeDeclTypeSpec(DeclTypeSpec::Category);
   DerivedTypeSpec &MakeDerivedTypeSpec(const SourceName &);
 
   // For modules read from module files, this is the stream of characters
@@ -151,6 +154,7 @@ private:
   std::list<Scope> children_;
   mapType symbols_;
   std::map<SourceName, Scope *> submodules_;
+  std::list<DeclTypeSpec> declTypeSpecs_;
   std::list<DerivedTypeSpec> derivedTypeSpecs_;
   std::string chars_;
   std::optional<ImportKind> importKind_;

diff --git a/flang/lib/semantics/semantics.h b/flang/lib/semantics/semantics.h
index 7cbd49c..3968003 100644 (file)
--- a/flang/lib/semantics/semantics.h
+++ b/flang/lib/semantics/semantics.h
@@ -67,6 +67,13 @@ public:
     return *this;
   }
 
+  DeclTypeSpec &MakeIntrinsicTypeSpec(TypeCategory category, int kind = 0) {
+    if (kind == 0) {
+      kind = defaultKinds_.GetDefaultKind(category);
+    }
+    return globalScope_.MakeDeclTypeSpec(category, kind);
+  }
+
   bool AnyFatalError() const;
   template<typename... A> parser::Message &Say(A... args) {
     return messages_.Say(std::forward<A>(args)...);

diff --git a/flang/lib/semantics/symbol.cc b/flang/lib/semantics/symbol.cc
index 16dd363..418b55d 100644 (file)
--- a/flang/lib/semantics/symbol.cc
+++ b/flang/lib/semantics/symbol.cc
@@ -48,12 +48,12 @@ void ModuleDetails::set_scope(const Scope *scope) {
 
 void EntityDetails::set_type(const DeclTypeSpec &type) {
   CHECK(!type_);
-  type_ = type;
+  type_ = &type;
 }
 
 void ObjectEntityDetails::set_type(const DeclTypeSpec &type) {
   CHECK(!type_);
-  type_ = type;
+  type_ = &type;
 }
 
 void ObjectEntityDetails::set_shape(const ArraySpec &shape) {
@@ -187,16 +187,10 @@ DeclTypeSpec *Symbol::GetType() {
 const DeclTypeSpec *Symbol::GetType() const {
   return std::visit(
       common::visitors{
-          [](const EntityDetails &x) {
-            return x.type().has_value() ? &x.type().value() : nullptr;
-          },
-          [](const ObjectEntityDetails &x) {
-            return x.type().has_value() ? &x.type().value() : nullptr;
-          },
+          [](const EntityDetails &x) { return x.type(); },
+          [](const ObjectEntityDetails &x) { return x.type(); },
           [](const ProcEntityDetails &x) { return x.interface().type(); },
-          [](const TypeParamDetails &x) {
-            return x.type().has_value() ? &x.type().value() : nullptr;
-          },
+          [](const TypeParamDetails &x) { return x.type(); },
           [](const auto &) -> const DeclTypeSpec * { return nullptr; },
       },
       details_);

diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h
index 064b95c..2fc788c 100644 (file)
--- a/flang/lib/semantics/symbol.h
+++ b/flang/lib/semantics/symbol.h
@@ -100,13 +100,13 @@ private:
 class EntityDetails {
 public:
   EntityDetails(bool isDummy = false) : isDummy_{isDummy} {}
-  const std::optional<DeclTypeSpec> &type() const { return type_; }
+  const DeclTypeSpec *type() const { return type_; }
   void set_type(const DeclTypeSpec &type);
   bool isDummy() const { return isDummy_; }
 
 private:
   bool isDummy_;
-  std::optional<DeclTypeSpec> type_;
+  const DeclTypeSpec *type_{nullptr};
   friend std::ostream &operator<<(std::ostream &, const EntityDetails &);
 };
 
@@ -118,7 +118,7 @@ public:
   MaybeExpr &init() { return init_; }
   const MaybeExpr &init() const { return init_; }
   void set_init(MaybeExpr &&expr) { init_ = std::move(expr); }
-  const std::optional<DeclTypeSpec> &type() const { return type_; }
+  const DeclTypeSpec *type() const { return type_; }
   void set_type(const DeclTypeSpec &type);
   ArraySpec &shape() { return shape_; }
   const ArraySpec &shape() const { return shape_; }
@@ -137,7 +137,7 @@ public:
 private:
   bool isDummy_;
   MaybeExpr init_;
-  std::optional<DeclTypeSpec> type_;
+  const DeclTypeSpec *type_{nullptr};
   ArraySpec shape_;
   friend std::ostream &operator<<(std::ostream &, const ObjectEntityDetails &);
 };
@@ -203,16 +203,16 @@ public:
   MaybeExpr &init() { return init_; }
   const MaybeExpr &init() const { return init_; }
   void set_init(MaybeExpr &&expr) { init_ = std::move(expr); }
-  const std::optional<DeclTypeSpec> &type() const { return type_; }
+  const DeclTypeSpec *type() const { return type_; }
   void set_type(const DeclTypeSpec &type) {
     CHECK(!type_);
-    type_ = type;
+    type_ = &type;
   }
 
 private:
   common::TypeParamAttr attr_;
   MaybeExpr init_;
-  std::optional<DeclTypeSpec> type_;
+  const DeclTypeSpec *type_{nullptr};
 };
 
 // Record the USE of a symbol: location is where (USE statement or renaming);

diff --git a/flang/lib/semantics/type.cc b/flang/lib/semantics/type.cc
index 28382a9..3718ea2 100644 (file)
--- a/flang/lib/semantics/type.cc
+++ b/flang/lib/semantics/type.cc
@@ -39,7 +39,7 @@ void DerivedTypeSpec::AddParamValue(
 }
 
 std::ostream &operator<<(std::ostream &o, const DerivedTypeSpec &x) {
-  o << "TYPE(" << x.name().ToString();
+  o << x.name().ToString();
   if (!x.paramValues_.empty()) {
     bool first = true;
     o << '(';
@@ -56,7 +56,7 @@ std::ostream &operator<<(std::ostream &o, const DerivedTypeSpec &x) {
     }
     o << ')';
   }
-  return o << ')';
+  return o;
 }
 
 Bound::Bound(int bound)
@@ -158,9 +158,10 @@ bool DeclTypeSpec::operator==(const DeclTypeSpec &that) const {
 std::ostream &operator<<(std::ostream &o, const DeclTypeSpec &x) {
   switch (x.category()) {
   case DeclTypeSpec::Intrinsic: return o << x.intrinsicTypeSpec();
-  case DeclTypeSpec::TypeDerived: return o << x.derivedTypeSpec();
+  case DeclTypeSpec::TypeDerived:
+    return o << "TYPE(" << x.derivedTypeSpec() << ')';
   case DeclTypeSpec::ClassDerived:
-    return o << "CLASS(" << x.derivedTypeSpec().name().ToString() << ')';
+    return o << "CLASS(" << x.derivedTypeSpec() << ')';
   case DeclTypeSpec::TypeStar: return o << "TYPE(*)";
   case DeclTypeSpec::ClassStar: return o << "CLASS(*)";
   default: CRASH_NO_CASE; return o;
@@ -173,6 +174,6 @@ void ProcInterface::set_symbol(const Symbol &symbol) {
 }
 void ProcInterface::set_type(const DeclTypeSpec &type) {
   CHECK(!symbol_);
-  type_ = type;
+  type_ = &type;
 }
 }

diff --git a/flang/lib/semantics/type.h b/flang/lib/semantics/type.h
index b95f522..a2aa160 100644 (file)
--- a/flang/lib/semantics/type.h
+++ b/flang/lib/semantics/type.h
@@ -167,6 +167,7 @@ private:
 class DerivedTypeSpec {
 public:
   using listType = std::list<std::pair<std::optional<SourceName>, ParamValue>>;
+  DerivedTypeSpec &operator=(const DerivedTypeSpec &) = delete;
   explicit DerivedTypeSpec(const SourceName &name) : name_{name} {}
   DerivedTypeSpec() = delete;
   const SourceName &name() const { return name_; }
@@ -203,6 +204,7 @@ public:
   const IntrinsicTypeSpec &intrinsicTypeSpec() const;
   DerivedTypeSpec &derivedTypeSpec();
   const DerivedTypeSpec &derivedTypeSpec() const;
+  void set_category(Category category) { category_ = category; }
 
 private:
   Category category_;
@@ -223,13 +225,13 @@ std::ostream &operator<<(std::ostream &, const DeclTypeSpec &);
 class ProcInterface {
 public:
   const Symbol *symbol() const { return symbol_; }
-  const DeclTypeSpec *type() const { return type_ ? &*type_ : nullptr; }
+  const DeclTypeSpec *type() const { return type_; }
   void set_symbol(const Symbol &symbol);
   void set_type(const DeclTypeSpec &type);
 
 private:
   const Symbol *symbol_{nullptr};
-  std::optional<DeclTypeSpec> type_;
+  const DeclTypeSpec *type_{nullptr};
 };
 }
 

diff --git a/flang/test/semantics/modfile12.f90 b/flang/test/semantics/modfile12.f90
index 8c08970..0a1dd80 100644 (file)
--- a/flang/test/semantics/modfile12.f90
+++ b/flang/test/semantics/modfile12.f90
@@ -22,6 +22,9 @@ module m
     integer, len :: d = a + b
   end type
   type(t(a+3,:)), allocatable :: z
+  class(t(a+4,:)), allocatable :: z2
+  type(*), allocatable :: z3
+  class(*), allocatable :: z4
   real*2 :: f
   complex*32 :: g
   type t2(i, j, h)
@@ -52,6 +55,9 @@ end
 !    integer(4),len::d=3_8
 !  end type
 !  type(t(4_4,:)),allocatable::z
+!  class(t(5_4,:)),allocatable::z2
+!  type(*),allocatable::z3
+!  class(*),allocatable::z4
 !  real(2)::f
 !  complex(16)::g
 !  type::t2(i,j,h)