flang/lib/Semantics/type.cpp

   1 //===-- lib/Semantics/type.cpp --------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "flang/Semantics/type.h"
  10 #include "check-declarations.h"
  11 #include "compute-offsets.h"
  12 #include "flang/Evaluate/fold.h"
  13 #include "flang/Evaluate/tools.h"
  14 #include "flang/Evaluate/type.h"
  15 #include "flang/Parser/characters.h"
  16 #include "flang/Parser/parse-tree-visitor.h"
  17 #include "flang/Semantics/scope.h"
  18 #include "flang/Semantics/symbol.h"
  19 #include "flang/Semantics/tools.h"
  20 #include "llvm/Support/raw_ostream.h"
  21
  22 namespace Fortran::semantics {
  23
  24 DerivedTypeSpec::DerivedTypeSpec(SourceName name, const Symbol &typeSymbol)
  25     : name_{name}, typeSymbol_{typeSymbol} {
  26   CHECK(typeSymbol.has<DerivedTypeDetails>());
  27 }
  28 DerivedTypeSpec::DerivedTypeSpec(const DerivedTypeSpec &that) = default;
  29 DerivedTypeSpec::DerivedTypeSpec(DerivedTypeSpec &&that) = default;
  30
  31 void DerivedTypeSpec::set_scope(const Scope &scope) {
  32   CHECK(!scope_);
  33   ReplaceScope(scope);
  34 }
  35 void DerivedTypeSpec::ReplaceScope(const Scope &scope) {
  36   CHECK(scope.IsDerivedType());
  37   scope_ = &scope;
  38 }
  39
  40 void DerivedTypeSpec::AddRawParamValue(
  41     const parser::Keyword *keyword, ParamValue &&value) {
  42   CHECK(parameters_.empty());
  43   rawParameters_.emplace_back(keyword, std::move(value));
  44 }
  45
  46 void DerivedTypeSpec::CookParameters(evaluate::FoldingContext &foldingContext) {
  47   if (cooked_) {
  48     return;
  49   }
  50   cooked_ = true;
  51   auto &messages{foldingContext.messages()};
  52   if (IsForwardReferenced()) {
  53     messages.Say(typeSymbol_.name(),
  54         "Derived type '%s' was used but never defined"_err_en_US,
  55         typeSymbol_.name());
  56     return;
  57   }
  58
  59   // Parameters of the most deeply nested "base class" come first when the
  60   // derived type is an extension.
  61   auto parameterNames{OrderParameterNames(typeSymbol_)};
  62   auto parameterDecls{OrderParameterDeclarations(typeSymbol_)};
  63   auto nextNameIter{parameterNames.begin()};
  64   RawParameters raw{std::move(rawParameters_)};
  65   for (auto &[maybeKeyword, value] : raw) {
  66     SourceName name;
  67     common::TypeParamAttr attr{common::TypeParamAttr::Kind};
  68     if (maybeKeyword) {
  69       name = maybeKeyword->v.source;
  70       auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(),
  71           [&](const Symbol &symbol) { return symbol.name() == name; })};
  72       if (it == parameterDecls.end()) {
  73         messages.Say(name,
  74             "'%s' is not the name of a parameter for derived type '%s'"_err_en_US,
  75             name, typeSymbol_.name());
  76       } else {
  77         // Resolve the keyword's symbol
  78         maybeKeyword->v.symbol = const_cast<Symbol *>(&it->get());
  79         attr = it->get().get<TypeParamDetails>().attr();
  80       }
  81     } else if (nextNameIter != parameterNames.end()) {
  82       name = *nextNameIter++;
  83       auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(),
  84           [&](const Symbol &symbol) { return symbol.name() == name; })};
  85       if (it == parameterDecls.end()) {
  86         break;
  87       }
  88       attr = it->get().get<TypeParamDetails>().attr();
  89     } else {
  90       messages.Say(name_,
  91           "Too many type parameters given for derived type '%s'"_err_en_US,
  92           typeSymbol_.name());
  93       break;
  94     }
  95     if (FindParameter(name)) {
  96       messages.Say(name_,
  97           "Multiple values given for type parameter '%s'"_err_en_US, name);
  98     } else {
  99       value.set_attr(attr);
 100       AddParamValue(name, std::move(value));
 101     }
 102   }
 103 }
 104
 105 void DerivedTypeSpec::EvaluateParameters(SemanticsContext &context) {
 106   evaluate::FoldingContext &foldingContext{context.foldingContext()};
 107   CookParameters(foldingContext);
 108   if (evaluated_) {
 109     return;
 110   }
 111   evaluated_ = true;
 112   auto &messages{foldingContext.messages()};
 113
 114   // Fold the explicit type parameter value expressions first.  Do not
 115   // fold them within the scope of the derived type being instantiated;
 116   // these expressions cannot use its type parameters.  Convert the values
 117   // of the expressions to the declared types of the type parameters.
 118   auto parameterDecls{OrderParameterDeclarations(typeSymbol_)};
 119   for (const Symbol &symbol : parameterDecls) {
 120     const SourceName &name{symbol.name()};
 121     if (ParamValue * paramValue{FindParameter(name)}) {
 122       if (const MaybeIntExpr & expr{paramValue->GetExplicit()}) {
 123         if (auto converted{evaluate::ConvertToType(symbol, SomeExpr{*expr})}) {
 124           SomeExpr folded{
 125               evaluate::Fold(foldingContext, std::move(*converted))};
 126           if (auto *intExpr{std::get_if<SomeIntExpr>(&folded.u)}) {
 127             paramValue->SetExplicit(std::move(*intExpr));
 128             continue;
 129           }
 130         }
 131         if (!context.HasError(symbol)) {
 132           evaluate::SayWithDeclaration(messages, symbol,
 133               "Value of type parameter '%s' (%s) is not convertible to its"
 134               " type"_err_en_US,
 135               name, expr->AsFortran());
 136         }
 137       }
 138     }
 139   }
 140
 141   // Default initialization expressions for the derived type's parameters
 142   // may reference other parameters so long as the declaration precedes the
 143   // use in the expression (10.1.12).  This is not necessarily the same
 144   // order as "type parameter order" (7.5.3.2).
 145   // Type parameter default value expressions are folded in declaration order
 146   // within the scope of the derived type so that the values of earlier type
 147   // parameters are available for use in the default initialization
 148   // expressions of later parameters.
 149   auto restorer{foldingContext.WithPDTInstance(*this)};
 150   for (const Symbol &symbol : parameterDecls) {
 151     const SourceName &name{symbol.name()};
 152     if (!FindParameter(name)) {
 153       const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
 154       if (details.init()) {
 155         auto expr{evaluate::Fold(foldingContext, SomeExpr{*details.init()})};
 156         AddParamValue(name,
 157             ParamValue{
 158                 std::move(std::get<SomeIntExpr>(expr.u)), details.attr()});
 159       } else if (!context.HasError(symbol)) {
 160         messages.Say(name_,
 161             "Type parameter '%s' lacks a value and has no default"_err_en_US,
 162             name);
 163       }
 164     }
 165   }
 166 }
 167
 168 void DerivedTypeSpec::AddParamValue(SourceName name, ParamValue &&value) {
 169   CHECK(cooked_);
 170   auto pair{parameters_.insert(std::make_pair(name, std::move(value)))};
 171   CHECK(pair.second); // name was not already present
 172 }
 173
 174 bool DerivedTypeSpec::MightBeParameterized() const {
 175   return !cooked_ || !parameters_.empty();
 176 }
 177
 178 bool DerivedTypeSpec::IsForwardReferenced() const {
 179   return typeSymbol_.get<DerivedTypeDetails>().isForwardReferenced();
 180 }
 181
 182 bool DerivedTypeSpec::HasDefaultInitialization(bool ignoreAllocatable) const {
 183   DirectComponentIterator components{*this};
 184   return bool{std::find_if(
 185       components.begin(), components.end(), [&](const Symbol &component) {
 186         return IsInitialized(component, true, ignoreAllocatable);
 187       })};
 188 }
 189
 190 bool DerivedTypeSpec::HasDestruction() const {
 191   if (!FinalsForDerivedTypeInstantiation(*this).empty()) {
 192     return true;
 193   }
 194   DirectComponentIterator components{*this};
 195   return bool{std::find_if(
 196       components.begin(), components.end(), [&](const Symbol &component) {
 197         return IsDestructible(component, &typeSymbol());
 198       })};
 199 }
 200
 201 ParamValue *DerivedTypeSpec::FindParameter(SourceName target) {
 202   return const_cast<ParamValue *>(
 203       const_cast<const DerivedTypeSpec *>(this)->FindParameter(target));
 204 }
 205
 206 bool DerivedTypeSpec::Match(const DerivedTypeSpec &that) const {
 207   if (&typeSymbol_ != &that.typeSymbol_) {
 208     return false;
 209   }
 210   for (const auto &pair : parameters_) {
 211     const Symbol *tpSym{scope_ ? scope_->FindSymbol(pair.first) : nullptr};
 212     const auto *tpDetails{
 213         tpSym ? tpSym->detailsIf<TypeParamDetails>() : nullptr};
 214     if (!tpDetails) {
 215       return false;
 216     }
 217     if (tpDetails->attr() != common::TypeParamAttr::Kind) {
 218       continue;
 219     }
 220     const ParamValue &value{pair.second};
 221     auto iter{that.parameters_.find(pair.first)};
 222     if (iter == that.parameters_.end() || iter->second != value) {
 223       return false;
 224     }
 225   }
 226   return true;
 227 }
 228
 229 class InstantiateHelper {
 230 public:
 231   InstantiateHelper(Scope &scope) : scope_{scope} {}
 232   // Instantiate components from fromScope into scope_
 233   void InstantiateComponents(const Scope &);
 234
 235 private:
 236   SemanticsContext &context() const { return scope_.context(); }
 237   evaluate::FoldingContext &foldingContext() {
 238     return context().foldingContext();
 239   }
 240   template <typename A> A Fold(A &&expr) {
 241     return evaluate::Fold(foldingContext(), std::move(expr));
 242   }
 243   void InstantiateComponent(const Symbol &);
 244   const DeclTypeSpec *InstantiateType(const Symbol &);
 245   const DeclTypeSpec &InstantiateIntrinsicType(
 246       SourceName, const DeclTypeSpec &);
 247   DerivedTypeSpec CreateDerivedTypeSpec(const DerivedTypeSpec &, bool);
 248
 249   Scope &scope_;
 250 };
 251
 252 static int PlumbPDTInstantiationDepth(const Scope *scope) {
 253   int depth{0};
 254   while (scope->IsParameterizedDerivedTypeInstantiation()) {
 255     ++depth;
 256     scope = &scope->parent();
 257   }
 258   return depth;
 259 }
 260
 261 // Completes component derived type instantiation and initializer folding
 262 // for a non-parameterized derived type Scope.
 263 static void InstantiateNonPDTScope(Scope &typeScope, Scope &containingScope) {
 264   auto &context{containingScope.context()};
 265   auto &foldingContext{context.foldingContext()};
 266   for (auto &pair : typeScope) {
 267     Symbol &symbol{*pair.second};
 268     if (DeclTypeSpec * type{symbol.GetType()}) {
 269       if (DerivedTypeSpec * derived{type->AsDerived()}) {
 270         if (!(derived->IsForwardReferenced() &&
 271                 IsAllocatableOrPointer(symbol))) {
 272           derived->Instantiate(containingScope);
 273         }
 274       }
 275     }
 276     if (!IsPointer(symbol)) {
 277       if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
 278         if (MaybeExpr & init{object->init()}) {
 279           auto restorer{foldingContext.messages().SetLocation(symbol.name())};
 280           init = evaluate::NonPointerInitializationExpr(
 281               symbol, std::move(*init), foldingContext);
 282         }
 283       }
 284     }
 285   }
 286   ComputeOffsets(context, typeScope);
 287 }
 288
 289 void DerivedTypeSpec::Instantiate(Scope &containingScope) {
 290   if (instantiated_) {
 291     return;
 292   }
 293   instantiated_ = true;
 294   auto &context{containingScope.context()};
 295   auto &foldingContext{context.foldingContext()};
 296   if (IsForwardReferenced()) {
 297     foldingContext.messages().Say(typeSymbol_.name(),
 298         "The derived type '%s' was forward-referenced but not defined"_err_en_US,
 299         typeSymbol_.name());
 300     context.SetError(typeSymbol_);
 301     return;
 302   }
 303   EvaluateParameters(context);
 304   const Scope &typeScope{DEREF(typeSymbol_.scope())};
 305   if (!MightBeParameterized()) {
 306     scope_ = &typeScope;
 307     if (typeScope.derivedTypeSpec()) {
 308       CHECK(*this == *typeScope.derivedTypeSpec());
 309     } else {
 310       Scope &mutableTypeScope{const_cast<Scope &>(typeScope)};
 311       mutableTypeScope.set_derivedTypeSpec(*this);
 312       InstantiateNonPDTScope(mutableTypeScope, containingScope);
 313     }
 314     return;
 315   }
 316   // New PDT instantiation.  Create a new scope and populate it
 317   // with components that have been specialized for this set of
 318   // parameters.
 319   Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)};
 320   newScope.set_derivedTypeSpec(*this);
 321   ReplaceScope(newScope);
 322   auto restorer{foldingContext.WithPDTInstance(*this)};
 323   std::string desc{typeSymbol_.name().ToString()};
 324   char sep{'('};
 325   for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) {
 326     const SourceName &name{symbol.name()};
 327     if (typeScope.find(symbol.name()) != typeScope.end()) {
 328       // This type parameter belongs to the derived type itself, not to
 329       // one of its ancestors.  Put the type parameter expression value,
 330       // when there is one, into the new scope as the initialization value
 331       // for the parameter.  And when there is no explicit value, add an
 332       // uninitialized type parameter to forestall use of any default.
 333       if (ParamValue * paramValue{FindParameter(name)}) {
 334         const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
 335         paramValue->set_attr(details.attr());
 336         TypeParamDetails instanceDetails{details.attr()};
 337         if (const DeclTypeSpec * type{details.type()}) {
 338           instanceDetails.set_type(*type);
 339         }
 340         desc += sep;
 341         desc += name.ToString();
 342         desc += '=';
 343         sep = ',';
 344         if (MaybeIntExpr expr{paramValue->GetExplicit()}) {
 345           if (auto folded{evaluate::NonPointerInitializationExpr(symbol,
 346                   SomeExpr{std::move(*expr)}, foldingContext, &newScope)}) {
 347             desc += folded->AsFortran();
 348             instanceDetails.set_init(
 349                 std::move(DEREF(evaluate::UnwrapExpr<SomeIntExpr>(*folded))));
 350           }
 351         }
 352         if (!instanceDetails.init()) {
 353           desc += '*';
 354         }
 355         newScope.try_emplace(name, std::move(instanceDetails));
 356       }
 357     }
 358   }
 359   parser::Message *contextMessage{nullptr};
 360   if (sep != '(') {
 361     desc += ')';
 362     contextMessage = new parser::Message{foldingContext.messages().at(),
 363         "instantiation of parameterized derived type '%s'"_en_US, desc};
 364     if (auto outer{containingScope.instantiationContext()}) {
 365       contextMessage->SetContext(outer.get());
 366     }
 367     newScope.set_instantiationContext(contextMessage);
 368   }
 369   // Instantiate nearly every non-parameter symbol from the original derived
 370   // type's scope into the new instance.
 371   auto restorer2{foldingContext.messages().SetContext(contextMessage)};
 372   if (PlumbPDTInstantiationDepth(&containingScope) > 100) {
 373     foldingContext.messages().Say(
 374         "Too many recursive parameterized derived type instantiations"_err_en_US);
 375   } else {
 376     InstantiateHelper{newScope}.InstantiateComponents(typeScope);
 377   }
 378 }
 379
 380 void InstantiateHelper::InstantiateComponents(const Scope &fromScope) {
 381   // Instantiate symbols in declaration order; this ensures that
 382   // parent components and type parameters of ancestor types exist
 383   // by the time that they're needed.
 384   for (SymbolRef ref : fromScope.GetSymbols()) {
 385     InstantiateComponent(*ref);
 386   }
 387   ComputeOffsets(context(), scope_);
 388 }
 389
 390 // Walks a parsed expression to prepare it for (re)analysis;
 391 // clears out the typedExpr analysis results and re-resolves
 392 // symbol table pointers of type parameters.
 393 class ComponentInitResetHelper {
 394 public:
 395   explicit ComponentInitResetHelper(Scope &scope) : scope_{scope} {}
 396
 397   template <typename A> bool Pre(const A &) { return true; }
 398
 399   template <typename A> void Post(const A &x) {
 400     if constexpr (parser::HasTypedExpr<A>()) {
 401       x.typedExpr.Reset();
 402     }
 403   }
 404
 405   void Post(const parser::Name &name) {
 406     if (name.symbol && name.symbol->has<TypeParamDetails>()) {
 407       name.symbol = scope_.FindComponent(name.source);
 408     }
 409   }
 410
 411 private:
 412   Scope &scope_;
 413 };
 414
 415 void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) {
 416   auto pair{scope_.try_emplace(
 417       oldSymbol.name(), oldSymbol.attrs(), common::Clone(oldSymbol.details()))};
 418   Symbol &newSymbol{*pair.first->second};
 419   if (!pair.second) {
 420     // Symbol was already present in the scope, which can only happen
 421     // in the case of type parameters.
 422     CHECK(oldSymbol.has<TypeParamDetails>());
 423     return;
 424   }
 425   newSymbol.flags() = oldSymbol.flags();
 426   if (auto *details{newSymbol.detailsIf<ObjectEntityDetails>()}) {
 427     if (const DeclTypeSpec * newType{InstantiateType(newSymbol)}) {
 428       details->ReplaceType(*newType);
 429     }
 430     for (ShapeSpec &dim : details->shape()) {
 431       if (dim.lbound().isExplicit()) {
 432         dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit())));
 433       }
 434       if (dim.ubound().isExplicit()) {
 435         dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit())));
 436       }
 437     }
 438     for (ShapeSpec &dim : details->coshape()) {
 439       if (dim.lbound().isExplicit()) {
 440         dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit())));
 441       }
 442       if (dim.ubound().isExplicit()) {
 443         dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit())));
 444       }
 445     }
 446     if (const auto *parsedExpr{details->unanalyzedPDTComponentInit()}) {
 447       // Analyze the parsed expression in this PDT instantiation context.
 448       ComponentInitResetHelper resetter{scope_};
 449       parser::Walk(*parsedExpr, resetter);
 450       auto restorer{foldingContext().messages().SetLocation(newSymbol.name())};
 451       details->set_init(evaluate::Fold(
 452           foldingContext(), AnalyzeExpr(context(), *parsedExpr)));
 453       details->set_unanalyzedPDTComponentInit(nullptr);
 454       // Remove analysis results to prevent unparsing or other use of
 455       // instantiation-specific expressions.
 456       parser::Walk(*parsedExpr, resetter);
 457     }
 458     if (MaybeExpr & init{details->init()}) {
 459       // Non-pointer components with default initializers are
 460       // processed now so that those default initializers can be used
 461       // in PARAMETER structure constructors.
 462       auto restorer{foldingContext().messages().SetLocation(newSymbol.name())};
 463       init = IsPointer(newSymbol)
 464           ? Fold(std::move(*init))
 465           : evaluate::NonPointerInitializationExpr(
 466                 newSymbol, std::move(*init), foldingContext());
 467     }
 468   } else if (auto *procDetails{newSymbol.detailsIf<ProcEntityDetails>()}) {
 469     // We have a procedure pointer.  Instantiate its return type
 470     if (const DeclTypeSpec * returnType{InstantiateType(newSymbol)}) {
 471       if (!procDetails->procInterface()) {
 472         procDetails->ReplaceType(*returnType);
 473       }
 474     }
 475   }
 476 }
 477
 478 const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) {
 479   const DeclTypeSpec *type{symbol.GetType()};
 480   if (!type) {
 481     return nullptr; // error has occurred
 482   } else if (const DerivedTypeSpec * spec{type->AsDerived()}) {
 483     return &FindOrInstantiateDerivedType(scope_,
 484         CreateDerivedTypeSpec(*spec, symbol.test(Symbol::Flag::ParentComp)),
 485         type->category());
 486   } else if (type->AsIntrinsic()) {
 487     return &InstantiateIntrinsicType(symbol.name(), *type);
 488   } else if (type->category() == DeclTypeSpec::ClassStar) {
 489     return type;
 490   } else {
 491     common::die("InstantiateType: %s", type->AsFortran().c_str());
 492   }
 493 }
 494
 495 /// Fold explicit length parameters of character components when the explicit
 496 /// expression is a constant expression (if it only depends on KIND parameters).
 497 /// Do not fold `character(len=pdt_length)`, even if the length parameter is
 498 /// constant in the pdt instantiation, in order to avoid losing the information
 499 /// that the character component is automatic (and must be a descriptor).
 500 static ParamValue FoldCharacterLength(evaluate::FoldingContext &foldingContext,
 501     const CharacterTypeSpec &characterSpec) {
 502   if (const auto &len{characterSpec.length().GetExplicit()}) {
 503     if (evaluate::IsConstantExpr(*len)) {
 504       return ParamValue{evaluate::Fold(foldingContext, common::Clone(*len)),
 505           common::TypeParamAttr::Len};
 506     }
 507   }
 508   return characterSpec.length();
 509 }
 510
 511 // Apply type parameter values to an intrinsic type spec.
 512 const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
 513     SourceName symbolName, const DeclTypeSpec &spec) {
 514   const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())};
 515   if (spec.category() != DeclTypeSpec::Character &&
 516       evaluate::IsActuallyConstant(intrinsic.kind())) {
 517     return spec; // KIND is already a known constant
 518   }
 519   // The expression was not originally constant, but now it must be so
 520   // in the context of a parameterized derived type instantiation.
 521   KindExpr copy{Fold(common::Clone(intrinsic.kind()))};
 522   int kind{context().GetDefaultKind(intrinsic.category())};
 523   if (auto value{evaluate::ToInt64(copy)}) {
 524     if (foldingContext().targetCharacteristics().IsTypeEnabled(
 525             intrinsic.category(), *value)) {
 526       kind = *value;
 527     } else {
 528       foldingContext().messages().Say(symbolName,
 529           "KIND parameter value (%jd) of intrinsic type %s "
 530           "did not resolve to a supported value"_err_en_US,
 531           *value,
 532           parser::ToUpperCaseLetters(EnumToString(intrinsic.category())));
 533     }
 534   }
 535   switch (spec.category()) {
 536   case DeclTypeSpec::Numeric:
 537     return scope_.MakeNumericType(intrinsic.category(), KindExpr{kind});
 538   case DeclTypeSpec::Logical:
 539     return scope_.MakeLogicalType(KindExpr{kind});
 540   case DeclTypeSpec::Character:
 541     return scope_.MakeCharacterType(
 542         FoldCharacterLength(foldingContext(), spec.characterTypeSpec()),
 543         KindExpr{kind});
 544   default:
 545     CRASH_NO_CASE;
 546   }
 547 }
 548
 549 DerivedTypeSpec InstantiateHelper::CreateDerivedTypeSpec(
 550     const DerivedTypeSpec &spec, bool isParentComp) {
 551   DerivedTypeSpec result{spec};
 552   result.CookParameters(foldingContext()); // enables AddParamValue()
 553   if (isParentComp) {
 554     // Forward any explicit type parameter values from the
 555     // derived type spec under instantiation that define type parameters
 556     // of the parent component to the derived type spec of the
 557     // parent component.
 558     const DerivedTypeSpec &instanceSpec{DEREF(foldingContext().pdtInstance())};
 559     for (const auto &[name, value] : instanceSpec.parameters()) {
 560       if (scope_.find(name) == scope_.end()) {
 561         result.AddParamValue(name, ParamValue{value});
 562       }
 563     }
 564   }
 565   return result;
 566 }
 567
 568 std::string DerivedTypeSpec::AsFortran() const {
 569   std::string buf;
 570   llvm::raw_string_ostream ss{buf};
 571   ss << name_;
 572   if (!rawParameters_.empty()) {
 573     CHECK(parameters_.empty());
 574     ss << '(';
 575     bool first = true;
 576     for (const auto &[maybeKeyword, value] : rawParameters_) {
 577       if (first) {
 578         first = false;
 579       } else {
 580         ss << ',';
 581       }
 582       if (maybeKeyword) {
 583         ss << maybeKeyword->v.source.ToString() << '=';
 584       }
 585       ss << value.AsFortran();
 586     }
 587     ss << ')';
 588   } else if (!parameters_.empty()) {
 589     ss << '(';
 590     bool first = true;
 591     for (const auto &[name, value] : parameters_) {
 592       if (first) {
 593         first = false;
 594       } else {
 595         ss << ',';
 596       }
 597       ss << name.ToString() << '=' << value.AsFortran();
 598     }
 599     ss << ')';
 600   }
 601   return ss.str();
 602 }
 603
 604 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DerivedTypeSpec &x) {
 605   return o << x.AsFortran();
 606 }
 607
 608 Bound::Bound(common::ConstantSubscript bound) : expr_{bound} {}
 609
 610 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) {
 611   if (x.isStar()) {
 612     o << '*';
 613   } else if (x.isColon()) {
 614     o << ':';
 615   } else if (x.expr_) {
 616     x.expr_->AsFortran(o);
 617   } else {
 618     o << "<no-expr>";
 619   }
 620   return o;
 621 }
 622
 623 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ShapeSpec &x) {
 624   if (x.lb_.isStar()) {
 625     CHECK(x.ub_.isStar());
 626     o << "..";
 627   } else {
 628     if (!x.lb_.isColon()) {
 629       o << x.lb_;
 630     }
 631     o << ':';
 632     if (!x.ub_.isColon()) {
 633       o << x.ub_;
 634     }
 635   }
 636   return o;
 637 }
 638
 639 llvm::raw_ostream &operator<<(
 640     llvm::raw_ostream &os, const ArraySpec &arraySpec) {
 641   char sep{'('};
 642   for (auto &shape : arraySpec) {
 643     os << sep << shape;
 644     sep = ',';
 645   }
 646   if (sep == ',') {
 647     os << ')';
 648   }
 649   return os;
 650 }
 651
 652 ParamValue::ParamValue(MaybeIntExpr &&expr, common::TypeParamAttr attr)
 653     : attr_{attr}, expr_{std::move(expr)} {}
 654 ParamValue::ParamValue(SomeIntExpr &&expr, common::TypeParamAttr attr)
 655     : attr_{attr}, expr_{std::move(expr)} {}
 656 ParamValue::ParamValue(
 657     common::ConstantSubscript value, common::TypeParamAttr attr)
 658     : ParamValue(SomeIntExpr{evaluate::Expr<evaluate::SubscriptInteger>{value}},
 659           attr) {}
 660
 661 void ParamValue::SetExplicit(SomeIntExpr &&x) {
 662   category_ = Category::Explicit;
 663   expr_ = std::move(x);
 664 }
 665
 666 std::string ParamValue::AsFortran() const {
 667   switch (category_) {
 668     SWITCH_COVERS_ALL_CASES
 669   case Category::Assumed:
 670     return "*";
 671   case Category::Deferred:
 672     return ":";
 673   case Category::Explicit:
 674     if (expr_) {
 675       std::string buf;
 676       llvm::raw_string_ostream ss{buf};
 677       expr_->AsFortran(ss);
 678       return ss.str();
 679     } else {
 680       return "";
 681     }
 682   }
 683 }
 684
 685 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ParamValue &x) {
 686   return o << x.AsFortran();
 687 }
 688
 689 IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, KindExpr &&kind)
 690     : category_{category}, kind_{std::move(kind)} {
 691   CHECK(category != TypeCategory::Derived);
 692 }
 693
 694 static std::string KindAsFortran(const KindExpr &kind) {
 695   std::string buf;
 696   llvm::raw_string_ostream ss{buf};
 697   if (auto k{evaluate::ToInt64(kind)}) {
 698     ss << *k; // emit unsuffixed kind code
 699   } else {
 700     kind.AsFortran(ss);
 701   }
 702   return ss.str();
 703 }
 704
 705 std::string IntrinsicTypeSpec::AsFortran() const {
 706   return parser::ToUpperCaseLetters(common::EnumToString(category_)) + '(' +
 707       KindAsFortran(kind_) + ')';
 708 }
 709
 710 llvm::raw_ostream &operator<<(
 711     llvm::raw_ostream &os, const IntrinsicTypeSpec &x) {
 712   return os << x.AsFortran();
 713 }
 714
 715 std::string CharacterTypeSpec::AsFortran() const {
 716   return "CHARACTER(" + length_.AsFortran() + ',' + KindAsFortran(kind()) + ')';
 717 }
 718
 719 llvm::raw_ostream &operator<<(
 720     llvm::raw_ostream &os, const CharacterTypeSpec &x) {
 721   return os << x.AsFortran();
 722 }
 723
 724 DeclTypeSpec::DeclTypeSpec(NumericTypeSpec &&typeSpec)
 725     : category_{Numeric}, typeSpec_{std::move(typeSpec)} {}
 726 DeclTypeSpec::DeclTypeSpec(LogicalTypeSpec &&typeSpec)
 727     : category_{Logical}, typeSpec_{std::move(typeSpec)} {}
 728 DeclTypeSpec::DeclTypeSpec(const CharacterTypeSpec &typeSpec)
 729     : category_{Character}, typeSpec_{typeSpec} {}
 730 DeclTypeSpec::DeclTypeSpec(CharacterTypeSpec &&typeSpec)
 731     : category_{Character}, typeSpec_{std::move(typeSpec)} {}
 732 DeclTypeSpec::DeclTypeSpec(Category category, const DerivedTypeSpec &typeSpec)
 733     : category_{category}, typeSpec_{typeSpec} {
 734   CHECK(category == TypeDerived || category == ClassDerived);
 735 }
 736 DeclTypeSpec::DeclTypeSpec(Category category, DerivedTypeSpec &&typeSpec)
 737     : category_{category}, typeSpec_{std::move(typeSpec)} {
 738   CHECK(category == TypeDerived || category == ClassDerived);
 739 }
 740 DeclTypeSpec::DeclTypeSpec(Category category) : category_{category} {
 741   CHECK(category == TypeStar || category == ClassStar);
 742 }
 743 bool DeclTypeSpec::IsNumeric(TypeCategory tc) const {
 744   return category_ == Numeric && numericTypeSpec().category() == tc;
 745 }
 746 bool DeclTypeSpec::IsSequenceType() const {
 747   if (const DerivedTypeSpec * derivedType{AsDerived()}) {
 748     const auto *typeDetails{
 749         derivedType->typeSymbol().detailsIf<DerivedTypeDetails>()};
 750     return typeDetails && typeDetails->sequence();
 751   }
 752   return false;
 753 }
 754
 755 const NumericTypeSpec &DeclTypeSpec::numericTypeSpec() const {
 756   CHECK(category_ == Numeric);
 757   return std::get<NumericTypeSpec>(typeSpec_);
 758 }
 759 const LogicalTypeSpec &DeclTypeSpec::logicalTypeSpec() const {
 760   CHECK(category_ == Logical);
 761   return std::get<LogicalTypeSpec>(typeSpec_);
 762 }
 763 bool DeclTypeSpec::operator==(const DeclTypeSpec &that) const {
 764   return category_ == that.category_ && typeSpec_ == that.typeSpec_;
 765 }
 766
 767 std::string DeclTypeSpec::AsFortran() const {
 768   switch (category_) {
 769     SWITCH_COVERS_ALL_CASES
 770   case Numeric:
 771     return numericTypeSpec().AsFortran();
 772   case Logical:
 773     return logicalTypeSpec().AsFortran();
 774   case Character:
 775     return characterTypeSpec().AsFortran();
 776   case TypeDerived:
 777     if (derivedTypeSpec()
 778             .typeSymbol()
 779             .get<DerivedTypeDetails>()
 780             .isDECStructure()) {
 781       return "RECORD" + derivedTypeSpec().typeSymbol().name().ToString();
 782     } else {
 783       return "TYPE(" + derivedTypeSpec().AsFortran() + ')';
 784     }
 785   case ClassDerived:
 786     return "CLASS(" + derivedTypeSpec().AsFortran() + ')';
 787   case TypeStar:
 788     return "TYPE(*)";
 789   case ClassStar:
 790     return "CLASS(*)";
 791   }
 792 }
 793
 794 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) {
 795   return o << x.AsFortran();
 796 }
 797
 798 bool IsInteroperableIntrinsicType(const DeclTypeSpec &type) {
 799   auto dyType{evaluate::DynamicType::From(type)};
 800   return dyType && IsInteroperableIntrinsicType(*dyType);
 801 }
 802
 803 } // namespace Fortran::semantics