flang/lib/Semantics/runtime-type-info.cpp

   1 //===-- lib/Semantics/runtime-type-info.cpp ---------------------*- C++ -*-===//
   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/runtime-type-info.h"
  10 #include "mod-file.h"
  11 #include "flang/Evaluate/fold-designator.h"
  12 #include "flang/Evaluate/fold.h"
  13 #include "flang/Evaluate/tools.h"
  14 #include "flang/Evaluate/type.h"
  15 #include "flang/Semantics/scope.h"
  16 #include "flang/Semantics/tools.h"
  17 #include <functional>
  18 #include <list>
  19 #include <map>
  20 #include <string>
  21
  22 namespace Fortran::semantics {
  23
  24 static int FindLenParameterIndex(
  25     const SymbolVector &parameters, const Symbol &symbol) {
  26   int lenIndex{0};
  27   for (SymbolRef ref : parameters) {
  28     if (&*ref == &symbol) {
  29       return lenIndex;
  30     }
  31     if (ref->get<TypeParamDetails>().attr() == common::TypeParamAttr::Len) {
  32       ++lenIndex;
  33     }
  34   }
  35   DIE("Length type parameter not found in parameter order");
  36   return -1;
  37 }
  38
  39 class RuntimeTableBuilder {
  40 public:
  41   RuntimeTableBuilder(SemanticsContext &, RuntimeDerivedTypeTables &);
  42   void DescribeTypes(Scope &scope, bool inSchemata);
  43
  44 private:
  45   const Symbol *DescribeType(Scope &);
  46   const Symbol &GetSchemaSymbol(const char *) const;
  47   const DeclTypeSpec &GetSchema(const char *) const;
  48   SomeExpr GetEnumValue(const char *) const;
  49   Symbol &CreateObject(const std::string &, const DeclTypeSpec &, Scope &);
  50   // The names of created symbols are saved in and owned by the
  51   // RuntimeDerivedTypeTables instance returned by
  52   // BuildRuntimeDerivedTypeTables() so that references to those names remain
  53   // valid for lowering.
  54   SourceName SaveObjectName(const std::string &);
  55   SomeExpr SaveNameAsPointerTarget(Scope &, const std::string &);
  56   const SymbolVector *GetTypeParameters(const Symbol &);
  57   evaluate::StructureConstructor DescribeComponent(const Symbol &,
  58       const ObjectEntityDetails &, Scope &, Scope &,
  59       const std::string &distinctName, const SymbolVector *parameters);
  60   evaluate::StructureConstructor DescribeComponent(
  61       const Symbol &, const ProcEntityDetails &, Scope &);
  62   bool InitializeDataPointer(evaluate::StructureConstructorValues &,
  63       const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope,
  64       Scope &dtScope, const std::string &distinctName);
  65   evaluate::StructureConstructor PackageIntValue(
  66       const SomeExpr &genre, std::int64_t = 0) const;
  67   SomeExpr PackageIntValueExpr(const SomeExpr &genre, std::int64_t = 0) const;
  68   std::vector<evaluate::StructureConstructor> DescribeBindings(
  69       const Scope &dtScope, Scope &);
  70   std::map<int, evaluate::StructureConstructor> DescribeSpecialGenerics(
  71       const Scope &dtScope, const Scope &thisScope,
  72       const DerivedTypeSpec *) const;
  73   void DescribeSpecialGeneric(const GenericDetails &,
  74       std::map<int, evaluate::StructureConstructor> &, const Scope &,
  75       const DerivedTypeSpec *) const;
  76   void DescribeSpecialProc(std::map<int, evaluate::StructureConstructor> &,
  77       const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
  78       std::optional<GenericKind::DefinedIo>, const Scope *,
  79       const DerivedTypeSpec *) const;
  80   void IncorporateDefinedIoGenericInterfaces(
  81       std::map<int, evaluate::StructureConstructor> &, GenericKind::DefinedIo,
  82       const Scope *, const DerivedTypeSpec *);
  83
  84   // Instantiated for ParamValue and Bound
  85   template <typename A>
  86   evaluate::StructureConstructor GetValue(
  87       const A &x, const SymbolVector *parameters) {
  88     if (x.isExplicit()) {
  89       return GetValue(x.GetExplicit(), parameters);
  90     } else {
  91       return PackageIntValue(deferredEnum_);
  92     }
  93   }
  94
  95   // Specialization for optional<Expr<SomeInteger and SubscriptInteger>>
  96   template <typename T>
  97   evaluate::StructureConstructor GetValue(
  98       const std::optional<evaluate::Expr<T>> &expr,
  99       const SymbolVector *parameters) {
 100     if (auto constValue{evaluate::ToInt64(expr)}) {
 101       return PackageIntValue(explicitEnum_, *constValue);
 102     }
 103     if (expr) {
 104       if (parameters) {
 105         if (const Symbol * lenParam{evaluate::ExtractBareLenParameter(*expr)}) {
 106           return PackageIntValue(
 107               lenParameterEnum_, FindLenParameterIndex(*parameters, *lenParam));
 108         }
 109       }
 110       // TODO: Replace a specification expression requiring actual operations
 111       // with a reference to a new anonymous LEN type parameter whose default
 112       // value captures the expression.  This replacement must take place when
 113       // the type is declared so that the new LEN type parameters appear in
 114       // all instantiations and structure constructors.
 115       context_.Say(location_,
 116           "derived type specification expression '%s' that is neither constant nor a length type parameter"_todo_en_US,
 117           expr->AsFortran());
 118     }
 119     return PackageIntValue(deferredEnum_);
 120   }
 121
 122   SemanticsContext &context_;
 123   RuntimeDerivedTypeTables &tables_;
 124   std::map<const Symbol *, SymbolVector> orderedTypeParameters_;
 125
 126   const DeclTypeSpec &derivedTypeSchema_; // TYPE(DerivedType)
 127   const DeclTypeSpec &componentSchema_; // TYPE(Component)
 128   const DeclTypeSpec &procPtrSchema_; // TYPE(ProcPtrComponent)
 129   const DeclTypeSpec &valueSchema_; // TYPE(Value)
 130   const DeclTypeSpec &bindingSchema_; // TYPE(Binding)
 131   const DeclTypeSpec &specialSchema_; // TYPE(SpecialBinding)
 132   SomeExpr deferredEnum_; // Value::Genre::Deferred
 133   SomeExpr explicitEnum_; // Value::Genre::Explicit
 134   SomeExpr lenParameterEnum_; // Value::Genre::LenParameter
 135   SomeExpr scalarAssignmentEnum_; // SpecialBinding::Which::ScalarAssignment
 136   SomeExpr
 137       elementalAssignmentEnum_; // SpecialBinding::Which::ElementalAssignment
 138   SomeExpr readFormattedEnum_; // SpecialBinding::Which::ReadFormatted
 139   SomeExpr readUnformattedEnum_; // SpecialBinding::Which::ReadUnformatted
 140   SomeExpr writeFormattedEnum_; // SpecialBinding::Which::WriteFormatted
 141   SomeExpr writeUnformattedEnum_; // SpecialBinding::Which::WriteUnformatted
 142   SomeExpr elementalFinalEnum_; // SpecialBinding::Which::ElementalFinal
 143   SomeExpr assumedRankFinalEnum_; // SpecialBinding::Which::AssumedRankFinal
 144   SomeExpr scalarFinalEnum_; // SpecialBinding::Which::ScalarFinal
 145   parser::CharBlock location_;
 146   std::set<const Scope *> ignoreScopes_;
 147 };
 148
 149 RuntimeTableBuilder::RuntimeTableBuilder(
 150     SemanticsContext &c, RuntimeDerivedTypeTables &t)
 151     : context_{c}, tables_{t}, derivedTypeSchema_{GetSchema("derivedtype")},
 152       componentSchema_{GetSchema("component")}, procPtrSchema_{GetSchema(
 153                                                     "procptrcomponent")},
 154       valueSchema_{GetSchema("value")}, bindingSchema_{GetSchema(
 155                                             bindingDescCompName)},
 156       specialSchema_{GetSchema("specialbinding")}, deferredEnum_{GetEnumValue(
 157                                                        "deferred")},
 158       explicitEnum_{GetEnumValue("explicit")}, lenParameterEnum_{GetEnumValue(
 159                                                    "lenparameter")},
 160       scalarAssignmentEnum_{GetEnumValue("scalarassignment")},
 161       elementalAssignmentEnum_{GetEnumValue("elementalassignment")},
 162       readFormattedEnum_{GetEnumValue("readformatted")},
 163       readUnformattedEnum_{GetEnumValue("readunformatted")},
 164       writeFormattedEnum_{GetEnumValue("writeformatted")},
 165       writeUnformattedEnum_{GetEnumValue("writeunformatted")},
 166       elementalFinalEnum_{GetEnumValue("elementalfinal")},
 167       assumedRankFinalEnum_{GetEnumValue("assumedrankfinal")},
 168       scalarFinalEnum_{GetEnumValue("scalarfinal")} {
 169   ignoreScopes_.insert(tables_.schemata);
 170 }
 171
 172 void RuntimeTableBuilder::DescribeTypes(Scope &scope, bool inSchemata) {
 173   inSchemata |= ignoreScopes_.find(&scope) != ignoreScopes_.end();
 174   if (scope.IsDerivedType()) {
 175     if (!inSchemata) { // don't loop trying to describe a schema
 176       DescribeType(scope);
 177     }
 178   } else {
 179     scope.InstantiateDerivedTypes();
 180   }
 181   for (Scope &child : scope.children()) {
 182     DescribeTypes(child, inSchemata);
 183   }
 184 }
 185
 186 // Returns derived type instantiation's parameters in declaration order
 187 const SymbolVector *RuntimeTableBuilder::GetTypeParameters(
 188     const Symbol &symbol) {
 189   auto iter{orderedTypeParameters_.find(&symbol)};
 190   if (iter != orderedTypeParameters_.end()) {
 191     return &iter->second;
 192   } else {
 193     return &orderedTypeParameters_
 194                 .emplace(&symbol, OrderParameterDeclarations(symbol))
 195                 .first->second;
 196   }
 197 }
 198
 199 static Scope &GetContainingNonDerivedScope(Scope &scope) {
 200   Scope *p{&scope};
 201   while (p->IsDerivedType()) {
 202     p = &p->parent();
 203   }
 204   return *p;
 205 }
 206
 207 static const Symbol &GetSchemaField(
 208     const DerivedTypeSpec &derived, const std::string &name) {
 209   const Scope &scope{
 210       DEREF(derived.scope() ? derived.scope() : derived.typeSymbol().scope())};
 211   auto iter{scope.find(SourceName(name))};
 212   CHECK(iter != scope.end());
 213   return *iter->second;
 214 }
 215
 216 static const Symbol &GetSchemaField(
 217     const DeclTypeSpec &derived, const std::string &name) {
 218   return GetSchemaField(DEREF(derived.AsDerived()), name);
 219 }
 220
 221 static evaluate::StructureConstructorValues &AddValue(
 222     evaluate::StructureConstructorValues &values, const DeclTypeSpec &spec,
 223     const std::string &name, SomeExpr &&x) {
 224   values.emplace(GetSchemaField(spec, name), std::move(x));
 225   return values;
 226 }
 227
 228 static evaluate::StructureConstructorValues &AddValue(
 229     evaluate::StructureConstructorValues &values, const DeclTypeSpec &spec,
 230     const std::string &name, const SomeExpr &x) {
 231   values.emplace(GetSchemaField(spec, name), x);
 232   return values;
 233 }
 234
 235 static SomeExpr IntToExpr(std::int64_t n) {
 236   return evaluate::AsGenericExpr(evaluate::ExtentExpr{n});
 237 }
 238
 239 static evaluate::StructureConstructor Structure(
 240     const DeclTypeSpec &spec, evaluate::StructureConstructorValues &&values) {
 241   return {DEREF(spec.AsDerived()), std::move(values)};
 242 }
 243
 244 static SomeExpr StructureExpr(evaluate::StructureConstructor &&x) {
 245   return SomeExpr{evaluate::Expr<evaluate::SomeDerived>{std::move(x)}};
 246 }
 247
 248 static int GetIntegerKind(const Symbol &symbol) {
 249   auto dyType{evaluate::DynamicType::From(symbol)};
 250   CHECK(dyType && dyType->category() == TypeCategory::Integer);
 251   return dyType->kind();
 252 }
 253
 254 static void SetReadOnlyCompilerCreatedFlags(Symbol &symbol) {
 255   symbol.set(Symbol::Flag::CompilerCreated);
 256   // Runtime type info symbols may have types that are incompatible with the
 257   // PARAMETER attribute (the main issue is that they may be TARGET, and normal
 258   // Fortran parameters cannot be TARGETs).
 259   if (symbol.has<semantics::ObjectEntityDetails>() ||
 260       symbol.has<semantics::ProcEntityDetails>()) {
 261     symbol.set(Symbol::Flag::ReadOnly);
 262   }
 263 }
 264
 265 // Save a rank-1 array constant of some numeric type as an
 266 // initialized data object in a scope.
 267 template <typename T>
 268 static SomeExpr SaveNumericPointerTarget(
 269     Scope &scope, SourceName name, std::vector<typename T::Scalar> &&x) {
 270   if (x.empty()) {
 271     return SomeExpr{evaluate::NullPointer{}};
 272   } else {
 273     ObjectEntityDetails object;
 274     if (const auto *spec{scope.FindType(
 275             DeclTypeSpec{NumericTypeSpec{T::category, KindExpr{T::kind}}})}) {
 276       object.set_type(*spec);
 277     } else {
 278       object.set_type(scope.MakeNumericType(T::category, KindExpr{T::kind}));
 279     }
 280     auto elements{static_cast<evaluate::ConstantSubscript>(x.size())};
 281     ArraySpec arraySpec;
 282     arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{elements - 1}));
 283     object.set_shape(arraySpec);
 284     object.set_init(evaluate::AsGenericExpr(evaluate::Constant<T>{
 285         std::move(x), evaluate::ConstantSubscripts{elements}}));
 286     Symbol &symbol{*scope
 287                         .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
 288                             std::move(object))
 289                         .first->second};
 290     SetReadOnlyCompilerCreatedFlags(symbol);
 291     return evaluate::AsGenericExpr(
 292         evaluate::Expr<T>{evaluate::Designator<T>{symbol}});
 293   }
 294 }
 295
 296 // Save an arbitrarily shaped array constant of some derived type
 297 // as an initialized data object in a scope.
 298 static SomeExpr SaveDerivedPointerTarget(Scope &scope, SourceName name,
 299     std::vector<evaluate::StructureConstructor> &&x,
 300     evaluate::ConstantSubscripts &&shape) {
 301   if (x.empty()) {
 302     return SomeExpr{evaluate::NullPointer{}};
 303   } else {
 304     const auto &derivedType{x.front().GetType().GetDerivedTypeSpec()};
 305     ObjectEntityDetails object;
 306     DeclTypeSpec typeSpec{DeclTypeSpec::TypeDerived, derivedType};
 307     if (const DeclTypeSpec * spec{scope.FindType(typeSpec)}) {
 308       object.set_type(*spec);
 309     } else {
 310       object.set_type(scope.MakeDerivedType(
 311           DeclTypeSpec::TypeDerived, common::Clone(derivedType)));
 312     }
 313     if (!shape.empty()) {
 314       ArraySpec arraySpec;
 315       for (auto n : shape) {
 316         arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{n - 1}));
 317       }
 318       object.set_shape(arraySpec);
 319     }
 320     object.set_init(
 321         evaluate::AsGenericExpr(evaluate::Constant<evaluate::SomeDerived>{
 322             derivedType, std::move(x), std::move(shape)}));
 323     Symbol &symbol{*scope
 324                         .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
 325                             std::move(object))
 326                         .first->second};
 327     SetReadOnlyCompilerCreatedFlags(symbol);
 328     return evaluate::AsGenericExpr(
 329         evaluate::Designator<evaluate::SomeDerived>{symbol});
 330   }
 331 }
 332
 333 static SomeExpr SaveObjectInit(
 334     Scope &scope, SourceName name, const ObjectEntityDetails &object) {
 335   Symbol &symbol{*scope
 336                       .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
 337                           ObjectEntityDetails{object})
 338                       .first->second};
 339   CHECK(symbol.get<ObjectEntityDetails>().init().has_value());
 340   SetReadOnlyCompilerCreatedFlags(symbol);
 341   return evaluate::AsGenericExpr(
 342       evaluate::Designator<evaluate::SomeDerived>{symbol});
 343 }
 344
 345 template <int KIND> static SomeExpr IntExpr(std::int64_t n) {
 346   return evaluate::AsGenericExpr(
 347       evaluate::Constant<evaluate::Type<TypeCategory::Integer, KIND>>{n});
 348 }
 349
 350 static std::optional<std::string> GetSuffixIfTypeKindParameters(
 351     const DerivedTypeSpec &derivedTypeSpec, const SymbolVector *parameters) {
 352   if (parameters) {
 353     std::optional<std::string> suffix;
 354     for (SymbolRef ref : *parameters) {
 355       const auto &tpd{ref->get<TypeParamDetails>()};
 356       if (tpd.attr() == common::TypeParamAttr::Kind) {
 357         if (const auto *pv{derivedTypeSpec.FindParameter(ref->name())}) {
 358           if (pv->GetExplicit()) {
 359             if (auto instantiatedValue{evaluate::ToInt64(*pv->GetExplicit())}) {
 360               if (suffix.has_value()) {
 361                 *suffix += "."s + std::to_string(*instantiatedValue);
 362               } else {
 363                 suffix = "."s + std::to_string(*instantiatedValue);
 364               }
 365             }
 366           }
 367         }
 368       }
 369     }
 370     return suffix;
 371   }
 372   return std::nullopt;
 373 }
 374
 375 const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
 376   if (const Symbol * info{dtScope.runtimeDerivedTypeDescription()}) {
 377     return info;
 378   }
 379   const DerivedTypeSpec *derivedTypeSpec{dtScope.derivedTypeSpec()};
 380   if (!derivedTypeSpec && !dtScope.IsDerivedTypeWithKindParameter() &&
 381       dtScope.symbol()) {
 382     // This derived type was declared (obviously, there's a Scope) but never
 383     // used in this compilation (no instantiated DerivedTypeSpec points here).
 384     // Create a DerivedTypeSpec now for it so that ComponentIterator
 385     // will work. This covers the case of a derived type that's declared in
 386     // a module but used only by clients and submodules, enabling the
 387     // run-time "no initialization needed here" flag to work.
 388     DerivedTypeSpec derived{dtScope.symbol()->name(), *dtScope.symbol()};
 389     if (const SymbolVector *
 390         lenParameters{GetTypeParameters(*dtScope.symbol())}) {
 391       // Create dummy deferred values for the length parameters so that the
 392       // DerivedTypeSpec is complete and can be used in helpers.
 393       for (SymbolRef lenParam : *lenParameters) {
 394         (void)lenParam;
 395         derived.AddRawParamValue(
 396             nullptr, ParamValue::Deferred(common::TypeParamAttr::Len));
 397       }
 398       derived.CookParameters(context_.foldingContext());
 399     }
 400     DeclTypeSpec &decl{
 401         dtScope.MakeDerivedType(DeclTypeSpec::TypeDerived, std::move(derived))};
 402     derivedTypeSpec = &decl.derivedTypeSpec();
 403   }
 404   const Symbol *dtSymbol{
 405       derivedTypeSpec ? &derivedTypeSpec->typeSymbol() : dtScope.symbol()};
 406   if (!dtSymbol) {
 407     return nullptr;
 408   }
 409   auto locationRestorer{common::ScopedSet(location_, dtSymbol->name())};
 410   // Check for an existing description that can be imported from a USE'd module
 411   std::string typeName{dtSymbol->name().ToString()};
 412   if (typeName.empty() ||
 413       (typeName.front() == '.' && !context_.IsTempName(typeName))) {
 414     return nullptr;
 415   }
 416   const SymbolVector *parameters{GetTypeParameters(*dtSymbol)};
 417   std::string distinctName{typeName};
 418   if (&dtScope != dtSymbol->scope() && derivedTypeSpec) {
 419     // Only create new type descriptions for different kind parameter values.
 420     // Type with different length parameters/same kind parameters can all
 421     // share the same type description available in the current scope.
 422     if (auto suffix{
 423             GetSuffixIfTypeKindParameters(*derivedTypeSpec, parameters)}) {
 424       distinctName += *suffix;
 425     }
 426   }
 427   std::string dtDescName{".dt."s + distinctName};
 428   Scope *dtSymbolScope{const_cast<Scope *>(dtSymbol->scope())};
 429   Scope &scope{
 430       GetContainingNonDerivedScope(dtSymbolScope ? *dtSymbolScope : dtScope)};
 431   if (const auto it{scope.find(SourceName{dtDescName})}; it != scope.end()) {
 432     dtScope.set_runtimeDerivedTypeDescription(*it->second);
 433     return &*it->second;
 434   }
 435
 436   // Create a new description object before populating it so that mutual
 437   // references will work as pointer targets.
 438   Symbol &dtObject{CreateObject(dtDescName, derivedTypeSchema_, scope)};
 439   dtScope.set_runtimeDerivedTypeDescription(dtObject);
 440   evaluate::StructureConstructorValues dtValues;
 441   AddValue(dtValues, derivedTypeSchema_, "name"s,
 442       SaveNameAsPointerTarget(scope, typeName));
 443   bool isPDTdefinitionWithKindParameters{
 444       !derivedTypeSpec && dtScope.IsDerivedTypeWithKindParameter()};
 445   if (!isPDTdefinitionWithKindParameters) {
 446     auto sizeInBytes{static_cast<common::ConstantSubscript>(dtScope.size())};
 447     if (auto alignment{dtScope.alignment().value_or(0)}) {
 448       sizeInBytes += alignment - 1;
 449       sizeInBytes /= alignment;
 450       sizeInBytes *= alignment;
 451     }
 452     AddValue(
 453         dtValues, derivedTypeSchema_, "sizeinbytes"s, IntToExpr(sizeInBytes));
 454   }
 455   bool isPDTinstantiation{derivedTypeSpec && &dtScope != dtSymbol->scope()};
 456   if (isPDTinstantiation) {
 457     // is PDT instantiation
 458     const Symbol *uninstDescObject{
 459         DescribeType(DEREF(const_cast<Scope *>(dtSymbol->scope())))};
 460     AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
 461         evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
 462             evaluate::Designator<evaluate::SomeDerived>{
 463                 DEREF(uninstDescObject)}}));
 464   } else {
 465     AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
 466         SomeExpr{evaluate::NullPointer{}});
 467   }
 468   using Int8 = evaluate::Type<TypeCategory::Integer, 8>;
 469   using Int1 = evaluate::Type<TypeCategory::Integer, 1>;
 470   std::vector<Int8::Scalar> kinds;
 471   std::vector<Int1::Scalar> lenKinds;
 472   if (parameters) {
 473     // Package the derived type's parameters in declaration order for
 474     // each category of parameter.  KIND= type parameters are described
 475     // by their instantiated (or default) values, while LEN= type
 476     // parameters are described by their INTEGER kinds.
 477     for (SymbolRef ref : *parameters) {
 478       const auto &tpd{ref->get<TypeParamDetails>()};
 479       if (tpd.attr() == common::TypeParamAttr::Kind) {
 480         auto value{evaluate::ToInt64(tpd.init()).value_or(0)};
 481         if (derivedTypeSpec) {
 482           if (const auto *pv{derivedTypeSpec->FindParameter(ref->name())}) {
 483             if (pv->GetExplicit()) {
 484               if (auto instantiatedValue{
 485                       evaluate::ToInt64(*pv->GetExplicit())}) {
 486                 value = *instantiatedValue;
 487               }
 488             }
 489           }
 490         }
 491         kinds.emplace_back(value);
 492       } else { // LEN= parameter
 493         lenKinds.emplace_back(GetIntegerKind(*ref));
 494       }
 495     }
 496   }
 497   AddValue(dtValues, derivedTypeSchema_, "kindparameter"s,
 498       SaveNumericPointerTarget<Int8>(
 499           scope, SaveObjectName(".kp."s + distinctName), std::move(kinds)));
 500   AddValue(dtValues, derivedTypeSchema_, "lenparameterkind"s,
 501       SaveNumericPointerTarget<Int1>(
 502           scope, SaveObjectName(".lpk."s + distinctName), std::move(lenKinds)));
 503   // Traverse the components of the derived type
 504   if (!isPDTdefinitionWithKindParameters) {
 505     std::vector<const Symbol *> dataComponentSymbols;
 506     std::vector<evaluate::StructureConstructor> procPtrComponents;
 507     for (const auto &pair : dtScope) {
 508       const Symbol &symbol{*pair.second};
 509       auto locationRestorer{common::ScopedSet(location_, symbol.name())};
 510       common::visit(
 511           common::visitors{
 512               [&](const TypeParamDetails &) {
 513                 // already handled above in declaration order
 514               },
 515               [&](const ObjectEntityDetails &) {
 516                 dataComponentSymbols.push_back(&symbol);
 517               },
 518               [&](const ProcEntityDetails &proc) {
 519                 if (IsProcedurePointer(symbol)) {
 520                   procPtrComponents.emplace_back(
 521                       DescribeComponent(symbol, proc, scope));
 522                 }
 523               },
 524               [&](const ProcBindingDetails &) { // handled in a later pass
 525               },
 526               [&](const GenericDetails &) { // ditto
 527               },
 528               [&](const auto &) {
 529                 common::die(
 530                     "unexpected details on symbol '%s' in derived type scope",
 531                     symbol.name().ToString().c_str());
 532               },
 533           },
 534           symbol.details());
 535     }
 536     // Sort the data component symbols by offset before emitting them
 537     std::sort(dataComponentSymbols.begin(), dataComponentSymbols.end(),
 538         [](const Symbol *x, const Symbol *y) {
 539           return x->offset() < y->offset();
 540         });
 541     std::vector<evaluate::StructureConstructor> dataComponents;
 542     for (const Symbol *symbol : dataComponentSymbols) {
 543       auto locationRestorer{common::ScopedSet(location_, symbol->name())};
 544       dataComponents.emplace_back(
 545           DescribeComponent(*symbol, symbol->get<ObjectEntityDetails>(), scope,
 546               dtScope, distinctName, parameters));
 547     }
 548     AddValue(dtValues, derivedTypeSchema_, "component"s,
 549         SaveDerivedPointerTarget(scope, SaveObjectName(".c."s + distinctName),
 550             std::move(dataComponents),
 551             evaluate::ConstantSubscripts{
 552                 static_cast<evaluate::ConstantSubscript>(
 553                     dataComponents.size())}));
 554     AddValue(dtValues, derivedTypeSchema_, "procptr"s,
 555         SaveDerivedPointerTarget(scope, SaveObjectName(".p."s + distinctName),
 556             std::move(procPtrComponents),
 557             evaluate::ConstantSubscripts{
 558                 static_cast<evaluate::ConstantSubscript>(
 559                     procPtrComponents.size())}));
 560     // Compile the "vtable" of type-bound procedure bindings
 561     std::uint32_t specialBitSet{0};
 562     bool isAbstractType{dtSymbol->attrs().test(Attr::ABSTRACT)};
 563     if (!isAbstractType) {
 564       std::vector<evaluate::StructureConstructor> bindings{
 565           DescribeBindings(dtScope, scope)};
 566       AddValue(dtValues, derivedTypeSchema_, bindingDescCompName,
 567           SaveDerivedPointerTarget(scope, SaveObjectName(".v."s + distinctName),
 568               std::move(bindings),
 569               evaluate::ConstantSubscripts{
 570                   static_cast<evaluate::ConstantSubscript>(bindings.size())}));
 571       // Describe "special" bindings to defined assignments, FINAL subroutines,
 572       // and user-defined derived type I/O subroutines.  Defined assignments
 573       // and I/O subroutines override any parent bindings; FINAL subroutines
 574       // do not (the runtime will call all of them).
 575       std::map<int, evaluate::StructureConstructor> specials{
 576           DescribeSpecialGenerics(dtScope, dtScope, derivedTypeSpec)};
 577       if (derivedTypeSpec) {
 578         for (auto &ref : FinalsForDerivedTypeInstantiation(*derivedTypeSpec)) {
 579           DescribeSpecialProc(specials, *ref, false /*!isAssignment*/, true,
 580               std::nullopt, nullptr, derivedTypeSpec);
 581         }
 582         IncorporateDefinedIoGenericInterfaces(specials,
 583             GenericKind::DefinedIo::ReadFormatted, &scope, derivedTypeSpec);
 584         IncorporateDefinedIoGenericInterfaces(specials,
 585             GenericKind::DefinedIo::ReadUnformatted, &scope, derivedTypeSpec);
 586         IncorporateDefinedIoGenericInterfaces(specials,
 587             GenericKind::DefinedIo::WriteFormatted, &scope, derivedTypeSpec);
 588         IncorporateDefinedIoGenericInterfaces(specials,
 589             GenericKind::DefinedIo::WriteUnformatted, &scope, derivedTypeSpec);
 590       }
 591       // Pack the special procedure bindings in ascending order of their "which"
 592       // code values, and compile a little-endian bit-set of those codes for
 593       // use in O(1) look-up at run time.
 594       std::vector<evaluate::StructureConstructor> sortedSpecials;
 595       for (auto &pair : specials) {
 596         auto bit{std::uint32_t{1} << pair.first};
 597         CHECK(!(specialBitSet & bit));
 598         specialBitSet |= bit;
 599         sortedSpecials.emplace_back(std::move(pair.second));
 600       }
 601       AddValue(dtValues, derivedTypeSchema_, "special"s,
 602           SaveDerivedPointerTarget(scope, SaveObjectName(".s."s + distinctName),
 603               std::move(sortedSpecials),
 604               evaluate::ConstantSubscripts{
 605                   static_cast<evaluate::ConstantSubscript>(specials.size())}));
 606     }
 607     AddValue(dtValues, derivedTypeSchema_, "specialbitset"s,
 608         IntExpr<4>(specialBitSet));
 609     // Note the presence/absence of a parent component
 610     AddValue(dtValues, derivedTypeSchema_, "hasparent"s,
 611         IntExpr<1>(dtScope.GetDerivedTypeParent() != nullptr));
 612     // To avoid wasting run time attempting to initialize derived type
 613     // instances without any initialized components, analyze the type
 614     // and set a flag if there's nothing to do for it at run time.
 615     AddValue(dtValues, derivedTypeSchema_, "noinitializationneeded"s,
 616         IntExpr<1>(
 617             derivedTypeSpec && !derivedTypeSpec->HasDefaultInitialization()));
 618     // Similarly, a flag to short-circuit destruction when not needed.
 619     AddValue(dtValues, derivedTypeSchema_, "nodestructionneeded"s,
 620         IntExpr<1>(isAbstractType ||
 621             (derivedTypeSpec && !derivedTypeSpec->HasDestruction())));
 622     // Similarly, a flag to short-circuit finalization when not needed.
 623     AddValue(dtValues, derivedTypeSchema_, "nofinalizationneeded"s,
 624         IntExpr<1>(isAbstractType ||
 625             (derivedTypeSpec && !IsFinalizable(*derivedTypeSpec))));
 626   }
 627   dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{
 628       StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))});
 629   return &dtObject;
 630 }
 631
 632 static const Symbol &GetSymbol(const Scope &schemata, SourceName name) {
 633   auto iter{schemata.find(name)};
 634   CHECK(iter != schemata.end());
 635   const Symbol &symbol{*iter->second};
 636   return symbol;
 637 }
 638
 639 const Symbol &RuntimeTableBuilder::GetSchemaSymbol(const char *name) const {
 640   return GetSymbol(
 641       DEREF(tables_.schemata), SourceName{name, std::strlen(name)});
 642 }
 643
 644 const DeclTypeSpec &RuntimeTableBuilder::GetSchema(
 645     const char *schemaName) const {
 646   Scope &schemata{DEREF(tables_.schemata)};
 647   SourceName name{schemaName, std::strlen(schemaName)};
 648   const Symbol &symbol{GetSymbol(schemata, name)};
 649   CHECK(symbol.has<DerivedTypeDetails>());
 650   CHECK(symbol.scope());
 651   CHECK(symbol.scope()->IsDerivedType());
 652   const DeclTypeSpec *spec{nullptr};
 653   if (symbol.scope()->derivedTypeSpec()) {
 654     DeclTypeSpec typeSpec{
 655         DeclTypeSpec::TypeDerived, *symbol.scope()->derivedTypeSpec()};
 656     spec = schemata.FindType(typeSpec);
 657   }
 658   if (!spec) {
 659     DeclTypeSpec typeSpec{
 660         DeclTypeSpec::TypeDerived, DerivedTypeSpec{name, symbol}};
 661     spec = schemata.FindType(typeSpec);
 662   }
 663   if (!spec) {
 664     spec = &schemata.MakeDerivedType(
 665         DeclTypeSpec::TypeDerived, DerivedTypeSpec{name, symbol});
 666   }
 667   CHECK(spec->AsDerived());
 668   return *spec;
 669 }
 670
 671 SomeExpr RuntimeTableBuilder::GetEnumValue(const char *name) const {
 672   const Symbol &symbol{GetSchemaSymbol(name)};
 673   auto value{evaluate::ToInt64(symbol.get<ObjectEntityDetails>().init())};
 674   CHECK(value.has_value());
 675   return IntExpr<1>(*value);
 676 }
 677
 678 Symbol &RuntimeTableBuilder::CreateObject(
 679     const std::string &name, const DeclTypeSpec &type, Scope &scope) {
 680   ObjectEntityDetails object;
 681   object.set_type(type);
 682   auto pair{scope.try_emplace(SaveObjectName(name),
 683       Attrs{Attr::TARGET, Attr::SAVE}, std::move(object))};
 684   CHECK(pair.second);
 685   Symbol &result{*pair.first->second};
 686   SetReadOnlyCompilerCreatedFlags(result);
 687   return result;
 688 }
 689
 690 SourceName RuntimeTableBuilder::SaveObjectName(const std::string &name) {
 691   return *tables_.names.insert(name).first;
 692 }
 693
 694 SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget(
 695     Scope &scope, const std::string &name) {
 696   CHECK(!name.empty());
 697   CHECK(name.front() != '.' || context_.IsTempName(name));
 698   ObjectEntityDetails object;
 699   auto len{static_cast<common::ConstantSubscript>(name.size())};
 700   if (const auto *spec{scope.FindType(DeclTypeSpec{CharacterTypeSpec{
 701           ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}}})}) {
 702     object.set_type(*spec);
 703   } else {
 704     object.set_type(scope.MakeCharacterType(
 705         ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}));
 706   }
 707   using evaluate::Ascii;
 708   using AsciiExpr = evaluate::Expr<Ascii>;
 709   object.set_init(evaluate::AsGenericExpr(AsciiExpr{name}));
 710   Symbol &symbol{*scope
 711                       .try_emplace(SaveObjectName(".n."s + name),
 712                           Attrs{Attr::TARGET, Attr::SAVE}, std::move(object))
 713                       .first->second};
 714   SetReadOnlyCompilerCreatedFlags(symbol);
 715   return evaluate::AsGenericExpr(
 716       AsciiExpr{evaluate::Designator<Ascii>{symbol}});
 717 }
 718
 719 evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
 720     const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope,
 721     Scope &dtScope, const std::string &distinctName,
 722     const SymbolVector *parameters) {
 723   evaluate::StructureConstructorValues values;
 724   auto &foldingContext{context_.foldingContext()};
 725   auto typeAndShape{evaluate::characteristics::TypeAndShape::Characterize(
 726       symbol, foldingContext)};
 727   CHECK(typeAndShape.has_value());
 728   auto dyType{typeAndShape->type()};
 729   const auto &shape{typeAndShape->shape()};
 730   AddValue(values, componentSchema_, "name"s,
 731       SaveNameAsPointerTarget(scope, symbol.name().ToString()));
 732   AddValue(values, componentSchema_, "category"s,
 733       IntExpr<1>(static_cast<int>(dyType.category())));
 734   if (dyType.IsUnlimitedPolymorphic() ||
 735       dyType.category() == TypeCategory::Derived) {
 736     AddValue(values, componentSchema_, "kind"s, IntExpr<1>(0));
 737   } else {
 738     AddValue(values, componentSchema_, "kind"s, IntExpr<1>(dyType.kind()));
 739   }
 740   AddValue(values, componentSchema_, "offset"s, IntExpr<8>(symbol.offset()));
 741   // CHARACTER length
 742   auto len{typeAndShape->LEN()};
 743   if (const semantics::DerivedTypeSpec *
 744       pdtInstance{dtScope.derivedTypeSpec()}) {
 745     auto restorer{foldingContext.WithPDTInstance(*pdtInstance)};
 746     len = Fold(foldingContext, std::move(len));
 747   }
 748   if (dyType.category() == TypeCategory::Character && len) {
 749     // Ignore IDIM(x) (represented as MAX(0, x))
 750     if (const auto *clamped{evaluate::UnwrapExpr<
 751             evaluate::Extremum<evaluate::SubscriptInteger>>(*len)}) {
 752       if (clamped->ordering == evaluate::Ordering::Greater &&
 753           clamped->left() == evaluate::Expr<evaluate::SubscriptInteger>{0}) {
 754         len = common::Clone(clamped->right());
 755       }
 756     }
 757     AddValue(values, componentSchema_, "characterlen"s,
 758         evaluate::AsGenericExpr(GetValue(len, parameters)));
 759   } else {
 760     AddValue(values, componentSchema_, "characterlen"s,
 761         PackageIntValueExpr(deferredEnum_));
 762   }
 763   // Describe component's derived type
 764   std::vector<evaluate::StructureConstructor> lenParams;
 765   if (dyType.category() == TypeCategory::Derived &&
 766       !dyType.IsUnlimitedPolymorphic()) {
 767     const DerivedTypeSpec &spec{dyType.GetDerivedTypeSpec()};
 768     Scope *derivedScope{const_cast<Scope *>(
 769         spec.scope() ? spec.scope() : spec.typeSymbol().scope())};
 770     const Symbol *derivedDescription{DescribeType(DEREF(derivedScope))};
 771     AddValue(values, componentSchema_, "derived"s,
 772         evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
 773             evaluate::Designator<evaluate::SomeDerived>{
 774                 DEREF(derivedDescription)}}));
 775     // Package values of LEN parameters, if any
 776     if (const SymbolVector * specParams{GetTypeParameters(spec.typeSymbol())}) {
 777       for (SymbolRef ref : *specParams) {
 778         const auto &tpd{ref->get<TypeParamDetails>()};
 779         if (tpd.attr() == common::TypeParamAttr::Len) {
 780           if (const ParamValue * paramValue{spec.FindParameter(ref->name())}) {
 781             lenParams.emplace_back(GetValue(*paramValue, parameters));
 782           } else {
 783             lenParams.emplace_back(GetValue(tpd.init(), parameters));
 784           }
 785         }
 786       }
 787     }
 788   } else {
 789     // Subtle: a category of Derived with a null derived type pointer
 790     // signifies CLASS(*)
 791     AddValue(values, componentSchema_, "derived"s,
 792         SomeExpr{evaluate::NullPointer{}});
 793   }
 794   // LEN type parameter values for the component's type
 795   if (!lenParams.empty()) {
 796     AddValue(values, componentSchema_, "lenvalue"s,
 797         SaveDerivedPointerTarget(scope,
 798             SaveObjectName(
 799                 ".lv."s + distinctName + "."s + symbol.name().ToString()),
 800             std::move(lenParams),
 801             evaluate::ConstantSubscripts{
 802                 static_cast<evaluate::ConstantSubscript>(lenParams.size())}));
 803   } else {
 804     AddValue(values, componentSchema_, "lenvalue"s,
 805         SomeExpr{evaluate::NullPointer{}});
 806   }
 807   // Shape information
 808   int rank{evaluate::GetRank(shape)};
 809   AddValue(values, componentSchema_, "rank"s, IntExpr<1>(rank));
 810   if (rank > 0 && !IsAllocatable(symbol) && !IsPointer(symbol)) {
 811     std::vector<evaluate::StructureConstructor> bounds;
 812     evaluate::NamedEntity entity{symbol};
 813     for (int j{0}; j < rank; ++j) {
 814       bounds.emplace_back(
 815           GetValue(std::make_optional(
 816                        evaluate::GetRawLowerBound(foldingContext, entity, j)),
 817               parameters));
 818       bounds.emplace_back(GetValue(
 819           evaluate::GetRawUpperBound(foldingContext, entity, j), parameters));
 820     }
 821     AddValue(values, componentSchema_, "bounds"s,
 822         SaveDerivedPointerTarget(scope,
 823             SaveObjectName(
 824                 ".b."s + distinctName + "."s + symbol.name().ToString()),
 825             std::move(bounds), evaluate::ConstantSubscripts{2, rank}));
 826   } else {
 827     AddValue(
 828         values, componentSchema_, "bounds"s, SomeExpr{evaluate::NullPointer{}});
 829   }
 830   // Default component initialization
 831   bool hasDataInit{false};
 832   if (IsAllocatable(symbol)) {
 833     AddValue(values, componentSchema_, "genre"s, GetEnumValue("allocatable"));
 834   } else if (IsPointer(symbol)) {
 835     AddValue(values, componentSchema_, "genre"s, GetEnumValue("pointer"));
 836     hasDataInit = InitializeDataPointer(
 837         values, symbol, object, scope, dtScope, distinctName);
 838   } else if (IsAutomatic(symbol)) {
 839     AddValue(values, componentSchema_, "genre"s, GetEnumValue("automatic"));
 840   } else {
 841     AddValue(values, componentSchema_, "genre"s, GetEnumValue("data"));
 842     hasDataInit = object.init().has_value();
 843     if (hasDataInit) {
 844       AddValue(values, componentSchema_, "initialization"s,
 845           SaveObjectInit(scope,
 846               SaveObjectName(
 847                   ".di."s + distinctName + "."s + symbol.name().ToString()),
 848               object));
 849     }
 850   }
 851   if (!hasDataInit) {
 852     AddValue(values, componentSchema_, "initialization"s,
 853         SomeExpr{evaluate::NullPointer{}});
 854   }
 855   return {DEREF(componentSchema_.AsDerived()), std::move(values)};
 856 }
 857
 858 evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
 859     const Symbol &symbol, const ProcEntityDetails &proc, Scope &scope) {
 860   evaluate::StructureConstructorValues values;
 861   AddValue(values, procPtrSchema_, "name"s,
 862       SaveNameAsPointerTarget(scope, symbol.name().ToString()));
 863   AddValue(values, procPtrSchema_, "offset"s, IntExpr<8>(symbol.offset()));
 864   if (auto init{proc.init()}; init && *init) {
 865     AddValue(values, procPtrSchema_, "initialization"s,
 866         SomeExpr{evaluate::ProcedureDesignator{**init}});
 867   } else {
 868     AddValue(values, procPtrSchema_, "initialization"s,
 869         SomeExpr{evaluate::NullPointer{}});
 870   }
 871   return {DEREF(procPtrSchema_.AsDerived()), std::move(values)};
 872 }
 873
 874 // Create a static pointer object with the same initialization
 875 // from whence the runtime can memcpy() the data pointer
 876 // component initialization.
 877 // Creates and interconnects the symbols, scopes, and types for
 878 //   TYPE :: ptrDt
 879 //     type, POINTER :: name
 880 //   END TYPE
 881 //   TYPE(ptrDt), TARGET, SAVE :: ptrInit = ptrDt(designator)
 882 // and then initializes the original component by setting
 883 //   initialization = ptrInit
 884 // which takes the address of ptrInit because the type is C_PTR.
 885 // This technique of wrapping the data pointer component into
 886 // a derived type instance disables any reason for lowering to
 887 // attempt to dereference the RHS of an initializer, thereby
 888 // allowing the runtime to actually perform the initialization
 889 // by means of a simple memcpy() of the wrapped descriptor in
 890 // ptrInit to the data pointer component being initialized.
 891 bool RuntimeTableBuilder::InitializeDataPointer(
 892     evaluate::StructureConstructorValues &values, const Symbol &symbol,
 893     const ObjectEntityDetails &object, Scope &scope, Scope &dtScope,
 894     const std::string &distinctName) {
 895   if (object.init().has_value()) {
 896     SourceName ptrDtName{SaveObjectName(
 897         ".dp."s + distinctName + "."s + symbol.name().ToString())};
 898     Symbol &ptrDtSym{
 899         *scope.try_emplace(ptrDtName, Attrs{}, UnknownDetails{}).first->second};
 900     SetReadOnlyCompilerCreatedFlags(ptrDtSym);
 901     Scope &ptrDtScope{scope.MakeScope(Scope::Kind::DerivedType, &ptrDtSym)};
 902     ignoreScopes_.insert(&ptrDtScope);
 903     ObjectEntityDetails ptrDtObj;
 904     ptrDtObj.set_type(DEREF(object.type()));
 905     ptrDtObj.set_shape(object.shape());
 906     Symbol &ptrDtComp{*ptrDtScope
 907                            .try_emplace(symbol.name(), Attrs{Attr::POINTER},
 908                                std::move(ptrDtObj))
 909                            .first->second};
 910     DerivedTypeDetails ptrDtDetails;
 911     ptrDtDetails.add_component(ptrDtComp);
 912     ptrDtSym.set_details(std::move(ptrDtDetails));
 913     ptrDtSym.set_scope(&ptrDtScope);
 914     DeclTypeSpec &ptrDtDeclType{
 915         scope.MakeDerivedType(DeclTypeSpec::Category::TypeDerived,
 916             DerivedTypeSpec{ptrDtName, ptrDtSym})};
 917     DerivedTypeSpec &ptrDtDerived{DEREF(ptrDtDeclType.AsDerived())};
 918     ptrDtDerived.set_scope(ptrDtScope);
 919     ptrDtDerived.CookParameters(context_.foldingContext());
 920     ptrDtDerived.Instantiate(scope);
 921     ObjectEntityDetails ptrInitObj;
 922     ptrInitObj.set_type(ptrDtDeclType);
 923     evaluate::StructureConstructorValues ptrInitValues;
 924     AddValue(
 925         ptrInitValues, ptrDtDeclType, symbol.name().ToString(), *object.init());
 926     ptrInitObj.set_init(evaluate::AsGenericExpr(
 927         Structure(ptrDtDeclType, std::move(ptrInitValues))));
 928     AddValue(values, componentSchema_, "initialization"s,
 929         SaveObjectInit(scope,
 930             SaveObjectName(
 931                 ".di."s + distinctName + "."s + symbol.name().ToString()),
 932             ptrInitObj));
 933     return true;
 934   } else {
 935     return false;
 936   }
 937 }
 938
 939 evaluate::StructureConstructor RuntimeTableBuilder::PackageIntValue(
 940     const SomeExpr &genre, std::int64_t n) const {
 941   evaluate::StructureConstructorValues xs;
 942   AddValue(xs, valueSchema_, "genre"s, genre);
 943   AddValue(xs, valueSchema_, "value"s, IntToExpr(n));
 944   return Structure(valueSchema_, std::move(xs));
 945 }
 946
 947 SomeExpr RuntimeTableBuilder::PackageIntValueExpr(
 948     const SomeExpr &genre, std::int64_t n) const {
 949   return StructureExpr(PackageIntValue(genre, n));
 950 }
 951
 952 SymbolVector CollectBindings(const Scope &dtScope) {
 953   SymbolVector result;
 954   std::map<SourceName, const Symbol *> localBindings;
 955   // Collect local bindings
 956   for (auto pair : dtScope) {
 957     const Symbol &symbol{*pair.second};
 958     if (symbol.has<ProcBindingDetails>()) {
 959       localBindings.emplace(symbol.name(), &symbol);
 960     }
 961   }
 962   if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) {
 963     result = CollectBindings(*parentScope);
 964     // Apply overrides from the local bindings of the extended type
 965     for (auto iter{result.begin()}; iter != result.end(); ++iter) {
 966       const Symbol &symbol{**iter};
 967       auto overridden{localBindings.find(symbol.name())};
 968       if (overridden != localBindings.end()) {
 969         *iter = *overridden->second;
 970         localBindings.erase(overridden);
 971       }
 972     }
 973   }
 974   // Add remaining (non-overriding) local bindings in name order to the result
 975   for (auto pair : localBindings) {
 976     result.push_back(*pair.second);
 977   }
 978   return result;
 979 }
 980
 981 std::vector<evaluate::StructureConstructor>
 982 RuntimeTableBuilder::DescribeBindings(const Scope &dtScope, Scope &scope) {
 983   std::vector<evaluate::StructureConstructor> result;
 984   for (const SymbolRef &ref : CollectBindings(dtScope)) {
 985     evaluate::StructureConstructorValues values;
 986     AddValue(values, bindingSchema_, procCompName,
 987         SomeExpr{evaluate::ProcedureDesignator{
 988             ref.get().get<ProcBindingDetails>().symbol()}});
 989     AddValue(values, bindingSchema_, "name"s,
 990         SaveNameAsPointerTarget(scope, ref.get().name().ToString()));
 991     result.emplace_back(DEREF(bindingSchema_.AsDerived()), std::move(values));
 992   }
 993   return result;
 994 }
 995
 996 std::map<int, evaluate::StructureConstructor>
 997 RuntimeTableBuilder::DescribeSpecialGenerics(const Scope &dtScope,
 998     const Scope &thisScope, const DerivedTypeSpec *derivedTypeSpec) const {
 999   std::map<int, evaluate::StructureConstructor> specials;
1000   if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) {
1001     specials =
1002         DescribeSpecialGenerics(*parentScope, thisScope, derivedTypeSpec);
1003   }
1004   for (auto pair : dtScope) {
1005     const Symbol &symbol{*pair.second};
1006     if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {
1007       DescribeSpecialGeneric(*generic, specials, thisScope, derivedTypeSpec);
1008     }
1009   }
1010   return specials;
1011 }
1012
1013 void RuntimeTableBuilder::DescribeSpecialGeneric(const GenericDetails &generic,
1014     std::map<int, evaluate::StructureConstructor> &specials,
1015     const Scope &dtScope, const DerivedTypeSpec *derivedTypeSpec) const {
1016   common::visit(common::visitors{
1017                     [&](const GenericKind::OtherKind &k) {
1018                       if (k == GenericKind::OtherKind::Assignment) {
1019                         for (auto ref : generic.specificProcs()) {
1020                           DescribeSpecialProc(specials, *ref, true,
1021                               false /*!final*/, std::nullopt, &dtScope,
1022                               derivedTypeSpec);
1023                         }
1024                       }
1025                     },
1026                     [&](const GenericKind::DefinedIo &io) {
1027                       switch (io) {
1028                       case GenericKind::DefinedIo::ReadFormatted:
1029                       case GenericKind::DefinedIo::ReadUnformatted:
1030                       case GenericKind::DefinedIo::WriteFormatted:
1031                       case GenericKind::DefinedIo::WriteUnformatted:
1032                         for (auto ref : generic.specificProcs()) {
1033                           DescribeSpecialProc(specials, *ref, false,
1034                               false /*!final*/, io, &dtScope, derivedTypeSpec);
1035                         }
1036                         break;
1037                       }
1038                     },
1039                     [](const auto &) {},
1040                 },
1041       generic.kind().u);
1042 }
1043
1044 void RuntimeTableBuilder::DescribeSpecialProc(
1045     std::map<int, evaluate::StructureConstructor> &specials,
1046     const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
1047     std::optional<GenericKind::DefinedIo> io, const Scope *dtScope,
1048     const DerivedTypeSpec *derivedTypeSpec) const {
1049   const auto *binding{specificOrBinding.detailsIf<ProcBindingDetails>()};
1050   if (binding && dtScope) { // use most recent override
1051     binding = &DEREF(dtScope->FindComponent(specificOrBinding.name()))
1052                    .get<ProcBindingDetails>();
1053   }
1054   const Symbol &specific{*(binding ? &binding->symbol() : &specificOrBinding)};
1055   if (auto proc{evaluate::characteristics::Procedure::Characterize(
1056           specific, context_.foldingContext())}) {
1057     std::uint8_t isArgDescriptorSet{0};
1058     int argThatMightBeDescriptor{0};
1059     MaybeExpr which;
1060     if (isAssignment) {
1061       // Only type-bound asst's with the same type on both dummy arguments
1062       // are germane to the runtime, which needs only these to implement
1063       // component assignment as part of intrinsic assignment.
1064       // Non-type-bound generic INTERFACEs and assignments from distinct
1065       // types must not be used for component intrinsic assignment.
1066       CHECK(proc->dummyArguments.size() == 2);
1067       const auto t1{
1068           DEREF(std::get_if<evaluate::characteristics::DummyDataObject>(
1069                     &proc->dummyArguments[0].u))
1070               .type.type()};
1071       const auto t2{
1072           DEREF(std::get_if<evaluate::characteristics::DummyDataObject>(
1073                     &proc->dummyArguments[1].u))
1074               .type.type()};
1075       if (!binding || t1.category() != TypeCategory::Derived ||
1076           t2.category() != TypeCategory::Derived ||
1077           t1.IsUnlimitedPolymorphic() || t2.IsUnlimitedPolymorphic() ||
1078           t1.GetDerivedTypeSpec() != t2.GetDerivedTypeSpec()) {
1079         return;
1080       }
1081       which = proc->IsElemental() ? elementalAssignmentEnum_
1082                                   : scalarAssignmentEnum_;
1083       if (binding && binding->passName() &&
1084           *binding->passName() == proc->dummyArguments[1].name) {
1085         argThatMightBeDescriptor = 1;
1086         isArgDescriptorSet |= 2;
1087       } else {
1088         argThatMightBeDescriptor = 2; // the non-passed-object argument
1089         isArgDescriptorSet |= 1;
1090       }
1091     } else if (isFinal) {
1092       CHECK(binding == nullptr); // FINALs are not bindings
1093       CHECK(proc->dummyArguments.size() == 1);
1094       if (proc->IsElemental()) {
1095         which = elementalFinalEnum_;
1096       } else {
1097         const auto &typeAndShape{
1098             std::get<evaluate::characteristics::DummyDataObject>(
1099                 proc->dummyArguments.at(0).u)
1100                 .type};
1101         if (typeAndShape.attrs().test(
1102                 evaluate::characteristics::TypeAndShape::Attr::AssumedRank)) {
1103           which = assumedRankFinalEnum_;
1104           isArgDescriptorSet |= 1;
1105         } else {
1106           which = scalarFinalEnum_;
1107           if (int rank{evaluate::GetRank(typeAndShape.shape())}; rank > 0) {
1108             argThatMightBeDescriptor = 1;
1109             which = IntExpr<1>(ToInt64(which).value() + rank);
1110           }
1111         }
1112       }
1113     } else { // user defined derived type I/O
1114       CHECK(proc->dummyArguments.size() >= 4);
1115       const auto *ddo{std::get_if<evaluate::characteristics::DummyDataObject>(
1116           &proc->dummyArguments[0].u)};
1117       if (!ddo) {
1118         return;
1119       }
1120       if (derivedTypeSpec &&
1121           !ddo->type.type().IsTkCompatibleWith(
1122               evaluate::DynamicType{*derivedTypeSpec})) {
1123         // Defined I/O specific procedure is not for this derived type.
1124         return;
1125       }
1126       if (ddo->type.type().IsPolymorphic()) {
1127         isArgDescriptorSet |= 1;
1128       }
1129       switch (io.value()) {
1130       case GenericKind::DefinedIo::ReadFormatted:
1131         which = readFormattedEnum_;
1132         break;
1133       case GenericKind::DefinedIo::ReadUnformatted:
1134         which = readUnformattedEnum_;
1135         break;
1136       case GenericKind::DefinedIo::WriteFormatted:
1137         which = writeFormattedEnum_;
1138         break;
1139       case GenericKind::DefinedIo::WriteUnformatted:
1140         which = writeUnformattedEnum_;
1141         break;
1142       }
1143     }
1144     if (argThatMightBeDescriptor != 0 &&
1145         !proc->dummyArguments.at(argThatMightBeDescriptor - 1)
1146              .CanBePassedViaImplicitInterface()) {
1147       isArgDescriptorSet |= 1 << (argThatMightBeDescriptor - 1);
1148     }
1149     evaluate::StructureConstructorValues values;
1150     auto index{evaluate::ToInt64(which)};
1151     CHECK(index.has_value());
1152     AddValue(
1153         values, specialSchema_, "which"s, SomeExpr{std::move(which.value())});
1154     AddValue(values, specialSchema_, "isargdescriptorset"s,
1155         IntExpr<1>(isArgDescriptorSet));
1156     AddValue(values, specialSchema_, procCompName,
1157         SomeExpr{evaluate::ProcedureDesignator{specific}});
1158     // index might already be present in the case of an override
1159     specials.emplace(*index,
1160         evaluate::StructureConstructor{
1161             DEREF(specialSchema_.AsDerived()), std::move(values)});
1162   }
1163 }
1164
1165 void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces(
1166     std::map<int, evaluate::StructureConstructor> &specials,
1167     GenericKind::DefinedIo definedIo, const Scope *scope,
1168     const DerivedTypeSpec *derivedTypeSpec) {
1169   SourceName name{GenericKind::AsFortran(definedIo)};
1170   for (; !scope->IsGlobal(); scope = &scope->parent()) {
1171     if (auto asst{scope->find(name)}; asst != scope->end()) {
1172       const Symbol &generic{asst->second->GetUltimate()};
1173       const auto &genericDetails{generic.get<GenericDetails>()};
1174       CHECK(std::holds_alternative<GenericKind::DefinedIo>(
1175           genericDetails.kind().u));
1176       CHECK(std::get<GenericKind::DefinedIo>(genericDetails.kind().u) ==
1177           definedIo);
1178       for (auto ref : genericDetails.specificProcs()) {
1179         DescribeSpecialProc(
1180             specials, *ref, false, false, definedIo, nullptr, derivedTypeSpec);
1181       }
1182     }
1183   }
1184 }
1185
1186 RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(
1187     SemanticsContext &context) {
1188   RuntimeDerivedTypeTables result;
1189   result.schemata = context.GetBuiltinModule(typeInfoBuiltinModule);
1190   if (result.schemata) {
1191     RuntimeTableBuilder builder{context, result};
1192     builder.DescribeTypes(context.globalScope(), false);
1193   }
1194   return result;
1195 }
1196
1197 } // namespace Fortran::semantics