| //===-- lib/Semantics/type.cpp --------------------------------------------===// |
| // |
| // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
| // See https://llvm.org/LICENSE.txt for license information. |
| // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
| // |
| //===----------------------------------------------------------------------===// |
| |
| #include "flang/Semantics/type.h" |
| #include "flang/Evaluate/fold.h" |
| #include "flang/Parser/characters.h" |
| #include "flang/Semantics/scope.h" |
| #include "flang/Semantics/symbol.h" |
| #include "flang/Semantics/tools.h" |
| #include "llvm/Support/raw_ostream.h" |
| |
| namespace Fortran::semantics { |
| |
| DerivedTypeSpec::DerivedTypeSpec(SourceName name, const Symbol &typeSymbol) |
| : name_{name}, typeSymbol_{typeSymbol} { |
| CHECK(typeSymbol.has<DerivedTypeDetails>()); |
| } |
| DerivedTypeSpec::DerivedTypeSpec(const DerivedTypeSpec &that) = default; |
| DerivedTypeSpec::DerivedTypeSpec(DerivedTypeSpec &&that) = default; |
| |
| void DerivedTypeSpec::set_scope(const Scope &scope) { |
| CHECK(!scope_); |
| ReplaceScope(scope); |
| } |
| void DerivedTypeSpec::ReplaceScope(const Scope &scope) { |
| CHECK(scope.IsDerivedType()); |
| scope_ = &scope; |
| } |
| |
| void DerivedTypeSpec::AddRawParamValue( |
| const std::optional<parser::Keyword> &keyword, ParamValue &&value) { |
| CHECK(parameters_.empty()); |
| rawParameters_.emplace_back(keyword ? &*keyword : nullptr, std::move(value)); |
| } |
| |
| void DerivedTypeSpec::CookParameters(evaluate::FoldingContext &foldingContext) { |
| if (cooked_) { |
| return; |
| } |
| cooked_ = true; |
| auto &messages{foldingContext.messages()}; |
| if (IsForwardReferenced()) { |
| messages.Say(typeSymbol_.name(), |
| "Derived type '%s' was used but never defined"_err_en_US, |
| typeSymbol_.name()); |
| return; |
| } |
| |
| // Parameters of the most deeply nested "base class" come first when the |
| // derived type is an extension. |
| auto parameterNames{OrderParameterNames(typeSymbol_)}; |
| auto parameterDecls{OrderParameterDeclarations(typeSymbol_)}; |
| auto nextNameIter{parameterNames.begin()}; |
| RawParameters raw{std::move(rawParameters_)}; |
| for (auto &[maybeKeyword, value] : raw) { |
| SourceName name; |
| common::TypeParamAttr attr{common::TypeParamAttr::Kind}; |
| if (maybeKeyword) { |
| name = maybeKeyword->v.source; |
| auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(), |
| [&](const Symbol &symbol) { return symbol.name() == name; })}; |
| if (it == parameterDecls.end()) { |
| messages.Say(name, |
| "'%s' is not the name of a parameter for derived type '%s'"_err_en_US, |
| name, typeSymbol_.name()); |
| } else { |
| // Resolve the keyword's symbol |
| maybeKeyword->v.symbol = const_cast<Symbol *>(&it->get()); |
| attr = it->get().get<TypeParamDetails>().attr(); |
| } |
| } else if (nextNameIter != parameterNames.end()) { |
| name = *nextNameIter++; |
| auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(), |
| [&](const Symbol &symbol) { return symbol.name() == name; })}; |
| CHECK(it != parameterDecls.end()); |
| attr = it->get().get<TypeParamDetails>().attr(); |
| } else { |
| messages.Say(name_, |
| "Too many type parameters given for derived type '%s'"_err_en_US, |
| typeSymbol_.name()); |
| break; |
| } |
| if (FindParameter(name)) { |
| messages.Say(name_, |
| "Multiple values given for type parameter '%s'"_err_en_US, name); |
| } else { |
| value.set_attr(attr); |
| AddParamValue(name, std::move(value)); |
| } |
| } |
| } |
| |
| void DerivedTypeSpec::EvaluateParameters( |
| evaluate::FoldingContext &foldingContext) { |
| CookParameters(foldingContext); |
| if (evaluated_) { |
| return; |
| } |
| evaluated_ = true; |
| auto &messages{foldingContext.messages()}; |
| |
| // 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. |
| auto parameterDecls{OrderParameterDeclarations(typeSymbol_)}; |
| for (const Symbol &symbol : parameterDecls) { |
| 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; |
| } |
| } |
| evaluate::SayWithDeclaration(messages, symbol, |
| "Value of type parameter '%s' (%s) is not convertible to its type"_err_en_US, |
| name, expr->AsFortran()); |
| } |
| } |
| } |
| |
| // Default initialization expressions for the derived type's parameters |
| // may reference other parameters so long as the declaration precedes the |
| // use in the expression (10.1.12). This is not necessarily the same |
| // order as "type parameter order" (7.5.3.2). |
| // 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 : parameterDecls) { |
| const SourceName &name{symbol.name()}; |
| if (!FindParameter(name)) { |
| const TypeParamDetails &details{symbol.get<TypeParamDetails>()}; |
| if (details.init()) { |
| auto expr{ |
| evaluate::Fold(foldingContext, common::Clone(details.init()))}; |
| AddParamValue(name, ParamValue{std::move(*expr), details.attr()}); |
| } else { |
| messages.Say(name_, |
| "Type parameter '%s' lacks a value and has no default"_err_en_US, |
| name); |
| } |
| } |
| } |
| } |
| |
| void DerivedTypeSpec::AddParamValue(SourceName name, ParamValue &&value) { |
| CHECK(cooked_); |
| auto pair{parameters_.insert(std::make_pair(name, std::move(value)))}; |
| CHECK(pair.second); // name was not already present |
| } |
| |
| bool DerivedTypeSpec::MightBeParameterized() const { |
| return !cooked_ || !parameters_.empty(); |
| } |
| |
| bool DerivedTypeSpec::IsForwardReferenced() const { |
| return typeSymbol_.get<DerivedTypeDetails>().isForwardReferenced(); |
| } |
| |
| bool DerivedTypeSpec::HasDefaultInitialization() const { |
| for (const Scope *scope{scope_}; scope; |
| scope = scope->GetDerivedTypeParent()) { |
| for (const auto &pair : *scope) { |
| const Symbol &symbol{*pair.second}; |
| if (IsAllocatable(symbol) || IsInitialized(symbol)) { |
| return true; |
| } |
| } |
| } |
| return false; |
| } |
| |
| ParamValue *DerivedTypeSpec::FindParameter(SourceName target) { |
| return const_cast<ParamValue *>( |
| const_cast<const DerivedTypeSpec *>(this)->FindParameter(target)); |
| } |
| |
| void DerivedTypeSpec::Instantiate( |
| Scope &containingScope, SemanticsContext &context) { |
| if (instantiated_) { |
| return; |
| } |
| instantiated_ = true; |
| auto &foldingContext{context.foldingContext()}; |
| if (IsForwardReferenced()) { |
| foldingContext.messages().Say(typeSymbol_.name(), |
| "The derived type '%s' was forward-referenced but not defined"_err_en_US, |
| typeSymbol_.name()); |
| return; |
| } |
| CookParameters(foldingContext); |
| EvaluateParameters(foldingContext); |
| const Scope &typeScope{DEREF(typeSymbol_.scope())}; |
| if (!MightBeParameterized()) { |
| scope_ = &typeScope; |
| for (const auto &pair : typeScope) { |
| const Symbol &symbol{*pair.second}; |
| if (const DeclTypeSpec * type{symbol.GetType()}) { |
| if (const DerivedTypeSpec * derived{type->AsDerived()}) { |
| if (!(derived->IsForwardReferenced() && |
| IsAllocatableOrPointer(symbol))) { |
| auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)}; |
| instantiatable.Instantiate(containingScope, context); |
| } |
| } |
| } |
| } |
| return; |
| } |
| Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)}; |
| newScope.set_derivedTypeSpec(*this); |
| ReplaceScope(newScope); |
| for (const Symbol &symbol : 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 ancestors. 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)) { |
| if (auto *msg{foldingContext.messages().Say( |
| "Value of kind type parameter '%s' (%s) is not " |
| "a scalar INTEGER constant"_err_en_US, |
| name, expr->AsFortran())}) { |
| 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)); |
| newScope.try_emplace(name, std::move(instanceDetails)); |
| } |
| } |
| } |
| } |
| // Instantiate every non-parameter symbol from the original derived |
| // type's scope into the new instance. |
| auto restorer{foldingContext.WithPDTInstance(*this)}; |
| newScope.AddSourceRange(typeScope.sourceRange()); |
| for (const auto &pair : typeScope) { |
| const Symbol &symbol{*pair.second}; |
| symbol.InstantiateComponent(newScope, context); |
| } |
| } |
| |
| std::string DerivedTypeSpec::AsFortran() const { |
| std::string buf; |
| llvm::raw_string_ostream ss{buf}; |
| ss << name_; |
| if (!rawParameters_.empty()) { |
| CHECK(parameters_.empty()); |
| ss << '('; |
| bool first = true; |
| for (const auto &[maybeKeyword, value] : rawParameters_) { |
| if (first) { |
| first = false; |
| } else { |
| ss << ','; |
| } |
| if (maybeKeyword) { |
| ss << maybeKeyword->v.source.ToString() << '='; |
| } |
| ss << value.AsFortran(); |
| } |
| ss << ')'; |
| } else if (!parameters_.empty()) { |
| ss << '('; |
| bool first = true; |
| for (const auto &[name, value] : parameters_) { |
| if (first) { |
| first = false; |
| } else { |
| ss << ','; |
| } |
| ss << name.ToString() << '=' << value.AsFortran(); |
| } |
| ss << ')'; |
| } |
| return ss.str(); |
| } |
| |
| llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DerivedTypeSpec &x) { |
| return o << x.AsFortran(); |
| } |
| |
| Bound::Bound(int bound) : expr_{bound} {} |
| |
| llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) { |
| if (x.isAssumed()) { |
| o << '*'; |
| } else if (x.isDeferred()) { |
| o << ':'; |
| } else if (x.expr_) { |
| x.expr_->AsFortran(o); |
| } else { |
| o << "<no-expr>"; |
| } |
| return o; |
| } |
| |
| llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ShapeSpec &x) { |
| if (x.lb_.isAssumed()) { |
| CHECK(x.ub_.isAssumed()); |
| o << ".."; |
| } else { |
| if (!x.lb_.isDeferred()) { |
| o << x.lb_; |
| } |
| o << ':'; |
| if (!x.ub_.isDeferred()) { |
| o << x.ub_; |
| } |
| } |
| return o; |
| } |
| |
| bool ArraySpec::IsExplicitShape() const { |
| return CheckAll([](const ShapeSpec &x) { return x.ubound().isExplicit(); }); |
| } |
| bool ArraySpec::IsAssumedShape() const { |
| return CheckAll([](const ShapeSpec &x) { return x.ubound().isDeferred(); }); |
| } |
| bool ArraySpec::IsDeferredShape() const { |
| return CheckAll([](const ShapeSpec &x) { |
| return x.lbound().isDeferred() && x.ubound().isDeferred(); |
| }); |
| } |
| bool ArraySpec::IsImpliedShape() const { |
| return !IsAssumedRank() && |
| CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); }); |
| } |
| bool ArraySpec::IsAssumedSize() const { |
| return !empty() && !IsAssumedRank() && back().ubound().isAssumed() && |
| std::all_of(begin(), end() - 1, |
| [](const ShapeSpec &x) { return x.ubound().isExplicit(); }); |
| } |
| bool ArraySpec::IsAssumedRank() const { |
| return Rank() == 1 && front().lbound().isAssumed(); |
| } |
| |
| llvm::raw_ostream &operator<<( |
| llvm::raw_ostream &os, const ArraySpec &arraySpec) { |
| char sep{'('}; |
| for (auto &shape : arraySpec) { |
| os << sep << shape; |
| sep = ','; |
| } |
| if (sep == ',') { |
| os << ')'; |
| } |
| return os; |
| } |
| |
| ParamValue::ParamValue(MaybeIntExpr &&expr, common::TypeParamAttr attr) |
| : attr_{attr}, expr_{std::move(expr)} {} |
| ParamValue::ParamValue(SomeIntExpr &&expr, common::TypeParamAttr attr) |
| : attr_{attr}, expr_{std::move(expr)} {} |
| ParamValue::ParamValue( |
| common::ConstantSubscript value, common::TypeParamAttr attr) |
| : ParamValue(SomeIntExpr{evaluate::Expr<evaluate::SubscriptInteger>{value}}, |
| attr) {} |
| |
| void ParamValue::SetExplicit(SomeIntExpr &&x) { |
| category_ = Category::Explicit; |
| expr_ = std::move(x); |
| } |
| |
| std::string ParamValue::AsFortran() const { |
| switch (category_) { |
| SWITCH_COVERS_ALL_CASES |
| case Category::Assumed: |
| return "*"; |
| case Category::Deferred: |
| return ":"; |
| case Category::Explicit: |
| if (expr_) { |
| std::string buf; |
| llvm::raw_string_ostream ss{buf}; |
| expr_->AsFortran(ss); |
| return ss.str(); |
| } else { |
| return ""; |
| } |
| } |
| } |
| |
| llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ParamValue &x) { |
| return o << x.AsFortran(); |
| } |
| |
| IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, KindExpr &&kind) |
| : category_{category}, kind_{std::move(kind)} { |
| CHECK(category != TypeCategory::Derived); |
| } |
| |
| static std::string KindAsFortran(const KindExpr &kind) { |
| std::string buf; |
| llvm::raw_string_ostream ss{buf}; |
| if (auto k{evaluate::ToInt64(kind)}) { |
| ss << *k; // emit unsuffixed kind code |
| } else { |
| kind.AsFortran(ss); |
| } |
| return ss.str(); |
| } |
| |
| std::string IntrinsicTypeSpec::AsFortran() const { |
| return parser::ToUpperCaseLetters(common::EnumToString(category_)) + '(' + |
| KindAsFortran(kind_) + ')'; |
| } |
| |
| llvm::raw_ostream &operator<<( |
| llvm::raw_ostream &os, const IntrinsicTypeSpec &x) { |
| return os << x.AsFortran(); |
| } |
| |
| std::string CharacterTypeSpec::AsFortran() const { |
| return "CHARACTER(" + length_.AsFortran() + ',' + KindAsFortran(kind()) + ')'; |
| } |
| |
| llvm::raw_ostream &operator<<( |
| llvm::raw_ostream &os, const CharacterTypeSpec &x) { |
| return os << x.AsFortran(); |
| } |
| |
| DeclTypeSpec::DeclTypeSpec(NumericTypeSpec &&typeSpec) |
| : category_{Numeric}, typeSpec_{std::move(typeSpec)} {} |
| DeclTypeSpec::DeclTypeSpec(LogicalTypeSpec &&typeSpec) |
| : category_{Logical}, typeSpec_{std::move(typeSpec)} {} |
| DeclTypeSpec::DeclTypeSpec(const CharacterTypeSpec &typeSpec) |
| : category_{Character}, typeSpec_{typeSpec} {} |
| DeclTypeSpec::DeclTypeSpec(CharacterTypeSpec &&typeSpec) |
| : category_{Character}, typeSpec_{std::move(typeSpec)} {} |
| DeclTypeSpec::DeclTypeSpec(Category category, const DerivedTypeSpec &typeSpec) |
| : category_{category}, typeSpec_{typeSpec} { |
| CHECK(category == TypeDerived || category == ClassDerived); |
| } |
| DeclTypeSpec::DeclTypeSpec(Category category, DerivedTypeSpec &&typeSpec) |
| : category_{category}, typeSpec_{std::move(typeSpec)} { |
| CHECK(category == TypeDerived || category == ClassDerived); |
| } |
| DeclTypeSpec::DeclTypeSpec(Category category) : category_{category} { |
| CHECK(category == TypeStar || category == ClassStar); |
| } |
| bool DeclTypeSpec::IsNumeric(TypeCategory tc) const { |
| return category_ == Numeric && numericTypeSpec().category() == tc; |
| } |
| bool DeclTypeSpec::IsSequenceType() const { |
| if (const DerivedTypeSpec * derivedType{AsDerived()}) { |
| const auto *typeDetails{ |
| derivedType->typeSymbol().detailsIf<DerivedTypeDetails>()}; |
| return typeDetails && typeDetails->sequence(); |
| } |
| return false; |
| } |
| IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() { |
| return const_cast<IntrinsicTypeSpec *>( |
| const_cast<const DeclTypeSpec *>(this)->AsIntrinsic()); |
| } |
| const NumericTypeSpec &DeclTypeSpec::numericTypeSpec() const { |
| CHECK(category_ == Numeric); |
| return std::get<NumericTypeSpec>(typeSpec_); |
| } |
| const LogicalTypeSpec &DeclTypeSpec::logicalTypeSpec() const { |
| CHECK(category_ == Logical); |
| return std::get<LogicalTypeSpec>(typeSpec_); |
| } |
| bool DeclTypeSpec::operator==(const DeclTypeSpec &that) const { |
| return category_ == that.category_ && typeSpec_ == that.typeSpec_; |
| } |
| |
| std::string DeclTypeSpec::AsFortran() const { |
| switch (category_) { |
| SWITCH_COVERS_ALL_CASES |
| case Numeric: |
| return numericTypeSpec().AsFortran(); |
| case Logical: |
| return logicalTypeSpec().AsFortran(); |
| case Character: |
| return characterTypeSpec().AsFortran(); |
| case TypeDerived: |
| return "TYPE(" + derivedTypeSpec().AsFortran() + ')'; |
| case ClassDerived: |
| return "CLASS(" + derivedTypeSpec().AsFortran() + ')'; |
| case TypeStar: |
| return "TYPE(*)"; |
| case ClassStar: |
| return "CLASS(*)"; |
| } |
| } |
| |
| llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) { |
| return o << x.AsFortran(); |
| } |
| |
| void ProcInterface::set_symbol(const Symbol &symbol) { |
| CHECK(!type_); |
| symbol_ = &symbol; |
| } |
| void ProcInterface::set_type(const DeclTypeSpec &type) { |
| CHECK(!symbol_); |
| type_ = &type; |
| } |
| } // namespace Fortran::semantics |