diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 46aceb3eaf2f..e8ee22a2b60c 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -1892,8 +1892,8 @@ static void FixMisparsedFunctionReference( CHECK(derivedType->has()); auto &scope{context.FindScope(name->source)}; const semantics::DeclTypeSpec &type{ - scope.FindOrInstantiateDerivedType( - semantics::DerivedTypeSpec{*derivedType}, context)}; + semantics::FindOrInstantiateDerivedType( + scope, semantics::DerivedTypeSpec{*derivedType}, context)}; u = funcRef.ConvertToStructureConstructor(type.derivedTypeSpec()); } else { common::die( diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 58fa73c39cbd..9758a388c092 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -2954,7 +2954,7 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) { } auto category{GetDeclTypeSpecCategory()}; - spec.ProcessParameterExpressions(context().foldingContext()); + ProcessParameterExpressions(spec, context().foldingContext()); if (const DeclTypeSpec * extant{currScope().FindInstantiatedDerivedType(spec, category)}) { // This derived type and parameter expressions (if any) are already present @@ -2973,7 +2973,7 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) { // clone its contents, specialize them with the actual type parameter // values, and check constraints. auto save{GetFoldingContext().messages().SetLocation(*currStmtSource())}; - type.derivedTypeSpec().Instantiate(currScope(), context()); + InstantiateDerivedType(type.derivedTypeSpec(), currScope(), context()); } SetDeclTypeSpec(type); } diff --git a/flang/lib/semantics/scope.cc b/flang/lib/semantics/scope.cc index 08289f256031..2a37014edc6e 100644 --- a/flang/lib/semantics/scope.cc +++ b/flang/lib/semantics/scope.cc @@ -13,13 +13,12 @@ // limitations under the License. #include "scope.h" -#include "semantics.h" #include "symbol.h" #include "type.h" -#include "../evaluate/fold.h" #include "../parser/characters.h" #include #include +#include namespace Fortran::semantics { @@ -123,6 +122,11 @@ bool Scope::AddSubmodule(const SourceName &name, Scope &submodule) { return submodules_.emplace(name, &submodule).second; } +const DeclTypeSpec *Scope::FindType(const DeclTypeSpec &type) const { + auto it{std::find(declTypeSpecs_.begin(), declTypeSpecs_.end(), type)}; + return it != declTypeSpecs_.end() ? &*it : nullptr; +} + const DeclTypeSpec &Scope::MakeNumericType( TypeCategory category, KindExpr &&kind) { return MakeLengthlessType(NumericTypeSpec{category, std::move(kind)}); @@ -139,12 +143,8 @@ const DeclTypeSpec &Scope::MakeClassStarType() { // Types that can't have length parameters can be reused without having to // compare length expressions. They are stored in the global scope. const DeclTypeSpec &Scope::MakeLengthlessType(DeclTypeSpec &&type) { - auto it{std::find(declTypeSpecs_.begin(), declTypeSpecs_.end(), type)}; - if (it != declTypeSpecs_.end()) { - return *it; - } else { - return declTypeSpecs_.emplace_back(std::move(type)); - } + const auto *found{FindType(type)}; + return found ? *found : declTypeSpecs_.emplace_back(std::move(type)); } const DeclTypeSpec &Scope::MakeCharacterType( @@ -300,75 +300,12 @@ bool Scope::IsParameterizedDerivedType() const { const DeclTypeSpec *Scope::FindInstantiatedDerivedType( const DerivedTypeSpec &spec, DeclTypeSpec::Category category) const { DeclTypeSpec type{category, spec}; - auto typeIter{std::find(declTypeSpecs_.begin(), declTypeSpecs_.end(), type)}; - if (typeIter != declTypeSpecs_.end()) { - return &*typeIter; - } - if (&parent_ == this) { + if (const auto *result{FindType(type)}) { + return result; + } else if (kind() == Kind::Global) { return nullptr; - } - return parent_.FindInstantiatedDerivedType(spec, category); -} - -const DeclTypeSpec &Scope::FindOrInstantiateDerivedType(DerivedTypeSpec &&spec, - SemanticsContext &semanticsContext, DeclTypeSpec::Category category) { - spec.ProcessParameterExpressions(semanticsContext.foldingContext()); - if (const DeclTypeSpec * type{FindInstantiatedDerivedType(spec, category)}) { - return *type; - } - // Create a new instantiation of this parameterized derived type - // for this particular distinct set of actual parameter values. - DeclTypeSpec &type{MakeDerivedType(std::move(spec), category)}; - type.derivedTypeSpec().Instantiate(*this, semanticsContext); - return type; -} - -Scope &Scope::InstantiateDerivedType( - const Scope &from, SemanticsContext &semanticsContext) { - CHECK(from.kind_ == Kind::DerivedType); - sourceRange_ = from.sourceRange_; - chars_ = from.chars_; - for (const auto &pair : from.symbols_) { - pair.second->Instantiate(*this, semanticsContext); - } - return *this; -} - -const DeclTypeSpec &Scope::InstantiateIntrinsicType( - const DeclTypeSpec &spec, SemanticsContext &semanticsContext) { - const IntrinsicTypeSpec *intrinsic{spec.AsIntrinsic()}; - CHECK(intrinsic != nullptr); - if (evaluate::ToInt64(intrinsic->kind()).has_value()) { - return spec; // KIND is already a known constant - } - // The expression was not originally constant, but now it must be so - // in the context of a parameterized derived type instantiation. - KindExpr copy{intrinsic->kind()}; - evaluate::FoldingContext &foldingContext{semanticsContext.foldingContext()}; - copy = evaluate::Fold(foldingContext, std::move(copy)); - int kind{semanticsContext.GetDefaultKind(intrinsic->category())}; - if (auto value{evaluate::ToInt64(copy)}) { - if (evaluate::IsValidKindOfIntrinsicType(intrinsic->category(), *value)) { - kind = *value; - } else { - foldingContext.messages().Say( - "KIND parameter value (%jd) of intrinsic type %s " - "did not resolve to a supported value"_err_en_US, - static_cast(*value), - parser::ToUpperCaseLetters( - common::EnumToString(intrinsic->category()))); - } - } - switch (spec.category()) { - case DeclTypeSpec::Numeric: - return declTypeSpecs_.emplace_back( - NumericTypeSpec{intrinsic->category(), KindExpr{kind}}); - case DeclTypeSpec::Logical: - return declTypeSpecs_.emplace_back(LogicalTypeSpec{KindExpr{kind}}); - case DeclTypeSpec::Character: - return declTypeSpecs_.emplace_back(CharacterTypeSpec{ - ParamValue{spec.characterTypeSpec().length()}, KindExpr{kind}}); - default: CRASH_NO_CASE; + } else { + return parent().FindInstantiatedDerivedType(spec, category); } } diff --git a/flang/lib/semantics/scope.h b/flang/lib/semantics/scope.h index 605119f0b6cb..dba756502312 100644 --- a/flang/lib/semantics/scope.h +++ b/flang/lib/semantics/scope.h @@ -23,12 +23,12 @@ #include "../parser/provenance.h" #include #include +#include #include #include namespace Fortran::semantics { -class SemanticsContext; using namespace parser::literals; using common::ConstantSubscript; @@ -162,6 +162,7 @@ public: Scope *FindSubmodule(const SourceName &) const; bool AddSubmodule(const SourceName &, Scope &); + const DeclTypeSpec *FindType(const DeclTypeSpec &) const; const DeclTypeSpec &MakeNumericType(TypeCategory, KindExpr &&kind); const DeclTypeSpec &MakeLogicalType(KindExpr &&kind); const DeclTypeSpec &MakeCharacterType( @@ -203,17 +204,6 @@ public: const DeclTypeSpec *FindInstantiatedDerivedType(const DerivedTypeSpec &, DeclTypeSpec::Category = DeclTypeSpec::TypeDerived) const; - // Returns a matching derived type instance if one exists, otherwise - // creates one - const DeclTypeSpec &FindOrInstantiateDerivedType(DerivedTypeSpec &&, - SemanticsContext &, DeclTypeSpec::Category = DeclTypeSpec::TypeDerived); - - // Clones a DerivedType scope for a new instance from the type definition. - Scope &InstantiateDerivedType(const Scope &, SemanticsContext &); - - const DeclTypeSpec &InstantiateIntrinsicType( - const DeclTypeSpec &, SemanticsContext &); - bool IsModuleFile() const { return kind_ == Kind::Module && symbol_ != nullptr && symbol_->test(Symbol::Flag::ModFile); diff --git a/flang/lib/semantics/symbol.cc b/flang/lib/semantics/symbol.cc index 98f9f605da5c..603d60d6185b 100644 --- a/flang/lib/semantics/symbol.cc +++ b/flang/lib/semantics/symbol.cc @@ -14,9 +14,7 @@ #include "symbol.h" #include "scope.h" -#include "semantics.h" #include "../common/idioms.h" -#include "../evaluate/fold.h" #include #include @@ -526,93 +524,6 @@ std::ostream &DumpForUnparse( return os; } -Symbol &Symbol::Instantiate( - Scope &scope, SemanticsContext &semanticsContext) const { - evaluate::FoldingContext foldingContext{semanticsContext.foldingContext()}; - CHECK(foldingContext.pdtInstance() != nullptr); - const DerivedTypeSpec &instanceSpec{*foldingContext.pdtInstance()}; - auto pair{scope.try_emplace(name_, attrs_)}; - Symbol &symbol{*pair.first->second}; - if (!pair.second) { - // Symbol was already present in the scope, which can only happen - // in the case of type parameters. - CHECK(has()); - return symbol; - } - symbol.attrs_ = attrs_; - symbol.flags_ = flags_; - std::visit( - common::visitors{ - [&](const ObjectEntityDetails &that) { - symbol.details_ = that; - ObjectEntityDetails &details{symbol.get()}; - if (DeclTypeSpec * origType{symbol.GetType()}) { - if (const DerivedTypeSpec * derived{origType->AsDerived()}) { - DerivedTypeSpec newSpec{*derived}; - if (test(Flag::ParentComp)) { - // Forward any explicit type parameter values from the - // derived type spec under instantiation to its parent - // component derived type spec that define type parameters - // of the parent component. - for (const auto &pair : instanceSpec.parameters()) { - if (scope.find(pair.first) == scope.end()) { - newSpec.AddParamValue( - pair.first, ParamValue{pair.second}); - } - } - } - details.ReplaceType( - scope.FindOrInstantiateDerivedType(std::move(newSpec), - semanticsContext, origType->category())); - } else if (origType->AsIntrinsic() != nullptr) { - const DeclTypeSpec &newType{scope.InstantiateIntrinsicType( - *origType, semanticsContext)}; - details.ReplaceType(newType); - } else if (origType->category() != DeclTypeSpec::ClassStar) { - common::die("instantiated component has type that is " - "neither intrinsic, derived, nor CLASS(*)"); - } - } - details.set_init( - evaluate::Fold(foldingContext, std::move(details.init()))); - for (ShapeSpec &dim : details.shape()) { - if (dim.lbound().isExplicit()) { - dim.lbound().SetExplicit(Fold( - foldingContext, std::move(dim.lbound().GetExplicit()))); - } - if (dim.ubound().isExplicit()) { - dim.ubound().SetExplicit(Fold( - foldingContext, std::move(dim.ubound().GetExplicit()))); - } - } - for (ShapeSpec &dim : details.coshape()) { - if (dim.lbound().isExplicit()) { - dim.lbound().SetExplicit(Fold( - foldingContext, std::move(dim.lbound().GetExplicit()))); - } - if (dim.ubound().isExplicit()) { - dim.ubound().SetExplicit(Fold( - foldingContext, std::move(dim.ubound().GetExplicit()))); - } - } - }, - [&](const ProcBindingDetails &that) { symbol.details_ = that; }, - [&](const GenericBindingDetails &that) { symbol.details_ = that; }, - [&](const ProcEntityDetails &that) { symbol.details_ = that; }, - [&](const FinalProcDetails &that) { symbol.details_ = that; }, - [&](const TypeParamDetails &that) { - // LEN type parameter, or error recovery on a KIND type parameter - // with no corresponding actual argument or default - symbol.details_ = that; - }, - [&](const auto &that) { - common::die("unexpected details in Symbol::Instantiate"); - }, - }, - details_); - return symbol; -} - const DerivedTypeSpec *Symbol::GetParentTypeSpec(const Scope *scope) const { if (const Symbol * parentComponent{GetParentComponent(scope)}) { const auto &object{parentComponent->get()}; diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h index a451dba79ce1..dc853454824b 100644 --- a/flang/lib/semantics/symbol.h +++ b/flang/lib/semantics/symbol.h @@ -30,7 +30,6 @@ namespace Fortran::semantics { /// *Details classes. class Scope; -class SemanticsContext; class Symbol; using SymbolVector = std::vector; @@ -610,9 +609,6 @@ public: details_); } - // Clones the Symbol in the context of a parameterized derived type instance - Symbol &Instantiate(Scope &, SemanticsContext &) const; - // If there is a parent component, return a pointer to its derived type spec. // The Scope * argument defaults to this->scope_ but should be overridden // for a parameterized derived type instantiation with the instance's scope. diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc index d2adc6f8660b..de6e8ec0700b 100644 --- a/flang/lib/semantics/tools.cc +++ b/flang/lib/semantics/tools.cc @@ -401,13 +401,267 @@ bool IsFinalizable(const Symbol &symbol) { return false; } -bool IsCoarray(const Symbol &symbol) { - return symbol.Corank() > 0; -} +bool IsCoarray(const Symbol &symbol) { return symbol.Corank() > 0; } bool IsAssumedSizeArray(const Symbol &symbol) { const auto *details{symbol.detailsIf()}; return details && details->IsAssumedSize(); } +static const DeclTypeSpec &InstantiateIntrinsicType(Scope &scope, + const DeclTypeSpec &spec, SemanticsContext &semanticsContext) { + const IntrinsicTypeSpec *intrinsic{spec.AsIntrinsic()}; + CHECK(intrinsic != nullptr); + if (evaluate::ToInt64(intrinsic->kind()).has_value()) { + return spec; // KIND is already a known constant + } + // The expression was not originally constant, but now it must be so + // in the context of a parameterized derived type instantiation. + KindExpr copy{intrinsic->kind()}; + evaluate::FoldingContext &foldingContext{semanticsContext.foldingContext()}; + copy = evaluate::Fold(foldingContext, std::move(copy)); + int kind{semanticsContext.GetDefaultKind(intrinsic->category())}; + if (auto value{evaluate::ToInt64(copy)}) { + if (evaluate::IsValidKindOfIntrinsicType(intrinsic->category(), *value)) { + kind = *value; + } else { + foldingContext.messages().Say( + "KIND parameter value (%jd) of intrinsic type %s " + "did not resolve to a supported value"_err_en_US, + static_cast(*value), + parser::ToUpperCaseLetters( + common::EnumToString(intrinsic->category()))); + } + } + switch (spec.category()) { + case DeclTypeSpec::Numeric: + return scope.MakeNumericType(intrinsic->category(), KindExpr{kind}); + case DeclTypeSpec::Logical: // + return scope.MakeLogicalType(KindExpr{kind}); + case DeclTypeSpec::Character: + return scope.MakeCharacterType( + ParamValue{spec.characterTypeSpec().length()}, KindExpr{kind}); + default: CRASH_NO_CASE; + } +} + +static const DeclTypeSpec *FindInstantiatedDerivedType(const Scope &scope, + const DerivedTypeSpec &spec, DeclTypeSpec::Category category) { + DeclTypeSpec type{category, spec}; + if (const auto *found{scope.FindType(type)}) { + return found; + } else if (scope.kind() == Scope::Kind::Global) { + return nullptr; + } else { + return FindInstantiatedDerivedType(scope.parent(), spec, category); + } +} + +static Symbol &InstantiateSymbol(const Symbol &, Scope &, SemanticsContext &); + +void InstantiateDerivedType(DerivedTypeSpec &spec, Scope &containingScope, + SemanticsContext &semanticsContext) { + Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)}; + newScope.set_derivedTypeSpec(spec); + spec.ReplaceScope(newScope); + const Symbol &typeSymbol{spec.typeSymbol()}; + const Scope *typeScope{typeSymbol.scope()}; + CHECK(typeScope != nullptr); + const auto &typeDetails{typeSymbol.get()}; + for (const Symbol *symbol : + typeDetails.OrderParameterDeclarations(typeSymbol)) { + const SourceName &name{symbol->name()}; + if (typeScope->find(symbol->name()) != typeScope->end()) { + // This type parameter belongs to the derived type itself, not to + // one of its parents. Put the type parameter expression value + // into the new scope as the initialization value for the parameter. + if (ParamValue * paramValue{spec.FindParameter(name)}) { + const TypeParamDetails &details{symbol->get()}; + paramValue->set_attr(details.attr()); + if (MaybeIntExpr expr{paramValue->GetExplicit()}) { + // Ensure that any kind type parameters with values are + // constant by now. + if (details.attr() == common::TypeParamAttr::Kind) { + // Any errors in rank and type will have already elicited + // messages, so don't pile on by complaining further here. + if (auto maybeDynamicType{expr->GetType()}) { + if (expr->Rank() == 0 && + maybeDynamicType->category() == TypeCategory::Integer) { + if (!evaluate::ToInt64(*expr).has_value()) { + std::stringstream fortran; + fortran << *expr; + if (auto *msg{ + semanticsContext.foldingContext().messages().Say( + "Value of kind type parameter '%s' (%s) is not " + "a scalar INTEGER constant"_err_en_US, + name, fortran.str())}) { + msg->Attach(name, "declared here"_en_US); + } + } + } + } + } + TypeParamDetails instanceDetails{details.attr()}; + if (const DeclTypeSpec * type{details.type()}) { + instanceDetails.set_type(*type); + } + instanceDetails.set_init(std::move(*expr)); + Symbol *parameter{ + newScope.try_emplace(name, std::move(instanceDetails)) + .first->second}; + CHECK(parameter != nullptr); + } + } + } + } + // Instantiate every non-parameter symbol from the original derived + // type's scope into the new instance. + auto restorer{semanticsContext.foldingContext().WithPDTInstance(spec)}; + newScope.AddSourceRange(typeScope->sourceRange()); + for (const auto &pair : *typeScope) { + const Symbol &symbol{*pair.second}; + InstantiateSymbol(symbol, newScope, semanticsContext); + } +} + +void ProcessParameterExpressions( + DerivedTypeSpec &spec, evaluate::FoldingContext &foldingContext) { + const Symbol &typeSymbol{spec.typeSymbol()}; + const DerivedTypeDetails &typeDetails{typeSymbol.get()}; + auto paramDecls{typeDetails.OrderParameterDeclarations(typeSymbol)}; + // Fold the explicit type parameter value expressions first. Do not + // fold them within the scope of the derived type being instantiated; + // these expressions cannot use its type parameters. Convert the values + // of the expressions to the declared types of the type parameters. + for (const Symbol *symbol : paramDecls) { + const SourceName &name{symbol->name()}; + if (ParamValue * paramValue{spec.FindParameter(name)}) { + if (const MaybeIntExpr & expr{paramValue->GetExplicit()}) { + if (auto converted{evaluate::ConvertToType(*symbol, SomeExpr{*expr})}) { + SomeExpr folded{ + evaluate::Fold(foldingContext, std::move(*converted))}; + if (auto *intExpr{std::get_if(&folded.u)}) { + paramValue->SetExplicit(std::move(*intExpr)); + continue; + } + } + std::stringstream fortran; + fortran << *expr; + if (auto *msg{foldingContext.messages().Say( + "Value of type parameter '%s' (%s) is not " + "convertible to its type"_err_en_US, + name, fortran.str())}) { + msg->Attach(name, "declared here"_en_US); + } + } + } + } + // Type parameter default value expressions are folded in declaration order + // within the scope of the derived type so that the values of earlier type + // parameters are available for use in the default initialization + // expressions of later parameters. + auto restorer{foldingContext.WithPDTInstance(spec)}; + for (const Symbol *symbol : paramDecls) { + const SourceName &name{symbol->name()}; + const TypeParamDetails &details{symbol->get()}; + MaybeIntExpr expr; + ParamValue *paramValue{spec.FindParameter(name)}; + if (paramValue == nullptr) { + expr = evaluate::Fold(foldingContext, common::Clone(details.init())); + } else if (paramValue->isExplicit()) { + expr = paramValue->GetExplicit(); + } + if (expr.has_value()) { + if (paramValue != nullptr) { + paramValue->SetExplicit(std::move(*expr)); + } else { + spec.AddParamValue(symbol->name(), ParamValue{std::move(*expr)}); + } + } + } +} + +const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope, + DerivedTypeSpec &&spec, SemanticsContext &semanticsContext, + DeclTypeSpec::Category category) { + ProcessParameterExpressions(spec, semanticsContext.foldingContext()); + if (const DeclTypeSpec * + type{FindInstantiatedDerivedType(scope, spec, category)}) { + return *type; + } + // Create a new instantiation of this parameterized derived type + // for this particular distinct set of actual parameter values. + DeclTypeSpec &type{scope.MakeDerivedType(std::move(spec), category)}; + InstantiateDerivedType(type.derivedTypeSpec(), scope, semanticsContext); + return type; +} + +// Clone a Symbol in the context of a parameterized derived type instance +static Symbol &InstantiateSymbol( + const Symbol &symbol, Scope &scope, SemanticsContext &semanticsContext) { + evaluate::FoldingContext foldingContext{semanticsContext.foldingContext()}; + CHECK(foldingContext.pdtInstance() != nullptr); + const DerivedTypeSpec &instanceSpec{*foldingContext.pdtInstance()}; + auto pair{scope.try_emplace(symbol.name(), symbol.attrs())}; + Symbol &result{*pair.first->second}; + if (!pair.second) { + // Symbol was already present in the scope, which can only happen + // in the case of type parameters. + CHECK(symbol.has()); + return result; + } + result.attrs() = symbol.attrs(); + result.flags() = symbol.flags(); + result.set_details(common::Clone(symbol.details())); + if (auto *details{result.detailsIf()}) { + if (DeclTypeSpec * origType{result.GetType()}) { + if (const DerivedTypeSpec * derived{origType->AsDerived()}) { + DerivedTypeSpec newSpec{*derived}; + if (symbol.test(Symbol::Flag::ParentComp)) { + // Forward any explicit type parameter values from the + // derived type spec under instantiation to its parent + // component derived type spec that define type parameters + // of the parent component. + for (const auto &pair : instanceSpec.parameters()) { + if (scope.find(pair.first) == scope.end()) { + newSpec.AddParamValue(pair.first, ParamValue{pair.second}); + } + } + } + details->ReplaceType(FindOrInstantiateDerivedType( + scope, std::move(newSpec), semanticsContext, origType->category())); + } else if (origType->AsIntrinsic() != nullptr) { + details->ReplaceType( + InstantiateIntrinsicType(scope, *origType, semanticsContext)); + } else if (origType->category() != DeclTypeSpec::ClassStar) { + DIE("instantiated component has type that is " + "neither intrinsic, derived, nor CLASS(*)"); + } + } + details->set_init( + evaluate::Fold(foldingContext, std::move(details->init()))); + for (ShapeSpec &dim : details->shape()) { + if (dim.lbound().isExplicit()) { + dim.lbound().SetExplicit( + Fold(foldingContext, std::move(dim.lbound().GetExplicit()))); + } + if (dim.ubound().isExplicit()) { + dim.ubound().SetExplicit( + Fold(foldingContext, std::move(dim.ubound().GetExplicit()))); + } + } + for (ShapeSpec &dim : details->coshape()) { + if (dim.lbound().isExplicit()) { + dim.lbound().SetExplicit( + Fold(foldingContext, std::move(dim.lbound().GetExplicit()))); + } + if (dim.ubound().isExplicit()) { + dim.ubound().SetExplicit( + Fold(foldingContext, std::move(dim.ubound().GetExplicit()))); + } + } + } + return result; +} + } diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h index b4de448e244c..6420ac57b1a8 100644 --- a/flang/lib/semantics/tools.h +++ b/flang/lib/semantics/tools.h @@ -103,6 +103,14 @@ bool IsFinalizable(const Symbol &symbol); bool IsCoarray(const Symbol &symbol); bool IsAssumedSizeArray(const Symbol &symbol); +// Create a new instantiation of this parameterized derived type +// for this particular distinct set of actual parameter values. +void InstantiateDerivedType(DerivedTypeSpec &, Scope &, SemanticsContext &); +// Return an existing or new derived type instance +const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &, DerivedTypeSpec &&, + SemanticsContext &, DeclTypeSpec::Category = DeclTypeSpec::TypeDerived); +void ProcessParameterExpressions(DerivedTypeSpec &, evaluate::FoldingContext &); + // Determines whether an object might be visible outside a // PURE function (C1594); returns a non-null Symbol pointer for // diagnostic purposes if so. diff --git a/flang/lib/semantics/type.cc b/flang/lib/semantics/type.cc index 815e0f3fac94..33876ed91a77 100644 --- a/flang/lib/semantics/type.cc +++ b/flang/lib/semantics/type.cc @@ -13,14 +13,9 @@ // limitations under the License. #include "type.h" -#include "expression.h" #include "scope.h" -#include "semantics.h" #include "symbol.h" -#include "../common/restorer.h" #include "../evaluate/fold.h" -#include "../evaluate/tools.h" -#include "../evaluate/type.h" #include "../parser/characters.h" #include #include @@ -38,6 +33,9 @@ DerivedTypeSpec::DerivedTypeSpec(DerivedTypeSpec &&that) void DerivedTypeSpec::set_scope(const Scope &scope) { CHECK(!scope_); + ReplaceScope(scope); +} +void DerivedTypeSpec::ReplaceScope(const Scope &scope) { CHECK(scope.kind() == Scope::Kind::DerivedType); scope_ = &scope; } @@ -54,127 +52,6 @@ ParamValue *DerivedTypeSpec::FindParameter(SourceName target) { const_cast(this)->FindParameter(target)); } -void DerivedTypeSpec::ProcessParameterExpressions( - evaluate::FoldingContext &foldingContext) { - const DerivedTypeDetails &typeDetails{typeSymbol_.get()}; - auto paramDecls{typeDetails.OrderParameterDeclarations(typeSymbol_)}; - // Fold the explicit type parameter value expressions first. Do not - // fold them within the scope of the derived type being instantiated; - // these expressions cannot use its type parameters. Convert the values - // of the expressions to the declared types of the type parameters. - for (const Symbol *symbol : paramDecls) { - const SourceName &name{symbol->name()}; - if (ParamValue * paramValue{FindParameter(name)}) { - if (const MaybeIntExpr & expr{paramValue->GetExplicit()}) { - if (auto converted{evaluate::ConvertToType(*symbol, SomeExpr{*expr})}) { - SomeExpr folded{ - evaluate::Fold(foldingContext, std::move(*converted))}; - if (auto *intExpr{std::get_if(&folded.u)}) { - paramValue->SetExplicit(std::move(*intExpr)); - continue; - } - } - std::stringstream fortran; - fortran << *expr; - if (auto *msg{foldingContext.messages().Say( - "Value of type parameter '%s' (%s) is not " - "convertible to its type"_err_en_US, - name, fortran.str())}) { - msg->Attach(name, "declared here"_en_US); - } - } - } - } - // Type parameter default value expressions are folded in declaration order - // within the scope of the derived type so that the values of earlier type - // parameters are available for use in the default initialization - // expressions of later parameters. - auto restorer{foldingContext.WithPDTInstance(*this)}; - for (const Symbol *symbol : paramDecls) { - const SourceName &name{symbol->name()}; - const TypeParamDetails &details{symbol->get()}; - MaybeIntExpr expr; - ParamValue *paramValue{FindParameter(name)}; - if (paramValue != nullptr) { - if (paramValue->isExplicit()) { - expr = paramValue->GetExplicit(); - } else { - continue; // deferred or assumed parameter: don't use default value - } - } else { - expr = evaluate::Fold(foldingContext, common::Clone(details.init())); - } - if (expr.has_value()) { - if (paramValue != nullptr) { - paramValue->SetExplicit(std::move(*expr)); - } else { - AddParamValue(symbol->name(), ParamValue{std::move(*expr)}); - } - } - } -} - -Scope &DerivedTypeSpec::Instantiate( - Scope &containingScope, SemanticsContext &semanticsContext) { - Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)}; - newScope.set_derivedTypeSpec(*this); - scope_ = &newScope; - const Scope *typeScope{typeSymbol_.scope()}; - CHECK(typeScope != nullptr); - const DerivedTypeDetails &typeDetails{typeSymbol_.get()}; - for (const Symbol *symbol : - typeDetails.OrderParameterDeclarations(typeSymbol_)) { - const SourceName &name{symbol->name()}; - if (typeScope->find(symbol->name()) != typeScope->end()) { - // This type parameter belongs to the derived type itself, not to - // one of its parents. Put the type parameter expression value - // into the new scope as the initialization value for the parameter. - if (ParamValue * paramValue{FindParameter(name)}) { - const TypeParamDetails &details{symbol->get()}; - paramValue->set_attr(details.attr()); - if (MaybeIntExpr expr{paramValue->GetExplicit()}) { - // Ensure that any kind type parameters with values are - // constant by now. - if (details.attr() == common::TypeParamAttr::Kind) { - // Any errors in rank and type will have already elicited - // messages, so don't pile on by complaining further here. - if (auto maybeDynamicType{expr->GetType()}) { - if (expr->Rank() == 0 && - maybeDynamicType->category() == TypeCategory::Integer) { - if (!evaluate::ToInt64(*expr).has_value()) { - std::stringstream fortran; - fortran << *expr; - if (auto *msg{ - semanticsContext.foldingContext().messages().Say( - "Value of kind type parameter '%s' (%s) is not " - "a scalar INTEGER constant"_err_en_US, - name, fortran.str())}) { - msg->Attach(name, "declared here"_en_US); - } - } - } - } - } - TypeParamDetails instanceDetails{details.attr()}; - if (const DeclTypeSpec * type{details.type()}) { - instanceDetails.set_type(*type); - } - instanceDetails.set_init(std::move(*expr)); - Symbol *parameter{ - newScope.try_emplace(name, std::move(instanceDetails)) - .first->second}; - CHECK(parameter != nullptr); - } - } - } - } - // Instantiate every non-parameter symbol from the original derived - // type's scope into the new instance. - auto restorer{semanticsContext.foldingContext().WithPDTInstance(*this)}; - newScope.InstantiateDerivedType(*typeScope, semanticsContext); - return newScope; -} - std::string DerivedTypeSpec::AsFortran() const { std::stringstream ss; ss << typeSymbol_.name().ToString(); diff --git a/flang/lib/semantics/type.h b/flang/lib/semantics/type.h index 224140565c26..a1d863a19702 100644 --- a/flang/lib/semantics/type.h +++ b/flang/lib/semantics/type.h @@ -33,15 +33,10 @@ namespace Fortran::parser { struct Expr; } -namespace Fortran::evaluate { -class FoldingContext; -} - namespace Fortran::semantics { class Scope; class Symbol; -class SemanticsContext; class ExprResolver; /// A SourceName is a name in the cooked character stream, @@ -231,6 +226,7 @@ public: const Symbol &typeSymbol() const { return typeSymbol_; } const Scope *scope() const { return scope_; } void set_scope(const Scope &); + void ReplaceScope(const Scope &); const std::map ¶meters() const { return parameters_; } @@ -246,8 +242,6 @@ public: return nullptr; } } - void ProcessParameterExpressions(evaluate::FoldingContext &); - Scope &Instantiate(Scope &, SemanticsContext &); bool operator==(const DerivedTypeSpec &that) const { return &typeSymbol_ == &that.typeSymbol_ && parameters_ == that.parameters_; }