CHECK(derivedType->has<semantics::DerivedTypeDetails>());
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(
}
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
// 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);
}
// 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 <algorithm>
#include <memory>
+#include <sstream>
namespace Fortran::semantics {
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)});
// 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(
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<std::intmax_t>(*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);
}
}
#include "../parser/provenance.h"
#include <list>
#include <map>
+#include <optional>
#include <set>
#include <string>
namespace Fortran::semantics {
-class SemanticsContext;
using namespace parser::literals;
using common::ConstantSubscript;
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(
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);
#include "symbol.h"
#include "scope.h"
-#include "semantics.h"
#include "../common/idioms.h"
-#include "../evaluate/fold.h"
#include <ostream>
#include <string>
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<TypeParamDetails>());
- return symbol;
- }
- symbol.attrs_ = attrs_;
- symbol.flags_ = flags_;
- std::visit(
- common::visitors{
- [&](const ObjectEntityDetails &that) {
- symbol.details_ = that;
- ObjectEntityDetails &details{symbol.get<ObjectEntityDetails>()};
- 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<ObjectEntityDetails>()};
/// *Details classes.
class Scope;
-class SemanticsContext;
class Symbol;
using SymbolVector = std::vector<const Symbol *>;
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.
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<ObjectEntityDetails>()};
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<std::intmax_t>(*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<DerivedTypeDetails>()};
+ 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<TypeParamDetails>()};
+ 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<DerivedTypeDetails>()};
+ 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<SomeIntExpr>(&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<TypeParamDetails>()};
+ 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<TypeParamDetails>());
+ return result;
+ }
+ result.attrs() = symbol.attrs();
+ result.flags() = symbol.flags();
+ result.set_details(common::Clone(symbol.details()));
+ if (auto *details{result.detailsIf<ObjectEntityDetails>()}) {
+ 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;
+}
+
}
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.
// 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 <algorithm>
#include <sstream>
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;
}
const_cast<const DerivedTypeSpec *>(this)->FindParameter(target));
}
-void DerivedTypeSpec::ProcessParameterExpressions(
- evaluate::FoldingContext &foldingContext) {
- const DerivedTypeDetails &typeDetails{typeSymbol_.get<DerivedTypeDetails>()};
- 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<SomeIntExpr>(&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<TypeParamDetails>()};
- 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<DerivedTypeDetails>()};
- 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<TypeParamDetails>()};
- 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();
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,
const Symbol &typeSymbol() const { return typeSymbol_; }
const Scope *scope() const { return scope_; }
void set_scope(const Scope &);
+ void ReplaceScope(const Scope &);
const std::map<SourceName, ParamValue> ¶meters() const {
return parameters_;
}
return nullptr;
}
}
- void ProcessParameterExpressions(evaluate::FoldingContext &);
- Scope &Instantiate(Scope &, SemanticsContext &);
bool operator==(const DerivedTypeSpec &that) const {
return &typeSymbol_ == &that.typeSymbol_ && parameters_ == that.parameters_;
}
projects / platform / upstream / llvm.git / commitdiff