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