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