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