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