[flang] Implement derived type description table encoding

[klausler]

Summary

Define Fortran derived types that describe the characteristics
of derived types, and instantiations of parameterized derived
types, that are of relevance to the runtime language support
library. Define a suite of corresponding C++ structure types
for the runtime library to use to interpret instances of the
descriptions.

Create instances of these description types in Semantics as
static initializers for compiler-created objects in the scopes
that define or instantiate user derived types.

Delete obsolete code from earlier attempts to package runtime
type information.

[jeanPerier]

flang/test/Semantics/typeinfo01.f90

5

This test is a nice illustration of what is happening, thanks for adding it.

flang/docs/RuntimeTypeInfo.md

 bound subroutine is a passed object dummy argument and satisfies
 all of the constraints of one -- in particular, it's scalar and
 polymorphic.
 
 So the derived type information for a defined assignment needs to
 comprise:
 * address(es) of the subroutine
 * whether the first, second, or both arguments are descriptors
-* whether the subroutine is elemental
+* whether the subroutine is elemental (necessarily also impure)
 
 ### User defined derived type I/O
 
 Fortran programs can specify subroutines that implement formatted and
 unformatted `READ` and `WRITE` operations for derived types.
 These defined I/O subroutines may be specified with an explicit `INTERFACE`
 or with a type-bound generic.
 When specified with an `INTERFACE`, the first argument must not be

flang/include/flang/Semantics/runtime-type-info.h

+//===-- include/flang/Semantics/runtime-type-info.h -------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// BuildRuntimeDerivedTypeTables() translates the scopes of derived types
+// and parameterized derived type instantiations into the type descriptions
+// defined in module/__fortran_type_info.f90, packaging these descriptions
+// as static initializers for compiler-created objects.
+
+#ifndef FORTRAN_SEMANTICS_RUNTIME_TYPE_INFO_H_
+#define FORTRAN_SEMANTICS_RUNTIME_TYPE_INFO_H_
+
+#include <set>
+#include <string>
+
+namespace llvm {
+class raw_ostream;
+}
+
+namespace Fortran::semantics {
+class Scope;
+class SemanticsContext;
+class Symbol;
+
+struct RuntimeDerivedTypeTables {
+  Scope *schemata{nullptr};
+  std::set<std::string> names;
+};
+
+RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(SemanticsContext &);
+
+void Dump(llvm::raw_ostream &, const RuntimeDerivedTypeTables &);
+} // namespace Fortran::semantics
+#endif // FORTRAN_SEMANTICS_RUNTIME_TYPE_INFO_H_

flang/include/flang/Semantics/scope.h

public:
   const DeclTypeSpec &MakeCharacterType(
       ParamValue &&length, KindExpr &&kind = KindExpr{0});
   DeclTypeSpec &MakeDerivedType(DeclTypeSpec::Category, DerivedTypeSpec &&);
   const DeclTypeSpec &MakeTypeStarType();
   const DeclTypeSpec &MakeClassStarType();
 
   std::size_t size() const { return size_; }
   void set_size(std::size_t size) { size_ = size; }
-  std::size_t alignment() const { return alignment_; }
-  void set_alignment(std::size_t alignment) { alignment_ = alignment; }
+  std::optional<std::size_t> alignment() const { return alignment_; }
+
+  void SetAlignment(std::size_t n) {
+    alignment_ = std::max(alignment_.value_or(0), n);
+  }
 
   ImportKind GetImportKind() const;
   // Names appearing in IMPORT statements in this scope
   std::set<SourceName> importNames() const { return importNames_; }
 
   // Set the kind of imports from host into this scope.
   // Return an error message for incompatible kinds.
   std::optional<parser::MessageFixedText> SetImportKind(ImportKind);
public:
 
   bool IsModuleFile() const {
     return kind_ == Kind::Module && symbol_ &&
         symbol_->test(Symbol::Flag::ModFile);
   }
 
   void InstantiateDerivedTypes(SemanticsContext &);
 
+  const Symbol *runtimeDerivedTypeDescription() const {
+    return runtimeDerivedTypeDescription_;
+  }
+  void set_runtimeDerivedTypeDescription(const Symbol &symbol) {
+    runtimeDerivedTypeDescription_ = &symbol;
+  }
+
 private:
   Scope &parent_; // this is enclosing scope, not extended derived type base
   const Kind kind_;
   std::size_t size_{0}; // size in bytes
-  std::size_t alignment_{0}; // required alignment in bytes
+  std::optional<std::size_t> alignment_; // required alignment in bytes
   parser::CharBlock sourceRange_;
   Symbol *const symbol_; // if not null, symbol_->scope() == this
   std::list<Scope> children_;
   mapType symbols_;
   mapType commonBlocks_;
   std::list<EquivalenceSet> equivalenceSets_;
   mapType crayPointers_;
   std::map<SourceName, common::Reference<Scope>> submodules_;
   std::list<DeclTypeSpec> declTypeSpecs_;
   std::optional<ImportKind> importKind_;
   std::set<SourceName> importNames_;
   DerivedTypeSpec *derivedTypeSpec_{nullptr}; // dTS->scope() == this
   parser::Message::Reference instantiationContext_;
   bool hasSAVE_{false}; // scope has a bare SAVE statement
+  const Symbol *runtimeDerivedTypeDescription_{nullptr};
   // When additional data members are added to Scope, remember to
   // copy them, if appropriate, in InstantiateDerivedType().
 
   // Storage for all Symbols. Every Symbol is in allSymbols and every Symbol*
   // or Symbol& points to one in there.
   static Symbols<1024> allSymbols;
 
   bool CanImport(const SourceName &) const;

flang/lib/Semantics/CMakeLists.txt

add_flang_library(FortranSemantics
   mod-file.cpp
   pointer-assignment.cpp
   program-tree.cpp
   resolve-labels.cpp
   resolve-directives.cpp
   resolve-names-utils.cpp
   resolve-names.cpp
   rewrite-parse-tree.cpp
+  runtime-type-info.cpp
   scope.cpp
   semantics.cpp
   symbol.cpp
   tools.cpp
   type.cpp
   unparse-with-symbols.cpp
 
   DEPENDS

flang/lib/Semantics/compute-offsets.cpp

void ComputeOffsetsHelper::Compute(Scope &scope) {
   dependents_.clear();
   equivalenceBlock_.clear();
 }
 
 void ComputeOffsetsHelper::DoScope(Scope &scope) {
   if (scope.symbol() && scope.IsParameterizedDerivedType()) {
     return; // only process instantiations of parameterized derived types
   }
+  if (scope.alignment().has_value()) {
+    return; // prevent infinite recursion in error cases
+  }
+  scope.SetAlignment(0);
   // Build dependents_ from equivalences: symbol -> symbol+offset
   for (const EquivalenceSet &set : scope.equivalenceSets()) {
     DoEquivalenceSet(set);
   }
   offset_ = 0;
-  alignment_ = 0;
+  alignment_ = 1;
   // Compute a base symbol and overall block size for each
   // disjoint EQUIVALENCE storage sequence.
   for (auto &[symbol, dep] : dependents_) {
     dep = Resolve(dep);
     CHECK(symbol->size() == 0);
     auto symInfo{GetSizeAndAlignment(*symbol)};
     symbol->set_size(symInfo.size);
     Symbol &base{*dep.symbol};
void ComputeOffsetsHelper::DoScope(Scope &scope) {
   for (auto &symbol : scope.GetSymbols()) {
     if (!InCommonBlock(*symbol) &&
         dependents_.find(symbol) == dependents_.end() &&
         equivalenceBlock_.find(symbol) == equivalenceBlock_.end()) {
       DoSymbol(*symbol);
     }
   }
   scope.set_size(offset_);
-  scope.set_alignment(alignment_);
+  scope.SetAlignment(alignment_);
   // Assign offsets in COMMON blocks.
   for (auto &pair : scope.commonBlocks()) {
     DoCommonBlock(*pair.second);
   }
   for (auto &[symbol, dep] : dependents_) {
     symbol->set_offset(dep.symbol->offset() + dep.offset);
     if (const auto *block{FindCommonBlockContaining(*dep.symbol)}) {
       symbol->get<ObjectEntityDetails>().set_commonBlock(*block);
if (type->category() == DeclTypeSpec::Character) {
       if (MaybeIntExpr lengthExpr{length.GetExplicit()}) {
         if (auto lengthInt{ToInt64(*lengthExpr)}) {
           result.size *= *lengthInt;
         }
       }
     }
   } else if (const DerivedTypeSpec * derived{type->AsDerived()}) {
     if (derived->scope()) {
+      DoScope(*const_cast<Scope *>(derived->scope()));
       result.size = derived->scope()->size();
-      result.alignment = derived->scope()->alignment();
+      result.alignment = derived->scope()->alignment().value_or(0);
     }
   } else {
     DIE("not intrinsic or derived");
   }
   return result;
 }
 
 std::size_t ComputeOffsetsHelper::CountElements(const Symbol &symbol) {

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

+//===-- lib/Semantics/runtime-type-info.cpp ---------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Semantics/runtime-type-info.h"
+#include "mod-file.h"
+#include "flang/Evaluate/fold-designator.h"
+#include "flang/Evaluate/fold.h"
+#include "flang/Evaluate/tools.h"
+#include "flang/Evaluate/type.h"
+#include "flang/Semantics/scope.h"
+#include "flang/Semantics/tools.h"
+#include <list>
+#include <map>
+#include <string>
+
+namespace Fortran::semantics {
+
+static int FindLenParameterIndex(
+    const SymbolVector &parameters, const Symbol &symbol) {
+  int lenIndex{0};
+  for (SymbolRef ref : parameters) {
+    if (&*ref == &symbol) {
+      return lenIndex;
+    }
+    if (ref->get<TypeParamDetails>().attr() == common::TypeParamAttr::Len) {
+      ++lenIndex;
+    }
+  }
+  DIE("Length type parameter not found in parameter order");
+  return -1;
+}
+
+class RuntimeTableBuilder {
+public:
+  RuntimeTableBuilder(SemanticsContext &, RuntimeDerivedTypeTables &);
+  void DescribeTypes(Scope &scope);
+
+private:
+  const Symbol *DescribeType(Scope &);
+  const Symbol &GetSchemaSymbol(const char *) const;
+  const DeclTypeSpec &GetSchema(const char *) const;
+  SomeExpr GetEnumValue(const char *) const;
+  Symbol &CreateObject(const std::string &, const DeclTypeSpec &, Scope &);
+  // The names of created symbols are saved in and owned by the
+  // RuntimeDerivedTypeTables instance returned by
+  // BuildRuntimeDerivedTypeTables() so that references to those names remain
+  // valid for lowering.
+  SourceName SaveObjectName(const std::string &);
+  SomeExpr SaveNameAsPointerTarget(Scope &, const std::string &);
+  const SymbolVector *GetTypeParameters(const Symbol &);
+  evaluate::StructureConstructor DescribeComponent(const Symbol &,
+      const ObjectEntityDetails &, Scope &, const std::string &distinctName,
+      const SymbolVector *parameters);
+  evaluate::StructureConstructor DescribeComponent(
+      const Symbol &, const ProcEntityDetails &, Scope &);
+  evaluate::StructureConstructor PackageIntValue(
+      const SomeExpr &genre, std::int64_t = 0) const;
+  SomeExpr PackageIntValueExpr(const SomeExpr &genre, std::int64_t = 0) const;
+  std::vector<const Symbol *> CollectBindings(const Scope &dtScope) const;
+  std::vector<evaluate::StructureConstructor> DescribeBindings(
+      const Scope &dtScope, Scope &);
+  void DescribeGeneric(
+      const GenericDetails &, std::vector<evaluate::StructureConstructor> &);
+  void DescribeSpecialProc(std::vector<evaluate::StructureConstructor> &,
+      const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
+      std::optional<GenericKind::DefinedIo>);
+  void IncorporateDefinedIoGenericInterfaces(
+      std::vector<evaluate::StructureConstructor> &, SourceName,
+      GenericKind::DefinedIo, const Scope *);
+
+  // Instantiated for ParamValue and Bound
+  template <typename A>
+  evaluate::StructureConstructor GetValue(
+      const A &x, const SymbolVector *parameters) {
+    if (x.isExplicit()) {
+      return GetValue(x.GetExplicit(), parameters);
+    } else {
+      return PackageIntValue(deferredEnum_);
+    }
+  }
+
+  // Specialization for optional<Expr<SomeInteger and SubscriptInteger>>
+  template <typename T>
+  evaluate::StructureConstructor GetValue(
+      const std::optional<evaluate::Expr<T>> &expr,
+      const SymbolVector *parameters) {
+    if (auto constValue{evaluate::ToInt64(expr)}) {
+      return PackageIntValue(explicitEnum_, *constValue);
+    }
+    if (parameters) {
+      if (const auto *typeParam{
+              evaluate::UnwrapExpr<evaluate::TypeParamInquiry>(expr)}) {
+        if (!typeParam->base()) {
+          const Symbol &symbol{typeParam->parameter()};
+          if (const auto *tpd{symbol.detailsIf<TypeParamDetails>()}) {
+            if (tpd->attr() == common::TypeParamAttr::Len) {
+              return PackageIntValue(lenParameterEnum_,
+                  FindLenParameterIndex(*parameters, symbol));
+            }
+          }
+        }
+      }
+    }
+    if (expr) {
+      context_.Say(location_,
+          "Specification expression '%s' is neither constant nor a length type parameter"_err_en_US,
+          expr->AsFortran());
+    }
+    return PackageIntValue(deferredEnum_);
+  }
+
+  SemanticsContext &context_;
+  RuntimeDerivedTypeTables &tables_;
+  std::map<const Symbol *, SymbolVector> orderedTypeParameters_;
+  int anonymousTypes_{0};
+
+  const DeclTypeSpec &derivedTypeSchema_; // TYPE(DerivedType)
+  const DeclTypeSpec &componentSchema_; // TYPE(Component)
+  const DeclTypeSpec &procPtrSchema_; // TYPE(ProcPtrComponent)
+  const DeclTypeSpec &valueSchema_; // TYPE(Value)
+  const DeclTypeSpec &bindingSchema_; // TYPE(Binding)
+  const DeclTypeSpec &specialSchema_; // TYPE(SpecialBinding)
+  SomeExpr deferredEnum_; // Value::Genre::Deferred
+  SomeExpr explicitEnum_; // Value::Genre::Explicit
+  SomeExpr lenParameterEnum_; // Value::Genre::LenParameter
+  SomeExpr assignmentEnum_; // SpecialBinding::Which::Assignment
+  SomeExpr
+      elementalAssignmentEnum_; // SpecialBinding::Which::ElementalAssignment
+  SomeExpr finalEnum_; // SpecialBinding::Which::Final
+  SomeExpr elementalFinalEnum_; // SpecialBinding::Which::ElementalFinal
+  SomeExpr assumedRankFinalEnum_; // SpecialBinding::Which::AssumedRankFinal
+  SomeExpr readFormattedEnum_; // SpecialBinding::Which::ReadFormatted
+  SomeExpr readUnformattedEnum_; // SpecialBinding::Which::ReadUnformatted
+  SomeExpr writeFormattedEnum_; // SpecialBinding::Which::WriteFormatted
+  SomeExpr writeUnformattedEnum_; // SpecialBinding::Which::WriteUnformatted
+  parser::CharBlock location_;
+};
+
+RuntimeTableBuilder::RuntimeTableBuilder(
+    SemanticsContext &c, RuntimeDerivedTypeTables &t)
+    : context_{c}, tables_{t}, derivedTypeSchema_{GetSchema("derivedtype")},
+      componentSchema_{GetSchema("component")}, procPtrSchema_{GetSchema(
+                                                    "procptrcomponent")},
+      valueSchema_{GetSchema("value")}, bindingSchema_{GetSchema("binding")},
+      specialSchema_{GetSchema("specialbinding")}, deferredEnum_{GetEnumValue(
+                                                       "deferred")},
+      explicitEnum_{GetEnumValue("explicit")}, lenParameterEnum_{GetEnumValue(
+                                                   "lenparameter")},
+      assignmentEnum_{GetEnumValue("assignment")},
+      elementalAssignmentEnum_{GetEnumValue("elementalassignment")},
+      finalEnum_{GetEnumValue("final")}, elementalFinalEnum_{GetEnumValue(
+                                             "elementalfinal")},
+      assumedRankFinalEnum_{GetEnumValue("assumedrankfinal")},
+      readFormattedEnum_{GetEnumValue("readformatted")},
+      readUnformattedEnum_{GetEnumValue("readunformatted")},
+      writeFormattedEnum_{GetEnumValue("writeformatted")},
+      writeUnformattedEnum_{GetEnumValue("writeunformatted")} {}
+
+void RuntimeTableBuilder::DescribeTypes(Scope &scope) {
+  if (&scope == tables_.schemata) {
+    return; // don't loop trying to describe a schema...
+  }
+  if (scope.IsDerivedType()) {
+    DescribeType(scope);
+  } else {
+    for (Scope &child : scope.children()) {
+      DescribeTypes(child);
+    }
+  }
+}
+
+// Returns derived type instantiation's parameters in declaration order
+const SymbolVector *RuntimeTableBuilder::GetTypeParameters(
+    const Symbol &symbol) {
+  auto iter{orderedTypeParameters_.find(&symbol)};
+  if (iter != orderedTypeParameters_.end()) {
+    return &iter->second;
+  } else {
+    return &orderedTypeParameters_
+                .emplace(&symbol, OrderParameterDeclarations(symbol))
+                .first->second;
+  }
+}
+
+static Scope &GetContainingNonDerivedScope(Scope &scope) {
+  Scope *p{&scope};
+  while (p->IsDerivedType()) {
+    p = &p->parent();
+  }
+  return *p;
+}
+
+static const Symbol &GetSchemaField(
+    const DerivedTypeSpec &derived, const std::string &name) {
+  const Scope &scope{
+      DEREF(derived.scope() ? derived.scope() : derived.typeSymbol().scope())};
+  auto iter{scope.find(SourceName(name))};
+  CHECK(iter != scope.end());
+  return *iter->second;
+}
+
+static const Symbol &GetSchemaField(
+    const DeclTypeSpec &derived, const std::string &name) {
+  return GetSchemaField(DEREF(derived.AsDerived()), name);
+}
+
+static evaluate::StructureConstructorValues &AddValue(
+    evaluate::StructureConstructorValues &values, const DeclTypeSpec &spec,
+    const std::string &name, SomeExpr &&x) {
+  values.emplace(GetSchemaField(spec, name), std::move(x));
+  return values;
+}
+
+static evaluate::StructureConstructorValues &AddValue(
+    evaluate::StructureConstructorValues &values, const DeclTypeSpec &spec,
+    const std::string &name, const SomeExpr &x) {
+  values.emplace(GetSchemaField(spec, name), x);
+  return values;
+}
+
+static SomeExpr IntToExpr(std::int64_t n) {
+  return evaluate::AsGenericExpr(evaluate::ExtentExpr{n});
+}
+
+static evaluate::StructureConstructor Structure(
+    const DeclTypeSpec &spec, evaluate::StructureConstructorValues &&values) {
+  return {DEREF(spec.AsDerived()), std::move(values)};
+}
+
+static SomeExpr StructureExpr(evaluate::StructureConstructor &&x) {
+  return SomeExpr{evaluate::Expr<evaluate::SomeDerived>{std::move(x)}};
+}
+
+static int GetIntegerKind(const Symbol &symbol) {
+  auto dyType{evaluate::DynamicType::From(symbol)};
+  CHECK(dyType && dyType->category() == TypeCategory::Integer);
+  return dyType->kind();
+}
+
+// Save a rank-1 array constant of some numeric type as an
+// initialized data object in a scope.
+template <typename T>
+static SomeExpr SaveNumericPointerTarget(
+    Scope &scope, SourceName name, std::vector<typename T::Scalar> &&x) {
+  if (x.empty()) {
+    return SomeExpr{evaluate::NullPointer{}};
+  } else {
+    ObjectEntityDetails object;
+    if (const auto *spec{scope.FindType(
+            DeclTypeSpec{NumericTypeSpec{T::category, KindExpr{T::kind}}})}) {
+      object.set_type(*spec);
+    } else {
+      object.set_type(scope.MakeNumericType(T::category, KindExpr{T::kind}));
+    }
+    auto elements{static_cast<evaluate::ConstantSubscript>(x.size())};
+    ArraySpec arraySpec;
+    arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{elements - 1}));
+    object.set_shape(arraySpec);
+    object.set_init(evaluate::AsGenericExpr(evaluate::Constant<T>{
+        std::move(x), evaluate::ConstantSubscripts{elements}}));
+    const Symbol &symbol{
+        *scope
+             .try_emplace(
+                 name, Attrs{Attr::TARGET, Attr::SAVE}, std::move(object))
+             .first->second};
+    return evaluate::AsGenericExpr(
+        evaluate::Expr<T>{evaluate::Designator<T>{symbol}});
+  }
+}
+
+// Save an arbitrarily shaped array constant of some derived type
+// as an initialized data object in a scope.
+static SomeExpr SaveDerivedPointerTarget(Scope &scope, SourceName name,
+    std::vector<evaluate::StructureConstructor> &&x,
+    evaluate::ConstantSubscripts &&shape) {
+  if (x.empty()) {
+    return SomeExpr{evaluate::NullPointer{}};
+  } else {
+    const auto &derivedType{x.front().GetType().GetDerivedTypeSpec()};
+    ObjectEntityDetails object;
+    DeclTypeSpec typeSpec{DeclTypeSpec::TypeDerived, derivedType};
+    if (const DeclTypeSpec * spec{scope.FindType(typeSpec)}) {
+      object.set_type(*spec);
+    } else {
+      object.set_type(scope.MakeDerivedType(
+          DeclTypeSpec::TypeDerived, common::Clone(derivedType)));
+    }
+    if (!shape.empty()) {
+      ArraySpec arraySpec;
+      for (auto n : shape) {
+        arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{n - 1}));
+      }
+      object.set_shape(arraySpec);
+    }
+    object.set_init(
+        evaluate::AsGenericExpr(evaluate::Constant<evaluate::SomeDerived>{
+            derivedType, std::move(x), std::move(shape)}));
+    const Symbol &symbol{
+        *scope
+             .try_emplace(
+                 name, Attrs{Attr::TARGET, Attr::SAVE}, std::move(object))
+             .first->second};
+    return evaluate::AsGenericExpr(
+        evaluate::Designator<evaluate::SomeDerived>{symbol});
+  }
+}
+
+static SomeExpr SaveObjectInit(
+    Scope &scope, SourceName name, const ObjectEntityDetails &object) {
+  const Symbol &symbol{*scope
+                            .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
+                                ObjectEntityDetails{object})
+                            .first->second};
+  CHECK(symbol.get<ObjectEntityDetails>().init().has_value());
+  return evaluate::AsGenericExpr(
+      evaluate::Designator<evaluate::SomeDerived>{symbol});
+}
+
+const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
+  if (const Symbol * info{dtScope.runtimeDerivedTypeDescription()}) {
+    return info;
+  }
+  const DerivedTypeSpec *derivedTypeSpec{dtScope.derivedTypeSpec()};
+  const Symbol *dtSymbol{
+      derivedTypeSpec ? &derivedTypeSpec->typeSymbol() : dtScope.symbol()};
+  if (!dtSymbol) {
+    return nullptr;
+  }
+  auto locationRestorer{common::ScopedSet(location_, dtSymbol->name())};
+  // Check for an existing description that can be imported from a USE'd module
+  std::string typeName{dtSymbol->name().ToString()};
+  if (typeName.empty() || typeName[0] == '.') {
+    return nullptr;
+  }
+  std::string distinctName{typeName};
+  if (&dtScope != dtSymbol->scope()) {
+    distinctName += "."s + std::to_string(anonymousTypes_++);
+  }
+  std::string dtDescName{".dt."s + distinctName};
+  Scope &scope{GetContainingNonDerivedScope(dtScope)};
+  if (distinctName == typeName && scope.IsModule()) {
+    if (const Symbol * description{scope.FindSymbol(SourceName{dtDescName})}) {
+      dtScope.set_runtimeDerivedTypeDescription(*description);
+      return description;
+    }
+  }
+  // Create a new description object before populating it so that mutual
+  // references will work as pointer targets.
+  Symbol &dtObject{CreateObject(dtDescName, derivedTypeSchema_, scope)};
+  dtScope.set_runtimeDerivedTypeDescription(dtObject);
+  evaluate::StructureConstructorValues dtValues;
+  AddValue(dtValues, derivedTypeSchema_, "name"s,
+      SaveNameAsPointerTarget(scope, typeName));
+  bool isPDTdefinition{
+      !derivedTypeSpec && dtScope.IsParameterizedDerivedType()};
+  if (!isPDTdefinition) {
+    auto sizeInBytes{static_cast<common::ConstantSubscript>(dtScope.size())};
+    if (auto alignment{dtScope.alignment().value_or(0)}) {
+      sizeInBytes += alignment - 1;
+      sizeInBytes /= alignment;
+      sizeInBytes *= alignment;
+    }
+    AddValue(
+        dtValues, derivedTypeSchema_, "sizeinbytes"s, IntToExpr(sizeInBytes));
+  }
+  const Symbol *parentDescObject{nullptr};
+  if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) {
+    parentDescObject = DescribeType(*const_cast<Scope *>(parentScope));
+  }
+  if (parentDescObject) {
+    AddValue(dtValues, derivedTypeSchema_, "parent"s,
+        evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
+            evaluate::Designator<evaluate::SomeDerived>{*parentDescObject}}));
+  } else {
+    AddValue(dtValues, derivedTypeSchema_, "parent"s,
+        SomeExpr{evaluate::NullPointer{}});
+  }
+  bool isPDTinstantiation{derivedTypeSpec && &dtScope != dtSymbol->scope()};
+  if (isPDTinstantiation) {
+    // is PDT instantiation
+    const Symbol *uninstDescObject{
+        DescribeType(DEREF(const_cast<Scope *>(dtSymbol->scope())))};
+    AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
+        evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
+            evaluate::Designator<evaluate::SomeDerived>{
+                DEREF(uninstDescObject)}}));
+  } else {
+    AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
+        SomeExpr{evaluate::NullPointer{}});
+  }
+
+  // TODO: compute typeHash
+
+  using Int8 = evaluate::Type<TypeCategory::Integer, 8>;
+  using Int1 = evaluate::Type<TypeCategory::Integer, 1>;
+  std::vector<Int8::Scalar> kinds;
+  std::vector<Int1::Scalar> lenKinds;
+  const SymbolVector *parameters{GetTypeParameters(*dtSymbol)};
+  if (parameters) {
+    // Package the derived type's parameters in declaration order for
+    // each category of parameter.  KIND= type parameters are described
+    // by their instantiated (or default) values, while LEN= type
+    // parameters are described by their INTEGER kinds.
+    for (SymbolRef ref : *parameters) {
+      const auto &tpd{ref->get<TypeParamDetails>()};
+      if (tpd.attr() == common::TypeParamAttr::Kind) {
+        auto value{evaluate::ToInt64(tpd.init()).value_or(0)};
+        if (derivedTypeSpec) {
+          if (const auto *pv{derivedTypeSpec->FindParameter(ref->name())}) {
+            if (pv->GetExplicit()) {
+              if (auto instantiatedValue{
+                      evaluate::ToInt64(*pv->GetExplicit())}) {
+                value = *instantiatedValue;
+              }
+            }
+          }
+        }
+        kinds.emplace_back(value);
+      } else { // LEN= parameter
+        lenKinds.emplace_back(GetIntegerKind(*ref));
+      }
+    }
+  }
+  AddValue(dtValues, derivedTypeSchema_, "kindparameter"s,
+      SaveNumericPointerTarget<Int8>(
+          scope, SaveObjectName(".kp."s + distinctName), std::move(kinds)));
+  AddValue(dtValues, derivedTypeSchema_, "lenparameterkind"s,
+      SaveNumericPointerTarget<Int1>(
+          scope, SaveObjectName(".lpk."s + distinctName), std::move(lenKinds)));
+  // Traverse the components of the derived type
+  if (!isPDTdefinition) {
+    std::vector<evaluate::StructureConstructor> dataComponents;
+    std::vector<evaluate::StructureConstructor> procPtrComponents;
+    std::vector<evaluate::StructureConstructor> specials;
+    for (const auto &pair : dtScope) {
+      const Symbol &symbol{*pair.second};
+      auto locationRestorer{common::ScopedSet(location_, symbol.name())};
+      std::visit(
+          common::visitors{
+              [&](const TypeParamDetails &) {
+                // already handled above in declaration order
+              },
+              [&](const ObjectEntityDetails &object) {
+                dataComponents.emplace_back(DescribeComponent(
+                    symbol, object, scope, distinctName, parameters));
+              },
+              [&](const ProcEntityDetails &proc) {
+                if (IsProcedurePointer(symbol)) {
+                  procPtrComponents.emplace_back(
+                      DescribeComponent(symbol, proc, scope));
+                }
+              },
+              [&](const ProcBindingDetails &) { // handled in a later pass
+              },
+              [&](const GenericDetails &generic) {
+                DescribeGeneric(generic, specials);
+              },
+              [&](const auto &) {
+                common::die(
+                    "unexpected details on symbol '%s' in derived type scope",
+                    symbol.name().ToString().c_str());
+              },
+          },
+          symbol.details());
+    }
+    AddValue(dtValues, derivedTypeSchema_, "component"s,
+        SaveDerivedPointerTarget(scope, SaveObjectName(".c."s + distinctName),
+            std::move(dataComponents),
+            evaluate::ConstantSubscripts{
+                static_cast<evaluate::ConstantSubscript>(
+                    dataComponents.size())}));
+    AddValue(dtValues, derivedTypeSchema_, "procptr"s,
+        SaveDerivedPointerTarget(scope, SaveObjectName(".p."s + distinctName),
+            std::move(procPtrComponents),
+            evaluate::ConstantSubscripts{
+                static_cast<evaluate::ConstantSubscript>(
+                    procPtrComponents.size())}));
+    // Compile the "vtable" of type-bound procedure bindings
+    std::vector<evaluate::StructureConstructor> bindings{
+        DescribeBindings(dtScope, scope)};
+    AddValue(dtValues, derivedTypeSchema_, "binding"s,
+        SaveDerivedPointerTarget(scope, SaveObjectName(".v."s + distinctName),
+            std::move(bindings),
+            evaluate::ConstantSubscripts{
+                static_cast<evaluate::ConstantSubscript>(bindings.size())}));
+    // Describe "special" bindings to defined assignments, FINAL subroutines,
+    // and user-defined derived type I/O subroutines.
+    if (dtScope.symbol()) {
+      for (const auto &pair :
+          dtScope.symbol()->get<DerivedTypeDetails>().finals()) {
+        DescribeSpecialProc(specials, *pair.second, false /*!isAssignment*/,
+            true, std::nullopt);
+      }
+    }
+    IncorporateDefinedIoGenericInterfaces(specials,
+        SourceName{"read(formatted)", 15},
+        GenericKind::DefinedIo::ReadFormatted, &scope);
+    IncorporateDefinedIoGenericInterfaces(specials,
+        SourceName{"read(unformatted)", 17},
+        GenericKind::DefinedIo::ReadUnformatted, &scope);
+    IncorporateDefinedIoGenericInterfaces(specials,
+        SourceName{"write(formatted)", 16},
+        GenericKind::DefinedIo::WriteFormatted, &scope);
+    IncorporateDefinedIoGenericInterfaces(specials,
+        SourceName{"write(unformatted)", 18},
+        GenericKind::DefinedIo::WriteUnformatted, &scope);
+    AddValue(dtValues, derivedTypeSchema_, "special"s,
+        SaveDerivedPointerTarget(scope, SaveObjectName(".s."s + distinctName),
+            std::move(specials),
+            evaluate::ConstantSubscripts{
+                static_cast<evaluate::ConstantSubscript>(specials.size())}));
+  }
+  dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{
+      StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))});
+  return &dtObject;
+}
+
+static const Symbol &GetSymbol(const Scope &schemata, SourceName name) {
+  auto iter{schemata.find(name)};
+  CHECK(iter != schemata.end());
+  const Symbol &symbol{*iter->second};
+  return symbol;
+}
+
+const Symbol &RuntimeTableBuilder::GetSchemaSymbol(const char *name) const {
+  return GetSymbol(
+      DEREF(tables_.schemata), SourceName{name, std::strlen(name)});
+}
+
+const DeclTypeSpec &RuntimeTableBuilder::GetSchema(
+    const char *schemaName) const {
+  Scope &schemata{DEREF(tables_.schemata)};
+  SourceName name{schemaName, std::strlen(schemaName)};
+  const Symbol &symbol{GetSymbol(schemata, name)};
+  CHECK(symbol.has<DerivedTypeDetails>());
+  CHECK(symbol.scope());
+  CHECK(symbol.scope()->IsDerivedType());
+  const DeclTypeSpec *spec{nullptr};
+  if (symbol.scope()->derivedTypeSpec()) {
+    DeclTypeSpec typeSpec{
+        DeclTypeSpec::TypeDerived, *symbol.scope()->derivedTypeSpec()};
+    spec = schemata.FindType(typeSpec);
+  }
+  if (!spec) {
+    DeclTypeSpec typeSpec{
+        DeclTypeSpec::TypeDerived, DerivedTypeSpec{name, symbol}};
+    spec = schemata.FindType(typeSpec);
+  }
+  if (!spec) {
+    spec = &schemata.MakeDerivedType(
+        DeclTypeSpec::TypeDerived, DerivedTypeSpec{name, symbol});
+  }
+  CHECK(spec->AsDerived());
+  return *spec;
+}
+
+template <int KIND> static SomeExpr IntExpr(std::int64_t n) {
+  return evaluate::AsGenericExpr(
+      evaluate::Constant<evaluate::Type<TypeCategory::Integer, KIND>>{n});
+}
+
+SomeExpr RuntimeTableBuilder::GetEnumValue(const char *name) const {
+  const Symbol &symbol{GetSchemaSymbol(name)};
+  auto value{evaluate::ToInt64(symbol.get<ObjectEntityDetails>().init())};
+  CHECK(value.has_value());
+  return IntExpr<1>(*value);
+}
+
+Symbol &RuntimeTableBuilder::CreateObject(
+    const std::string &name, const DeclTypeSpec &type, Scope &scope) {
+  ObjectEntityDetails object;
+  object.set_type(type);
+  auto pair{scope.try_emplace(SaveObjectName(name),
+      Attrs{Attr::TARGET, Attr::SAVE}, std::move(object))};
+  CHECK(pair.second);
+  Symbol &result{*pair.first->second};
+  return result;
+}
+
+SourceName RuntimeTableBuilder::SaveObjectName(const std::string &name) {
+  return *tables_.names.insert(name).first;
+}
+
+SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget(
+    Scope &scope, const std::string &name) {
+  CHECK(!name.empty());
+  CHECK(name.front() != '.');
+  ObjectEntityDetails object;
+  auto len{static_cast<common::ConstantSubscript>(name.size())};
+  if (const auto *spec{scope.FindType(DeclTypeSpec{CharacterTypeSpec{
+          ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}}})}) {
+    object.set_type(*spec);
+  } else {
+    object.set_type(scope.MakeCharacterType(
+        ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}));
+  }
+  using Ascii = evaluate::Type<TypeCategory::Character, 1>;
+  using AsciiExpr = evaluate::Expr<Ascii>;
+  object.set_init(evaluate::AsGenericExpr(AsciiExpr{name}));
+  const Symbol &symbol{
+      *scope
+           .try_emplace(SaveObjectName(".n."s + name),
+               Attrs{Attr::TARGET, Attr::SAVE}, std::move(object))
+           .first->second};
+  return evaluate::AsGenericExpr(
+      AsciiExpr{evaluate::Designator<Ascii>{symbol}});
+}
+
+evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
+    const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope,
+    const std::string &distinctName, const SymbolVector *parameters) {
+  evaluate::StructureConstructorValues values;
+  auto typeAndShape{evaluate::characteristics::TypeAndShape::Characterize(
+      object, context_.foldingContext())};
+  CHECK(typeAndShape.has_value());
+  auto dyType{typeAndShape->type()};
+  const auto &shape{typeAndShape->shape()};
+  AddValue(values, componentSchema_, "name"s,
+      SaveNameAsPointerTarget(scope, symbol.name().ToString()));
+  AddValue(values, componentSchema_, "category"s,
+      IntExpr<1>(static_cast<int>(dyType.category())));
+  if (dyType.IsUnlimitedPolymorphic() ||
+      dyType.category() == TypeCategory::Derived) {
+    AddValue(values, componentSchema_, "kind"s, IntExpr<1>(0));
+  } else {
+    AddValue(values, componentSchema_, "kind"s, IntExpr<1>(dyType.kind()));
+  }
+  AddValue(values, componentSchema_, "offset"s, IntExpr<8>(symbol.offset()));
+  // CHARACTER length
+  const auto &len{typeAndShape->LEN()};
+  if (dyType.category() == TypeCategory::Character && len) {
+    AddValue(values, componentSchema_, "characterlen"s,
+        evaluate::AsGenericExpr(GetValue(len, parameters)));
+  } else {
+    AddValue(values, componentSchema_, "characterlen"s,
+        PackageIntValueExpr(deferredEnum_));
+  }
+  // Describe component's derived type
+  std::vector<evaluate::StructureConstructor> lenParams;
+  if (dyType.category() == TypeCategory::Derived &&
+      !dyType.IsUnlimitedPolymorphic()) {
+    const DerivedTypeSpec &spec{dyType.GetDerivedTypeSpec()};
+    Scope *derivedScope{const_cast<Scope *>(
+        spec.scope() ? spec.scope() : spec.typeSymbol().scope())};
+    const Symbol *derivedDescription{DescribeType(DEREF(derivedScope))};
+    AddValue(values, componentSchema_, "derived"s,
+        evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
+            evaluate::Designator<evaluate::SomeDerived>{
+                DEREF(derivedDescription)}}));
+    // Package values of LEN parameters, if any
+    if (const SymbolVector * specParams{GetTypeParameters(spec.typeSymbol())}) {
+      for (SymbolRef ref : *specParams) {
+        const auto &tpd{ref->get<TypeParamDetails>()};
+        if (tpd.attr() == common::TypeParamAttr::Len) {
+          if (const ParamValue * paramValue{spec.FindParameter(ref->name())}) {
+            lenParams.emplace_back(GetValue(*paramValue, parameters));
+          } else {
+            lenParams.emplace_back(GetValue(tpd.init(), parameters));
+          }
+        }
+      }
+    }
+  } else {
+    // Subtle: a category of Derived with a null derived type pointer
+    // signifies CLASS(*)
+    AddValue(values, componentSchema_, "derived"s,
+        SomeExpr{evaluate::NullPointer{}});
+  }
+  // LEN type parameter values for the component's type
+  if (!lenParams.empty()) {
+    AddValue(values, componentSchema_, "lenvalue"s,
+        SaveDerivedPointerTarget(scope,
+            SaveObjectName(
+                ".lv."s + distinctName + "."s + symbol.name().ToString()),
+            std::move(lenParams),
+            evaluate::ConstantSubscripts{
+                static_cast<evaluate::ConstantSubscript>(lenParams.size())}));
+  } else {
+    AddValue(values, componentSchema_, "lenvalue"s,
+        SomeExpr{evaluate::NullPointer{}});
+  }
+  // Shape information
+  int rank{evaluate::GetRank(shape)};
+  AddValue(values, componentSchema_, "rank"s, IntExpr<1>(rank));
+  if (rank > 0) {
+    std::vector<evaluate::StructureConstructor> bounds;
+    evaluate::NamedEntity entity{symbol};
+    auto &foldingContext{context_.foldingContext()};
+    for (int j{0}; j < rank; ++j) {
+      bounds.emplace_back(GetValue(std::make_optional(evaluate::GetLowerBound(
+                                       foldingContext, entity, j)),
+          parameters));
+      bounds.emplace_back(GetValue(
+          evaluate::GetUpperBound(foldingContext, entity, j), parameters));
+    }
+    AddValue(values, componentSchema_, "bounds"s,
+        SaveDerivedPointerTarget(scope,
+            SaveObjectName(
+                ".b."s + distinctName + "."s + symbol.name().ToString()),
+            std::move(bounds), evaluate::ConstantSubscripts{2, rank}));
+  } else {
+    AddValue(
+        values, componentSchema_, "bounds"s, SomeExpr{evaluate::NullPointer{}});
+  }
+  // Default component initialization
+  bool hasDataInit{false};
+  if (IsAllocatable(symbol)) {
+    AddValue(values, componentSchema_, "genre"s, GetEnumValue("allocatable"));
+  } else if (IsPointer(symbol)) {
+    AddValue(values, componentSchema_, "genre"s, GetEnumValue("pointer"));
+    hasDataInit = object.init().has_value();
+    if (hasDataInit) {
+      AddValue(values, componentSchema_, "initialization"s,
+          SomeExpr{*object.init()});
+    }
+  } else if (IsAutomaticObject(symbol)) {
+    AddValue(values, componentSchema_, "genre"s, GetEnumValue("automatic"));
+  } else {
+    AddValue(values, componentSchema_, "genre"s, GetEnumValue("data"));
+    hasDataInit = object.init().has_value();
+    if (hasDataInit) {
+      AddValue(values, componentSchema_, "initialization"s,
+          SaveObjectInit(scope,
+              SaveObjectName(
+                  ".di."s + distinctName + "."s + symbol.name().ToString()),
+              object));
+    }
+  }
+  if (!hasDataInit) {
+    AddValue(values, componentSchema_, "initialization"s,
+        SomeExpr{evaluate::NullPointer{}});
+  }
+  return {DEREF(componentSchema_.AsDerived()), std::move(values)};
+}
+
+evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
+    const Symbol &symbol, const ProcEntityDetails &proc, Scope &scope) {
+  evaluate::StructureConstructorValues values;
+  AddValue(values, procPtrSchema_, "name"s,
+      SaveNameAsPointerTarget(scope, symbol.name().ToString()));
+  AddValue(values, procPtrSchema_, "offset"s, IntExpr<8>(symbol.offset()));
+  if (auto init{proc.init()}; init && *init) {
+    AddValue(values, procPtrSchema_, "initialization"s,
+        SomeExpr{evaluate::ProcedureDesignator{**init}});
+  } else {
+    AddValue(values, procPtrSchema_, "initialization"s,
+        SomeExpr{evaluate::NullPointer{}});
+  }
+  return {DEREF(procPtrSchema_.AsDerived()), std::move(values)};
+}
+
+evaluate::StructureConstructor RuntimeTableBuilder::PackageIntValue(
+    const SomeExpr &genre, std::int64_t n) const {
+  evaluate::StructureConstructorValues xs;
+  AddValue(xs, valueSchema_, "genre"s, genre);
+  AddValue(xs, valueSchema_, "value"s, IntToExpr(n));
+  return Structure(valueSchema_, std::move(xs));
+}
+
+SomeExpr RuntimeTableBuilder::PackageIntValueExpr(
+    const SomeExpr &genre, std::int64_t n) const {
+  return StructureExpr(PackageIntValue(genre, n));
+}
+
+std::vector<const Symbol *> RuntimeTableBuilder::CollectBindings(
+    const Scope &dtScope) const {
+  std::vector<const Symbol *> result;
+  std::map<SourceName, const Symbol *> localBindings;
+  // Collect local bindings
+  for (auto pair : dtScope) {
+    const Symbol &symbol{*pair.second};
+    if (symbol.has<ProcBindingDetails>()) {
+      localBindings.emplace(symbol.name(), &symbol);
+    }
+  }
+  if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) {
+    result = CollectBindings(*parentScope);
+    // Apply overrides from the local bindings of the extended type
+    for (auto iter{result.begin()}; iter != result.end(); ++iter) {
+      const Symbol &symbol{**iter};
+      auto overridden{localBindings.find(symbol.name())};
+      if (overridden != localBindings.end()) {
+        *iter = overridden->second;
+        localBindings.erase(overridden);
+      }
+    }
+  }
+  // Add remaining (non-overriding) local bindings in name order to the result
+  for (auto pair : localBindings) {
+    result.push_back(pair.second);
+  }
+  return result;
+}
+
+std::vector<evaluate::StructureConstructor>
+RuntimeTableBuilder::DescribeBindings(const Scope &dtScope, Scope &scope) {
+  std::vector<evaluate::StructureConstructor> result;
+  for (const Symbol *symbol : CollectBindings(dtScope)) {
+    evaluate::StructureConstructorValues values;
+    AddValue(values, bindingSchema_, "proc"s,
+        SomeExpr{evaluate::ProcedureDesignator{
+            symbol->get<ProcBindingDetails>().symbol()}});
+    AddValue(values, bindingSchema_, "name"s,
+        SaveNameAsPointerTarget(scope, symbol->name().ToString()));
+    result.emplace_back(DEREF(bindingSchema_.AsDerived()), std::move(values));
+  }
+  return result;
+}
+
+void RuntimeTableBuilder::DescribeGeneric(const GenericDetails &generic,
+    std::vector<evaluate::StructureConstructor> &specials) {
+  std::visit(common::visitors{
+                 [&](const GenericKind::OtherKind &k) {
+                   if (k == GenericKind::OtherKind::Assignment) {
+                     for (auto ref : generic.specificProcs()) {
+                       DescribeSpecialProc(specials, *ref, true,
+                           false /*!final*/, std::nullopt);
+                     }
+                   }
+                 },
+                 [&](const GenericKind::DefinedIo &io) {
+                   switch (io) {
+                   case GenericKind::DefinedIo::ReadFormatted:
+                   case GenericKind::DefinedIo::ReadUnformatted:
+                   case GenericKind::DefinedIo::WriteFormatted:
+                   case GenericKind::DefinedIo::WriteUnformatted:
+                     for (auto ref : generic.specificProcs()) {
+                       DescribeSpecialProc(
+                           specials, *ref, false, false /*!final*/, io);
+                     }
+                     break;
+                   }
+                 },
+                 [](const auto &) {},
+             },
+      generic.kind().u);
+}
+
+void RuntimeTableBuilder::DescribeSpecialProc(
+    std::vector<evaluate::StructureConstructor> &specials,
+    const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
+    std::optional<GenericKind::DefinedIo> io) {
+  const auto *binding{specificOrBinding.detailsIf<ProcBindingDetails>()};
+  const Symbol &specific{*(binding ? &binding->symbol() : &specificOrBinding)};
+  if (auto proc{evaluate::characteristics::Procedure::Characterize(
+          specific, context_.foldingContext())}) {
+    std::uint8_t rank{0};
+    std::uint8_t isArgDescriptorSet{0};
+    int argThatMightBeDescriptor{0};
+    MaybeExpr which;
+    if (isAssignment) { // only type-bound asst's are germane to runtime
+      CHECK(binding != nullptr);
+      CHECK(proc->dummyArguments.size() == 2);
+      which = proc->IsElemental() ? elementalAssignmentEnum_ : assignmentEnum_;
+      if (binding && binding->passName() &&
+          *binding->passName() == proc->dummyArguments[1].name) {
+        argThatMightBeDescriptor = 1;
+        isArgDescriptorSet |= 2;
+      } else {
+        argThatMightBeDescriptor = 2; // the non-passed-object argument
+        isArgDescriptorSet |= 1;
+      }
+    } else if (isFinal) {
+      CHECK(binding == nullptr); // FINALs are not bindings
+      CHECK(proc->dummyArguments.size() == 1);
+      if (proc->IsElemental()) {
+        which = elementalFinalEnum_;
+      } else {
+        const auto &typeAndShape{
+            std::get<evaluate::characteristics::DummyDataObject>(
+                proc->dummyArguments.at(0).u)
+                .type};
+        if (typeAndShape.attrs().test(
+                evaluate::characteristics::TypeAndShape::Attr::AssumedRank)) {
+          which = assumedRankFinalEnum_;
+          isArgDescriptorSet |= 1;
+        } else {
+          which = finalEnum_;
+          rank = evaluate::GetRank(typeAndShape.shape());
+          if (rank > 0) {
+            argThatMightBeDescriptor = 1;
+          }
+        }
+      }
+    } else { // user defined derived type I/O
+      CHECK(proc->dummyArguments.size() >= 4);
+      bool isArg0Descriptor{
+          !proc->dummyArguments.at(0).CanBePassedViaImplicitInterface()};
+      // N.B. When the user defined I/O subroutine is a type bound procedure,
+      // its first argument is always a descriptor, otherwise, when it was an
+      // interface, it never is.
+      CHECK(!!binding == isArg0Descriptor);
+      if (binding) {
+        isArgDescriptorSet |= 1;
+      }
+      switch (io.value()) {
+      case GenericKind::DefinedIo::ReadFormatted:
+        which = readFormattedEnum_;
+        break;
+      case GenericKind::DefinedIo::ReadUnformatted:
+        which = readUnformattedEnum_;
+        break;
+      case GenericKind::DefinedIo::WriteFormatted:
+        which = writeFormattedEnum_;
+        break;
+      case GenericKind::DefinedIo::WriteUnformatted:
+        which = writeUnformattedEnum_;
+        break;
+      }
+    }
+    if (argThatMightBeDescriptor != 0 &&
+        !proc->dummyArguments.at(argThatMightBeDescriptor - 1)
+             .CanBePassedViaImplicitInterface()) {
+      isArgDescriptorSet |= 1 << (argThatMightBeDescriptor - 1);
+    }
+    evaluate::StructureConstructorValues values;
+    AddValue(
+        values, specialSchema_, "which"s, SomeExpr{std::move(which.value())});
+    AddValue(values, specialSchema_, "rank"s, IntExpr<1>(rank));
+    AddValue(values, specialSchema_, "isargdescriptorset"s,
+        IntExpr<1>(isArgDescriptorSet));
+    AddValue(values, specialSchema_, "proc"s,
+        SomeExpr{evaluate::ProcedureDesignator{specific}});
+    specials.emplace_back(DEREF(specialSchema_.AsDerived()), std::move(values));
+  }
+}
+
+void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces(
+    std::vector<evaluate::StructureConstructor> &specials, SourceName name,
+    GenericKind::DefinedIo definedIo, const Scope *scope) {
+  for (; !scope->IsGlobal(); scope = &scope->parent()) {
+    if (auto asst{scope->find(name)}; asst != scope->end()) {
+      const Symbol &generic{*asst->second};
+      const auto &genericDetails{generic.get<GenericDetails>()};
+      CHECK(std::holds_alternative<GenericKind::DefinedIo>(
+          genericDetails.kind().u));
+      CHECK(std::get<GenericKind::DefinedIo>(genericDetails.kind().u) ==
+          definedIo);
+      for (auto ref : genericDetails.specificProcs()) {
+        DescribeSpecialProc(specials, *ref, false, false, definedIo);
+      }
+    }
+  }
+}
+
+RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(
+    SemanticsContext &context) {
+  ModFileReader reader{context};
+  RuntimeDerivedTypeTables result;
+  static const char schemataName[]{"__fortran_type_info"};
+  SourceName schemataModule{schemataName, std::strlen(schemataName)};
+  result.schemata = reader.Read(schemataModule);
+  if (result.schemata) {
+    RuntimeTableBuilder builder{context, result};
+    builder.DescribeTypes(context.globalScope());
+  }
+  return result;
+}
+} // namespace Fortran::semantics

flang/lib/Semantics/semantics.cpp

 }
 
 void DoDumpSymbols(llvm::raw_ostream &os, const Scope &scope, int indent) {
   PutIndent(os, indent);
   os << Scope::EnumToString(scope.kind()) << " scope:";
   if (const auto *symbol{scope.symbol()}) {
     os << ' ' << symbol->name();
   }
-  if (scope.size()) {
-    os << " size=" << scope.size() << " alignment=" << scope.alignment();
+  if (scope.alignment().has_value()) {
+    os << " size=" << scope.size() << " alignment=" << *scope.alignment();
   }
   if (scope.derivedTypeSpec()) {
     os << " instantiation of " << *scope.derivedTypeSpec();
   }
   os << '\n';
   ++indent;
   for (const auto &pair : scope) {
     const auto &symbol{*pair.second};

flang/lib/Semantics/tools.cpp

 }
 
 bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name) {
   if (!derived) {
     return false;
   } else {
     const auto &symbol{derived->typeSymbol()};
     return symbol.owner().IsModule() &&
-        symbol.owner().GetName().value() == "__fortran_builtins" &&
+        (symbol.owner().GetName().value() == "__fortran_builtins" ||
+            symbol.owner().GetName().value() == "__fortran_type_info") &&
         symbol.name() == "__builtin_"s + name;
   }
 }
 
 bool IsIsoCType(const DerivedTypeSpec *derived) {
   return IsBuiltinDerivedType(derived, "c_ptr") ||
       IsBuiltinDerivedType(derived, "c_funptr");
 }
if (!object->isDummy() && !IsAllocatable(symbol) && !IsPointer(symbol)) {
         }
       }
     }
   }
   return false;
 }
 
 bool IsFinalizable(const Symbol &symbol) {
-  if (const DeclTypeSpec * type{symbol.GetType()}) {
-    if (const DerivedTypeSpec * derived{type->AsDerived()}) {
-      return IsFinalizable(*derived);
+  if (IsPointer(symbol)) {
+    return false;
+  }
+  if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+    if (object->isDummy() && !IsIntentOut(symbol)) {
+      return false;
     }
+    const DeclTypeSpec *type{object->type()};
+    const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
+    return derived && IsFinalizable(*derived);
   }
   return false;
 }
 
 bool IsFinalizable(const DerivedTypeSpec &derived) {
   if (!derived.typeSymbol().get<DerivedTypeDetails>().finals().empty()) {
     return true;
   }

flang/module/__fortran_builtins.f90

 !===-- module/__fortran_builtins.f90 ---------------------------------------===!
 !
 ! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 ! See https://llvm.org/LICENSE.txt for license information.
 ! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 !
 !===------------------------------------------------------------------------===!
 
 ! These naming shenanigans prevent names from Fortran intrinsic modules
 ! from being usable on INTRINSIC statements, and force the program
 ! to USE the standard intrinsic modules in order to access the
 ! standard names of the procedures.
 module __Fortran_builtins
 
+  use __Fortran_type_info, only: __builtin_c_ptr, __builtin_c_funptr
   integer, parameter, private :: int64 = selected_int_kind(18)
 
   intrinsic :: __builtin_c_f_pointer
 
-  type :: __builtin_c_ptr
-    integer(kind=int64) :: __address = 0
-  end type
-
-  type :: __builtin_c_funptr
-    integer(kind=int64) :: __address = 0
-  end type
-
   type :: __builtin_event_type
-    integer(kind=int64) :: __count = 0
+    integer(kind=int64) :: __count
   end type
 
   type :: __builtin_lock_type
-    integer(kind=int64) :: __count = 0
+    integer(kind=int64) :: __count
   end type
 
   type :: __builtin_team_type
-    integer(kind=int64) :: __id = 0
+    integer(kind=int64) :: __id
   end type
 end module

flang/module/__fortran_type_info.f90

+!===-- module/__fortran_type_info.f90 --------------------------------------===!
+!
+! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+! See https://llvm.org/LICENSE.txt for license information.
+! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+!
+!===------------------------------------------------------------------------===!
+
+! Fortran definitions of runtime type description schemata.
+! See flang/runtime/type-info.h for C++ perspective.
+! The Semantics phase of the compiler requires the module file of this module
+! in order to generate description tables for all other derived types.
+
+module __Fortran_type_info
+
+  private
+
+  integer, parameter :: int64 = selected_int_kind(18)
+
+  type, public :: __builtin_c_ptr
+    integer(kind=int64) :: __address
+  end type
+
+  type, public :: __builtin_c_funptr
+    integer(kind=int64) :: __address
+  end type
+
+  type :: DerivedType
+    ! "TBP" bindings appear first.  Inherited bindings, with overrides already
+    ! applied, appear in the initial entries in the same order as they
+    ! appear in the parent type's bindings, if any.  They are followed
+    ! by new local bindings in alphabetic order of theing binding names.
+    type(Binding), pointer :: binding(:)
+    character(len=:), pointer :: name
+    integer(kind=int64) :: sizeInBytes
+    type(DerivedType), pointer :: parent
+    ! Instances of parameterized derived types use the "uninstantiated"
+    ! component to point to the pristine original definition.
+    type(DerivedType), pointer :: uninstantiated
+    integer(kind=int64) :: typeHash
+    integer(kind=int64), pointer :: kindParameter(:) ! values of instance
+    integer(1), pointer :: lenParameterKind(:) ! INTEGER kinds of LEN types
+    ! Data components appear in alphabetic order.
+    ! The parent component, if any, appears explicitly.
+    type(Component), pointer :: component(:) ! data components
+    type(ProcPtrComponent), pointer :: procptr(:) ! procedure pointers
+    ! Special bindings of the ancestral types are not duplicated here.
+    type(SpecialBinding), pointer :: special(:)
+  end type
+
+  type :: Binding
+    type(__builtin_c_funptr) :: proc
+    character(len=:), pointer :: name
+  end type
+
+  ! Array bounds and type parameters of ocmponents are deferred
+  ! (for allocatables and pointers), explicit constants, or
+  ! taken from LEN type parameters for automatic components.
+  enum, bind(c) ! Value::Genre
+    enumerator :: Deferred = 1, Explicit = 2, LenParameter = 3
+  end enum
+
+  type, bind(c) :: Value
+    integer(1) :: genre ! Value::Genre
+    integer(1) :: __padding0(7)
+    integer(kind=int64) :: value
+  end type
+
+  enum, bind(c) ! Component::Genre
+    enumerator :: Data = 1, Pointer = 2, Allocatable = 3, Automatic = 4
+  end enum
+
+  enum, bind(c) ! common::TypeCategory
+    enumerator :: CategoryInteger = 0, CategoryReal = 1, &
+      CategoryComplex = 2, CategoryCharacter = 3, &
+      CategoryLogical = 4, CategoryDerived = 5
+  end enum
+
+  type :: Component ! data components, incl. object pointers
+    character(len=:), pointer :: name
+    integer(1) :: genre ! Component::Genre
+    integer(1) :: category
+    integer(1) :: kind
+    integer(1) :: rank
+    integer(1) :: __padding0(4)
+    integer(kind=int64) :: offset
+    type(Value) :: characterLen ! for category == Character
+    type(DerivedType), pointer :: derived ! for category == Derived
+    type(Value), pointer :: lenValue(:) ! (SIZE(derived%lenParameterKind))
+    type(Value), pointer :: bounds(:, :) ! (2, rank): lower, upper
+    class(*), pointer :: initialization
+  end type
+
+  type :: ProcPtrComponent ! procedure pointer components
+    character(len=:), pointer :: name
+    integer(kind=int64) :: offset
+    type(__builtin_c_funptr) :: initialization
+  end type
+
+  enum, bind(c) ! SpecialBinding::Which
+    enumerator :: Assignment = 4, ElementalAssignment = 5
+    enumerator :: Final = 8, ElementalFinal = 9, AssumedRankFinal = 10
+    enumerator :: ReadFormatted = 16, ReadUnformatted = 17
+    enumerator :: WriteFormatted = 18, WriteUnformatted = 19
+  end enum
+
+  type, bind(c) :: SpecialBinding
+    integer(1) :: which ! SpecialBinding::Which
+    integer(1) :: rank ! for which == SpecialBinding::Which::Final only
+    integer(1) :: isArgDescriptorSet
+    integer(1) :: __padding0(5)
+    type(__builtin_c_funptr) :: proc
+  end type
+
+end module

flang/module/iso_c_binding.f90

 
 module iso_c_binding
 
   use __Fortran_builtins, only: &
     c_f_pointer => __builtin_c_f_pointer, &
     c_ptr => __builtin_c_ptr, &
     c_funptr => __builtin_c_funptr
 
-  type(c_ptr), parameter :: c_null_ptr = c_ptr()
-  type(c_funptr), parameter :: c_null_funptr = c_funptr()
+  type(c_ptr), parameter :: c_null_ptr = c_ptr(0)
+  type(c_funptr), parameter :: c_null_funptr = c_funptr(0)
 
   ! Table 18.2 (in clause 18.3.1)
   ! TODO: Specialize (via macros?) for alternative targets
   integer, parameter :: &
     c_int8_t = 1, &
     c_int16_t = 2, &
     c_int32_t = 4, &
     c_int64_t = 8, &

flang/runtime/CMakeLists.txt

 include_directories(AFTER ${CMAKE_CURRENT_BINARY_DIR})
 
 add_flang_library(FortranRuntime
   ISO_Fortran_binding.cpp
   allocatable.cpp
   buffer.cpp
   character.cpp
   connection.cpp
-  derived-type.cpp
+  derived.cpp
   descriptor.cpp
   edit-input.cpp
   edit-output.cpp
   environment.cpp
   file.cpp
   format.cpp
   internal-unit.cpp
   iostat.cpp

flang/runtime/allocatable.h

 //===-- runtime/allocatable.h -----------------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 // Defines APIs for Fortran runtime library support of code generated
 // to manipulate and query allocatable variables, dummy arguments, & components.
 #ifndef FORTRAN_RUNTIME_ALLOCATABLE_H_
 #define FORTRAN_RUNTIME_ALLOCATABLE_H_
 #include "descriptor.h"
 #include "entry-names.h"
 
+namespace Fortran::runtime::typeInfo {
+class DerivedType;
+}
+
 namespace Fortran::runtime {
 extern "C" {
 
 // Initializes the descriptor for an allocatable of intrinsic or derived type.
 // The incoming descriptor is treated as (and can be) uninitialized garbage.
 // Must be called for each allocatable variable as its scope comes into being.
 // The storage for the allocatable's descriptor must have already been
 // allocated to a size sufficient for the rank, corank, and type.
 // A descriptor must be initialized before being used for any purpose,
 // but needs reinitialization in a deallocated state only when there is
 // a change of type, rank, or corank.
 void RTNAME(AllocatableInitIntrinsic)(
     Descriptor &, TypeCategory, int kind, int rank = 0, int corank = 0);
 void RTNAME(AllocatableInitCharacter)(Descriptor &, SubscriptValue length = 0,
     int kind = 1, int rank = 0, int corank = 0);
 void RTNAME(AllocatableInitDerived)(
-    Descriptor &, const DerivedType &, int rank = 0, int corank = 0);
+    Descriptor &, const typeInfo::DerivedType &, int rank = 0, int corank = 0);
 
 // Checks that an allocatable is not already allocated in statements
 // with STAT=.  Use this on a value descriptor before setting bounds or
 // type parameters.  Not necessary on a freshly initialized descriptor.
 // (If there's no STAT=, the error will be caught later anyway, but
 // this API allows the error to be caught before descriptor is modified.)
 // Return 0 on success (deallocated state), else the STAT= value.
 int RTNAME(AllocatableCheckAllocated)(Descriptor &,

flang/runtime/allocatable.cpp

 void RTNAME(AllocatableInitCharacter)(Descriptor &descriptor,
     SubscriptValue length, int kind, int rank, int corank) {
   INTERNAL_CHECK(corank == 0);
   descriptor.Establish(
       kind, length, nullptr, rank, nullptr, CFI_attribute_allocatable);
 }
 
 void RTNAME(AllocatableInitDerived)(Descriptor &descriptor,
-    const DerivedType &derivedType, int rank, int corank) {
+    const typeInfo::DerivedType &derivedType, int rank, int corank) {
   INTERNAL_CHECK(corank == 0);
   descriptor.Establish(
       derivedType, nullptr, rank, nullptr, CFI_attribute_allocatable);
 }
 
 void RTNAME(AllocatableAssign)(Descriptor &to, const Descriptor & /*from*/) {
   INTERNAL_CHECK(false); // AllocatableAssign is not yet implemented
 }

flang/runtime/derived-type.h

-//===-- runtime/derived-type.h ----------------------------------*- C++ -*-===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-
-#ifndef FORTRAN_RUNTIME_DERIVED_TYPE_H_
-#define FORTRAN_RUNTIME_DERIVED_TYPE_H_
-
-#include "type-code.h"
-#include "flang/ISO_Fortran_binding.h"
-#include <cinttypes>
-#include <cstddef>
-
-namespace Fortran::runtime {
-
-class Descriptor;
-
-// Static type information about derived type specializations,
-// suitable for residence in read-only storage.
-
-using TypeParameterValue = ISO::CFI_index_t;
-
-class TypeParameter {
-public:
-  const char *name() const { return name_; }
-  const TypeCode typeCode() const { return typeCode_; }
-
-  bool IsLenTypeParameter() const { return which_ < 0; }
-
-  // Returns the static value of a KIND type parameter, or the default
-  // value of a LEN type parameter.
-  TypeParameterValue StaticValue() const { return value_; }
-
-  // Returns the static value of a KIND type parameter, or an
-  // instantiated value of LEN type parameter.
-  TypeParameterValue GetValue(const Descriptor &) const;
-
-private:
-  const char *name_;
-  TypeCode typeCode_; // INTEGER, but not necessarily default kind
-  int which_{-1}; // index into DescriptorAddendum LEN type parameter values
-  TypeParameterValue value_; // default in the case of LEN type parameter
-};
-
-// Components that have any need for a descriptor will either reference
-// a static descriptor that applies to all instances, or will *be* a
-// descriptor.  Be advised: the base addresses in static descriptors
-// are null.  Most runtime interfaces separate the data address from that
-// of the descriptor, and ignore the encapsulated base address in the
-// descriptor.  Some interfaces, e.g. calls to interoperable procedures,
-// cannot pass a separate data address, and any static descriptor being used
-// in that kind of situation must be copied and customized.
-// Static descriptors are flagged in their attributes.
-class Component {
-public:
-  const char *name() const { return name_; }
-  TypeCode typeCode() const { return typeCode_; }
-  const Descriptor *staticDescriptor() const { return staticDescriptor_; }
-
-  bool IsParent() const { return (flags_ & PARENT) != 0; }
-  bool IsPrivate() const { return (flags_ & PRIVATE) != 0; }
-  bool IsDescriptor() const { return (flags_ & IS_DESCRIPTOR) != 0; }
-
-  template <typename A> A *Locate(char *dtInstance) const {
-    return reinterpret_cast<A *>(dtInstance + offset_);
-  }
-  template <typename A> const A *Locate(const char *dtInstance) const {
-    return reinterpret_cast<const A *>(dtInstance + offset_);
-  }
-
-  Descriptor *GetDescriptor(char *dtInstance) const {
-    if (IsDescriptor()) {
-      return Locate<Descriptor>(dtInstance);
-    } else {
-      return nullptr;
-    }
-  }
-
-  const Descriptor *GetDescriptor(const char *dtInstance) const {
-    if (staticDescriptor_) {
-      return staticDescriptor_;
-    } else if (IsDescriptor()) {
-      return Locate<const Descriptor>(dtInstance);
-    } else {
-      return nullptr;
-    }
-  }
-
-private:
-  enum Flag { PARENT = 1, PRIVATE = 2, IS_DESCRIPTOR = 4 };
-  const char *name_{nullptr};
-  std::uint32_t flags_{0};
-  TypeCode typeCode_{CFI_type_other};
-  const Descriptor *staticDescriptor_{nullptr};
-  std::size_t offset_{0}; // byte offset in derived type instance
-};
-
-struct ExecutableCode {
-  ExecutableCode() {}
-  ExecutableCode(const ExecutableCode &) = default;
-  ExecutableCode &operator=(const ExecutableCode &) = default;
-  std::intptr_t host{0};
-  std::intptr_t device{0};
-};
-
-struct TypeBoundProcedure {
-  const char *name;
-  ExecutableCode code;
-};
-
-// Represents a specialization of a derived type; i.e., any KIND type
-// parameters have values set at compilation time.
-// Extended derived types have the EXTENDS flag set and place their base
-// component first in the component descriptions, which is significant for
-// the execution of FINAL subroutines.
-class DerivedType {
-public:
-  DerivedType(const char *n, std::size_t kps, std::size_t lps,
-      const TypeParameter *tp, std::size_t cs, const Component *ca,
-      std::size_t tbps, const TypeBoundProcedure *tbp, std::size_t sz)
-      : name_{n}, kindParameters_{kps}, lenParameters_{lps}, typeParameter_{tp},
-        components_{cs}, component_{ca}, typeBoundProcedures_{tbps},
-        typeBoundProcedure_{tbp}, bytes_{sz} {
-    if (IsNontrivialAnalysis()) {
-      flags_ |= NONTRIVIAL;
-    }
-  }
-
-  const char *name() const { return name_; }
-  std::size_t kindParameters() const { return kindParameters_; }
-  std::size_t lenParameters() const { return lenParameters_; }
-
-  // KIND type parameters come first.
-  const TypeParameter &typeParameter(int n) const { return typeParameter_[n]; }
-
-  std::size_t components() const { return components_; }
-
-  // The first few type-bound procedure indices are special.
-  enum SpecialTBP { InitializerTBP, CopierTBP, FinalTBP };
-
-  std::size_t typeBoundProcedures() const { return typeBoundProcedures_; }
-  const TypeBoundProcedure &typeBoundProcedure(int n) const {
-    return typeBoundProcedure_[n];
-  }
-
-  DerivedType &set_sequence() {
-    flags_ |= SEQUENCE;
-    return *this;
-  }
-  DerivedType &set_bind_c() {
-    flags_ |= BIND_C;
-    return *this;
-  }
-
-  std::size_t SizeInBytes() const { return bytes_; }
-  bool Extends() const { return components_ > 0 && component_[0].IsParent(); }
-  bool AnyPrivate() const;
-  bool IsSequence() const { return (flags_ & SEQUENCE) != 0; }
-  bool IsBindC() const { return (flags_ & BIND_C) != 0; }
-  bool IsNontrivial() const { return (flags_ & NONTRIVIAL) != 0; }
-
-  bool IsSameType(const DerivedType &) const;
-
-  void Initialize(char *instance) const;
-  void Destroy(char *instance, bool finalize = true) const;
-
-private:
-  enum Flag { SEQUENCE = 1, BIND_C = 2, NONTRIVIAL = 4 };
-
-  // True when any descriptor of data of this derived type will require
-  // an addendum pointing to a DerivedType, possibly with values of
-  // LEN type parameters.  Conservative.
-  bool IsNontrivialAnalysis() const;
-
-  const char *name_{""}; // NUL-terminated constant text
-  std::size_t kindParameters_{0};
-  std::size_t lenParameters_{0};
-  const TypeParameter *typeParameter_{nullptr}; // array
-  std::size_t components_{0}; // *not* including type parameters
-  const Component *component_{nullptr}; // array
-  std::size_t typeBoundProcedures_{0};
-  const TypeBoundProcedure *typeBoundProcedure_{nullptr}; // array
-  std::uint64_t flags_{0};
-  std::size_t bytes_{0};
-};
-} // namespace Fortran::runtime
-#endif // FORTRAN_RUNTIME_DERIVED_TYPE_H_

flang/runtime/derived-type.cpp

-//===-- runtime/derived-type.cpp ------------------------------------------===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-
-#include "derived-type.h"
-#include "descriptor.h"
-#include <cstring>
-
-namespace Fortran::runtime {
-
-TypeParameterValue TypeParameter::GetValue(const Descriptor &descriptor) const {
-  if (which_ < 0) {
-    return value_;
-  } else {
-    return descriptor.Addendum()->LenParameterValue(which_);
-  }
-}
-
-bool DerivedType::IsNontrivialAnalysis() const {
-  if (kindParameters_ > 0 || lenParameters_ > 0 || typeBoundProcedures_ > 0) {
-    return true;
-  }
-  for (std::size_t j{0}; j < components_; ++j) {
-    if (component_[j].IsDescriptor()) {
-      return true;
-    }
-    if (const Descriptor * staticDescriptor{component_[j].staticDescriptor()}) {
-      if (const DescriptorAddendum * addendum{staticDescriptor->Addendum()}) {
-        if (const DerivedType * dt{addendum->derivedType()}) {
-          if (dt->IsNontrivial()) {
-            return true;
-          }
-        }
-      }
-    }
-  }
-  return false;
-}
-
-void DerivedType::Initialize(char *instance) const {
-  if (typeBoundProcedures_ > InitializerTBP) {
-    if (auto f{reinterpret_cast<void (*)(char *)>(
-            typeBoundProcedure_[InitializerTBP].code.host)}) {
-      f(instance);
-    }
-  }
-#if 0 // TODO
-  for (std::size_t j{0}; j < components_; ++j) {
-    if (const Descriptor * descriptor{component_[j].GetDescriptor(instance)}) {
-      // invoke initialization TBP
-    }
-  }
-#endif
-}
-
-void DerivedType::Destroy(char *instance, bool finalize) const {
-  if (finalize && typeBoundProcedures_ > FinalTBP) {
-    if (auto f{reinterpret_cast<void (*)(char *)>(
-            typeBoundProcedure_[FinalTBP].code.host)}) {
-      f(instance);
-    }
-  }
-  const char *constInstance{instance};
-  for (std::size_t j{0}; j < components_; ++j) {
-    if (Descriptor * descriptor{component_[j].GetDescriptor(instance)}) {
-      descriptor->Deallocate(finalize);
-    } else if (const Descriptor *
-        descriptor{component_[j].GetDescriptor(constInstance)}) {
-      descriptor->Destroy(component_[j].Locate<char>(instance), finalize);
-    }
-  }
-}
-} // namespace Fortran::runtime

flang/runtime/derived.h

+//===-- runtime/derived.h -------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FLANG_RUNTIME_DERIVED_H_
+#define FLANG_RUNTIME_DERIVED_H_
+
+namespace Fortran::runtime::typeInfo {
+class DerivedType;
+}
+
+namespace Fortran::runtime {
+class Descriptor;
+void Destroy(const Descriptor &, bool finalize, const typeInfo::DerivedType &);
+} // namespace Fortran::runtime
+#endif // FLANG_RUNTIME_FINAL_H_

flang/runtime/derived.cpp

+//===-- runtime/derived.cpp -----------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "derived.h"
+#include "descriptor.h"
+#include "type-info.h"
+
+namespace Fortran::runtime {
+
+static const typeInfo::SpecialBinding *FindFinal(
+    const typeInfo::DerivedType &derived, int rank) {
+  const typeInfo::SpecialBinding *elemental{nullptr};
+  const Descriptor &specialDesc{derived.special.descriptor()};
+  std::size_t totalSpecialBindings{specialDesc.Elements()};
+  for (std::size_t j{0}; j < totalSpecialBindings; ++j) {
+    const auto &special{
+        *specialDesc.ZeroBasedIndexedElement<typeInfo::SpecialBinding>(j)};
+    switch (special.which) {
+    case typeInfo::SpecialBinding::Which::Final:
+      if (special.rank == rank) {
+        return &special;
+      }
+      break;
+    case typeInfo::SpecialBinding::Which::ElementalFinal:
+      elemental = &special;
+      break;
+    case typeInfo::SpecialBinding::Which::AssumedRankFinal:
+      return &special;
+    default:;
+    }
+  }
+  return elemental;
+}
+
+static void CallFinalSubroutine(
+    const Descriptor &descriptor, const typeInfo::DerivedType &derived) {
+  if (const auto *special{FindFinal(derived, descriptor.rank())}) {
+    if (special->which == typeInfo::SpecialBinding::Which::ElementalFinal) {
+      std::size_t byteStride{descriptor.ElementBytes()};
+      auto p{reinterpret_cast<void (*)(char *)>(special->proc)};
+      // Finalizable objects must be contiguous.
+      std::size_t elements{descriptor.Elements()};
+      for (std::size_t j{0}; j < elements; ++j) {
+        p(descriptor.OffsetElement<char>(j * byteStride));
+      }
+    } else if (special->isArgDescriptorSet & 1) {
+      auto p{reinterpret_cast<void (*)(const Descriptor &)>(special->proc)};
+      p(descriptor);
+    } else {
+      // Finalizable objects must be contiguous.
+      auto p{reinterpret_cast<void (*)(char *)>(special->proc)};
+      p(descriptor.OffsetElement<char>());
+    }
+  }
+}
+
+static inline SubscriptValue GetValue(
+    const typeInfo::Value &value, const Descriptor &descriptor) {
+  if (value.genre == typeInfo::Value::Genre::LenParameter) {
+    return descriptor.Addendum()->LenParameterValue(value.value);
+  } else {
+    return value.value;
+  }
+}
+
+// The order of finalization follows Fortran 2018 7.5.6.2, with
+// deallocation of non-parent components (and their consequent finalization)
+// taking place before parent component finalization.
+void Destroy(const Descriptor &descriptor, bool finalize,
+    const typeInfo::DerivedType &derived) {
+  if (finalize) {
+    CallFinalSubroutine(descriptor, derived);
+  }
+  const Descriptor &componentDesc{derived.component.descriptor()};
+  std::int64_t myComponents{componentDesc.GetDimension(0).Extent()};
+  std::size_t elements{descriptor.Elements()};
+  std::size_t byteStride{descriptor.ElementBytes()};
+  for (unsigned k{0}; k < myComponents; ++k) {
+    const auto &comp{
+        *componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
+    if (comp.genre == typeInfo::Component::Genre::Allocatable ||
+        comp.genre == typeInfo::Component::Genre::Automatic) {
+      for (std::size_t j{0}; j < elements; ++j) {
+        descriptor.OffsetElement<Descriptor>(j * byteStride + comp.offset)
+            ->Deallocate(finalize);
+      }
+    } else if (comp.genre == typeInfo::Component::Genre::Data &&
+        comp.derivedType.descriptor().raw().base_addr) {
+      SubscriptValue extent[maxRank];
+      const Descriptor &boundsDesc{comp.bounds.descriptor()};
+      for (int dim{0}; dim < comp.rank; ++dim) {
+        extent[dim] =
+            GetValue(
+                *boundsDesc.ZeroBasedIndexedElement<typeInfo::Value>(2 * dim),
+                descriptor) -
+            GetValue(*boundsDesc.ZeroBasedIndexedElement<typeInfo::Value>(
+                         2 * dim + 1),
+                descriptor) +
+            1;
+      }
+      StaticDescriptor<maxRank, true, 0> staticDescriptor;
+      Descriptor &compDesc{staticDescriptor.descriptor()};
+      const auto &compType{*comp.derivedType.descriptor()
+                                .OffsetElement<typeInfo::DerivedType>()};
+      for (std::size_t j{0}; j < elements; ++j) {
+        compDesc.Establish(compType,
+            descriptor.OffsetElement<char>(j * byteStride + comp.offset),
+            comp.rank, extent);
+        Destroy(compDesc, finalize, compType);
+      }
+    }
+  }
+  const Descriptor &parentDesc{derived.parent.descriptor()};
+  if (const auto *parent{parentDesc.OffsetElement<typeInfo::DerivedType>()}) {
+    Destroy(descriptor, finalize, *parent);
+  }
+}
+} // namespace Fortran::runtime

flang/runtime/descriptor.h

 // to implement nontrivial dummy arguments, pointers, allocatables,
 // function results, and the special behaviors of instances of derived types.
 // This header file includes and extends the published language
 // interoperability header that is required by the Fortran 2018 standard
 // as a subset of definitions suitable for exposure to user C/C++ code.
 // User C code is welcome to depend on that ISO_Fortran_binding.h file,
 // but should never reference this internal header.
 
-#include "derived-type.h"
 #include "memory.h"
 #include "type-code.h"
 #include "flang/ISO_Fortran_binding.h"
 #include <cassert>
 #include <cinttypes>
 #include <cstddef>
 #include <cstdio>
 #include <cstring>
 
+namespace Fortran::runtime::typeInfo {
+using TypeParameterValue = std::int64_t;
+class DerivedType;
+} // namespace Fortran::runtime::typeInfo
+
 namespace Fortran::runtime {
 
 using SubscriptValue = ISO::CFI_index_t;
 
 static constexpr int maxRank{CFI_MAX_RANK};
 
 // A C++ view of the sole interoperable standard descriptor (ISO::CFI_cdesc_t)
 // and its type and per-dimension information.
private:
   ISO::CFI_dim_t raw_;
 };
 
 // The storage for this object follows the last used dim[] entry in a
 // Descriptor (CFI_cdesc_t) generic descriptor.  Space matters here, since
 // descriptors serve as POINTER and ALLOCATABLE components of derived type
 // instances.  The presence of this structure is implied by the flag
 // CFI_cdesc_t.f18Addendum, and the number of elements in the len_[]
-// array is determined by DerivedType::lenParameters().
+// array is determined by derivedType_->LenParameters().
 class DescriptorAddendum {
 public:
   enum Flags {
     StaticDescriptor = 0x001,
     ImplicitAllocatable = 0x002, // compiler-created allocatable
     DoNotFinalize = 0x004, // compiler temporary
     Target = 0x008, // TARGET attribute
   };
 
   explicit DescriptorAddendum(
-      const DerivedType *dt = nullptr, std::uint64_t flags = 0)
+      const typeInfo::DerivedType *dt = nullptr, std::uint64_t flags = 0)
       : derivedType_{dt}, flags_{flags} {}
 
-  const DerivedType *derivedType() const { return derivedType_; }
-  DescriptorAddendum &set_derivedType(const DerivedType *dt) {
+  const typeInfo::DerivedType *derivedType() const { return derivedType_; }
+  DescriptorAddendum &set_derivedType(const typeInfo::DerivedType *dt) {
     derivedType_ = dt;
     return *this;
   }
   std::uint64_t &flags() { return flags_; }
   const std::uint64_t &flags() const { return flags_; }
 
-  std::size_t LenParameters() const {
-    if (derivedType_) {
-      return derivedType_->lenParameters();
-    }
-    return 0;
-  }
+  std::size_t LenParameters() const;
 
-  TypeParameterValue LenParameterValue(int which) const { return len_[which]; }
+  typeInfo::TypeParameterValue LenParameterValue(int which) const {
+    return len_[which];
+  }
   static constexpr std::size_t SizeInBytes(int lenParameters) {
-    return sizeof(DescriptorAddendum) - sizeof(TypeParameterValue) +
-        lenParameters * sizeof(TypeParameterValue);
+    return sizeof(DescriptorAddendum) - sizeof(typeInfo::TypeParameterValue) +
+        lenParameters * sizeof(typeInfo::TypeParameterValue);
   }
   std::size_t SizeInBytes() const;
 
-  void SetLenParameterValue(int which, TypeParameterValue x) {
+  void SetLenParameterValue(int which, typeInfo::TypeParameterValue x) {
     len_[which] = x;
   }
 
   void Dump(FILE * = stdout) const;
 
 private:
-  const DerivedType *derivedType_{nullptr};
+  const typeInfo::DerivedType *derivedType_;
   std::uint64_t flags_{0};
-  TypeParameterValue len_[1]; // must be the last component
+  typeInfo::TypeParameterValue len_[1]; // must be the last component
   // The LEN type parameter values can also include captured values of
   // specification expressions that were used for bounds and for LEN type
   // parameters of components.  The values have been truncated to the LEN
   // type parameter's type, if shorter than 64 bits, then sign-extended.
 };
 
 // A C++ view of a standard descriptor object.
 class Descriptor {
public:
   void Establish(TypeCategory, int kind, void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other,
       bool addendum = false);
   void Establish(int characterKind, std::size_t characters, void *p = nullptr,
       int rank = maxRank, const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other,
       bool addendum = false);
-  void Establish(const DerivedType &dt, void *p = nullptr, int rank = maxRank,
-      const SubscriptValue *extent = nullptr,
+  void Establish(const typeInfo::DerivedType &dt, void *p = nullptr,
+      int rank = maxRank, const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
 
   static OwningPtr<Descriptor> Create(TypeCode t, std::size_t elementBytes,
       void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other,
       int derivedTypeLenParameters = 0);
   static OwningPtr<Descriptor> Create(TypeCategory, int kind, void *p = nullptr,
       int rank = maxRank, const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
   static OwningPtr<Descriptor> Create(int characterKind,
       SubscriptValue characters, void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
-  static OwningPtr<Descriptor> Create(const DerivedType &dt, void *p = nullptr,
-      int rank = maxRank, const SubscriptValue *extent = nullptr,
+  static OwningPtr<Descriptor> Create(const typeInfo::DerivedType &dt,
+      void *p = nullptr, int rank = maxRank,
+      const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
 
   ISO::CFI_cdesc_t &raw() { return raw_; }
   const ISO::CFI_cdesc_t &raw() const { return raw_; }
   std::size_t ElementBytes() const { return raw_.elem_len; }
   int rank() const { return raw_.rank; }
   TypeCode type() const { return TypeCode{raw_.type}; }
 
public:
   std::size_t SizeInBytes() const;
 
   std::size_t Elements() const;
 
   // TODO: SOURCE= and MOLD=
   int Allocate();
   int Allocate(const SubscriptValue lb[], const SubscriptValue ub[]);
   int Deallocate(bool finalize = true);
-  void Destroy(char *data, bool finalize = true) const;
+  void Destroy(bool finalize = true) const;
 
   bool IsContiguous(int leadingDimensions = maxRank) const {
     auto bytes{static_cast<SubscriptValue>(ElementBytes())};
     for (int j{0}; j < leadingDimensions && j < raw_.rank; ++j) {
       const Dimension &dim{GetDimension(j)};
       if (bytes != dim.ByteStride()) {
         return false;
       }
const Descriptor &descriptor() const {
     return *reinterpret_cast<const Descriptor *>(storage_);
   }
 
   void Check() {
     assert(descriptor().rank() <= maxRank);
     assert(descriptor().SizeInBytes() <= byteSize);
     if (DescriptorAddendum * addendum{descriptor().Addendum()}) {
       assert(hasAddendum);
-      if (const DerivedType * dt{addendum->derivedType()}) {
-        assert(dt->lenParameters() <= maxLengthTypeParameters);
-      } else {
-        assert(maxLengthTypeParameters == 0);
-      }
+      assert(addendum->LenParameters() <= maxLengthTypeParameters);
     } else {
       assert(!hasAddendum);
       assert(maxLengthTypeParameters == 0);
     }
     descriptor().Check();
   }
 
 private:
   char storage_[byteSize];
 };
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_DESCRIPTOR_H_

flang/runtime/descriptor.cpp

 //===-- runtime/descriptor.cpp --------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "descriptor.h"
+#include "derived.h"
 #include "memory.h"
 #include "terminator.h"
+#include "type-info.h"
 #include <cassert>
 #include <cstdlib>
 #include <cstring>
 
 namespace Fortran::runtime {
 
 Descriptor::Descriptor(const Descriptor &that) {
   std::memcpy(this, &that, that.SizeInBytes());

 
 void Descriptor::Establish(int characterKind, std::size_t characters, void *p,
     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
     bool addendum) {
   Establish(TypeCode{TypeCategory::Character, characterKind},
       characterKind * characters, p, rank, extent, attribute, addendum);
 }
 
-void Descriptor::Establish(const DerivedType &dt, void *p, int rank,
+void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank,
     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
-  Establish(
-      CFI_type_struct, dt.SizeInBytes(), p, rank, extent, attribute, true);
+  Establish(CFI_type_struct, dt.sizeInBytes, p, rank, extent, attribute, true);
   DescriptorAddendum *a{Addendum()};
   Terminator terminator{__FILE__, __LINE__};
   RUNTIME_CHECK(terminator, a != nullptr);
   new (a) DescriptorAddendum{&dt};
 }
 
 OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
     void *p, int rank, const SubscriptValue *extent,

 
 OwningPtr<Descriptor> Descriptor::Create(int characterKind,
     SubscriptValue characters, void *p, int rank, const SubscriptValue *extent,
     ISO::CFI_attribute_t attribute) {
   return Create(TypeCode{TypeCategory::Character, characterKind},
       characterKind * characters, p, rank, extent, attribute);
 }
 
-OwningPtr<Descriptor> Descriptor::Create(const DerivedType &dt, void *p,
-    int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
-  return Create(TypeCode{CFI_type_struct}, dt.SizeInBytes(), p, rank, extent,
-      attribute, dt.lenParameters());
+OwningPtr<Descriptor> Descriptor::Create(const typeInfo::DerivedType &dt,
+    void *p, int rank, const SubscriptValue *extent,
+    ISO::CFI_attribute_t attribute) {
+  return Create(TypeCode{CFI_type_struct}, dt.sizeInBytes, p, rank, extent,
+      attribute, dt.LenParameters());
 }
 
 std::size_t Descriptor::SizeInBytes() const {
   const DescriptorAddendum *addendum{Addendum()};
   return sizeof *this - sizeof(Dimension) + raw_.rank * sizeof(Dimension) +
       (addendum ? addendum->SizeInBytes() : 0);
 }
 
int Descriptor::Allocate(const SubscriptValue lb[], const SubscriptValue ub[]) {
   int result{ISO::CFI_allocate(&raw_, lb, ub, ElementBytes())};
   if (result == CFI_SUCCESS) {
     // TODO: derived type initialization
   }
   return result;
 }
 
 int Descriptor::Deallocate(bool finalize) {
-  if (raw_.base_addr) {
-    Destroy(static_cast<char *>(raw_.base_addr), finalize);
-  }
+  Destroy(finalize);
   return ISO::CFI_deallocate(&raw_);
 }
 
-void Descriptor::Destroy(char *data, bool finalize) const {
-  if (data) {
-    if (const DescriptorAddendum * addendum{Addendum()}) {
+void Descriptor::Destroy(bool finalize) const {
+    if (const typeInfo::DerivedType * dt{addendum->derivedType()}) {
       if (addendum->flags() & DescriptorAddendum::DoNotFinalize) {
         finalize = false;
       }
-      if (const DerivedType * dt{addendum->derivedType()}) {
-        std::size_t elements{Elements()};
-        std::size_t elementBytes{ElementBytes()};
-        for (std::size_t j{0}; j < elements; ++j) {
-          dt->Destroy(data + j * elementBytes, finalize);
-        }
-      }
+      runtime::Destroy(*this, finalize, *dt);
     }
   }
 }
 
 bool Descriptor::IncrementSubscripts(
     SubscriptValue *subscript, const int *permutation) const {
   for (int j{0}; j < raw_.rank; ++j) {
     int k{permutation ? permutation[j] : j};
if (const DescriptorAddendum * addendum{Addendum()}) {
     addendum->Dump(f);
   }
 }
 
 std::size_t DescriptorAddendum::SizeInBytes() const {
   return SizeInBytes(LenParameters());
 }
 
+std::size_t DescriptorAddendum::LenParameters() const {
+  const auto *type{derivedType()};
+  return type ? type->LenParameters() : 0;
+}
+
 void DescriptorAddendum::Dump(FILE *f) const {
   std::fprintf(
       f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType_));
   std::fprintf(f, "  flags 0x%jx\n", static_cast<std::intmax_t>(flags_));
   // TODO: LEN parameter values
 }
 } // namespace Fortran::runtime

flang/runtime/transformational.cpp

OwningPtr<Descriptor> RESHAPE(const Descriptor &source, const Descriptor &shape,
   } else {
     for (int j{0}; j < resultRank; ++j) {
       dimOrder[j] = j;
     }
   }
 
   // Create and populate the result's descriptor.
   const DescriptorAddendum *sourceAddendum{source.Addendum()};
-  const DerivedType *sourceDerivedType{
+  const typeInfo::DerivedType *sourceDerivedType{
       sourceAddendum ? sourceAddendum->derivedType() : nullptr};
   OwningPtr<Descriptor> result;
   if (sourceDerivedType) {
     result = Descriptor::Create(*sourceDerivedType, nullptr, resultRank,
         resultExtent, CFI_attribute_allocatable);
   } else {
     result = Descriptor::Create(source.type(), elementBytes, nullptr,
         resultRank, resultExtent,
         CFI_attribute_allocatable); // TODO rearrange these arguments
   }
   DescriptorAddendum *resultAddendum{result->Addendum()};
   RUNTIME_CHECK(terminator, resultAddendum);
   resultAddendum->flags() |= DescriptorAddendum::DoNotFinalize;
   if (sourceDerivedType) {
-    std::size_t lenParameters{sourceDerivedType->lenParameters()};
+    std::size_t lenParameters{sourceAddendum->LenParameters()};
     for (std::size_t j{0}; j < lenParameters; ++j) {
       resultAddendum->SetLenParameterValue(
           j, sourceAddendum->LenParameterValue(j));
     }
   }
   // Allocate storage for the result's data.
   int status{result->Allocate(lowerBound, resultExtent)};
   if (status != CFI_SUCCESS) {

flang/runtime/type-info.h

+//===-- runtime/type-info.h -------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_TYPE_INFO_H_
+#define FORTRAN_RUNTIME_TYPE_INFO_H_
+
+// A C++ perspective of the derived type description schemata in
+// flang/module/__fortran_type_info.f90.
+
+#include "descriptor.h"
+#include "flang/Common/Fortran.h"
+#include <cinttypes>
+#include <memory>
+
+namespace Fortran::runtime::typeInfo {
+
+class DerivedType {
+public:
+  ~DerivedType();
+
+  // This member comes first because it's used like a vtable by generated code.
+  // It includes all of the ancestor types' bindings, if any, first,
+  // with any overrides from descendants already applied to them.  Local
+  // bindings then follow in alphabetic order of binding name.
+  StaticDescriptor<1> binding; // TYPE(BINDING), DIMENSION(:), POINTER
+
+  StaticDescriptor<0> name; // CHARACTER(:), POINTER
+
+  std::uint64_t sizeInBytes{0};
+  StaticDescriptor<0> parent; // TYPE(DERIVEDTYPE), POINTER
+
+  // Instantiations of a parameterized derived type with KIND type
+  // parameters will point this data member to the description of
+  // the original uninstantiated type, which may be shared from a
+  // module via use association.  The original uninstantiated derived
+  // type description will point to itself.  Derived types that have
+  // no KIND type parameters will have a null pointer here.
+  StaticDescriptor<0> uninstantiated; // TYPE(DERIVEDTYPE), POINTER
+
+  // TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2)
+  std::uint64_t typeHash{0};
+
+  // These pointer targets include all of the items from the parent, if any.
+  StaticDescriptor<1> kindParameter; // pointer to rank-1 array of INTEGER(8)
+  StaticDescriptor<1> lenParameterKind; // pointer to rank-1 array of INTEGER(1)
+
+  // This array of local data components includes the parent component.
+  // Components are in alphabetic order.
+  // It does not include procedure pointer components.
+  StaticDescriptor<1, true> component; // TYPE(COMPONENT), POINTER, DIMENSION(:)
+
+  // Procedure pointer components
+  StaticDescriptor<1, true> procPtr; // TYPE(PROCPTR), POINTER, DIMENSION(:)
+
+  // Does not include special bindings from ancestral types.
+  StaticDescriptor<1, true>
+      special; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:)
+
+  std::size_t LenParameters() const {
+    return lenParameterKind.descriptor().Elements();
+  }
+};
+
+using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
+
+struct Binding {
+  ProcedurePointer proc;
+  StaticDescriptor<0> name; // CHARACTER(:), POINTER
+};
+
+struct Value {
+  enum class Genre : std::uint8_t {
+    Deferred = 1,
+    Explicit = 2,
+    LenParameter = 3
+  };
+  Genre genre{Genre::Explicit};
+  // The value encodes an index into the table of LEN type parameters in
+  // a descriptor's addendum for genre == Genre::LenParameter.
+  TypeParameterValue value{0};
+};
+
+struct Component {
+  enum class Genre : std::uint8_t { Data, Pointer, Allocatable, Automatic };
+  StaticDescriptor<0> name; // CHARACTER(:), POINTER
+  Genre genre{Genre::Data};
+  std::uint8_t category; // common::TypeCategory
+  std::uint8_t kind{0};
+  std::uint8_t rank{0};
+  std::uint64_t offset{0};
+  Value characterLen; // for TypeCategory::Character
+  StaticDescriptor<0, true> derivedType; // TYPE(DERIVEDTYPE), POINTER
+  StaticDescriptor<1, true> lenValue; // TYPE(VALUE), POINTER, DIMENSION(:)
+  StaticDescriptor<2, true> bounds; // TYPE(VALUE), POINTER, DIMENSION(2,:)
+  char *initialization{nullptr}; // for Genre::Data and Pointer
+  // TODO: cobounds
+  // TODO: `PRIVATE` attribute
+};
+
+struct ProcPtrComponent {
+  StaticDescriptor<0> name; // CHARACTER(:), POINTER
+  std::uint64_t offset{0};
+  ProcedurePointer procInitialization; // for Genre::Procedure
+};
+
+struct SpecialBinding {
+  enum class Which : std::uint8_t {
+    None = 0,
+    Assignment = 4,
+    ElementalAssignment = 5,
+    Final = 8,
+    ElementalFinal = 9,
+    AssumedRankFinal = 10,
+    ReadFormatted = 16,
+    ReadUnformatted = 17,
+    WriteFormatted = 18,
+    WriteUnformatted = 19
+  } which{Which::None};
+
+  // Used for Which::Final only.  Which::Assignment always has rank 0, as
+  // type-bound defined assignment for rank > 0 must be elemental
+  // due to the required passed object dummy argument, which are scalar.
+  // User defined derived type I/O is always scalar.
+  std::uint8_t rank{0};
+
+  // The following little bit-set identifies which dummy arguments are
+  // passed via descriptors for their derived type arguments.
+  //   Which::Assignment and Which::ElementalAssignment:
+  //     Set to 1, 2, or (usually 3).
+  //     The passed-object argument (usually the "to") is always passed via a
+  //     a descriptor in the cases where the runtime will call a defined
+  //     assignment because these calls are to type-bound generics,
+  //     not generic interfaces, and type-bound generic defined assigment
+  //     may appear only in an extensible type and requires a passed-object
+  //     argument (see C774), and passed-object arguments to TBPs must be
+  //     both polymorphic and scalar (C760).  The non-passed-object argument
+  //     (usually the "from") is usually, but not always, also a descriptor.
+  //   Which::Final and Which::ElementalFinal:
+  //     Set to 1 when dummy argument is assumed-shape; otherwise, the
+  //     argument can be passed by address.  (Fortran guarantees that
+  //     any finalized object must be whole and contiguous by restricting
+  //     the use of DEALLOCATE on pointers.  The dummy argument of an
+  //     elemental final subroutine must be scalar and monomorphic, but
+  //     use a descriptors when the type has LEN parameters.)
+  //   Which::AssumedRankFinal: flag must necessarily be set
+  //   User derived type I/O:
+  //     Set to 1 when "dtv" initial dummy argument is polymorphic, which is
+  //     the case when and only when the derived type is extensible.
+  //     When false, the user derived type I/O subroutine must have been
+  //     called via a generic interface, not a generic TBP.
+  std::uint8_t isArgDescriptorSet{0};
+
+  ProcedurePointer proc{nullptr};
+};
+} // namespace Fortran::runtime::typeInfo
+#endif // FORTRAN_RUNTIME_TYPE_INFO_H_

flang/test/Semantics/typeinfo01.f90

+!RUN: %f18 -fdebug-dump-symbols -fparse-only %s | FileCheck %s
+! Tests for derived type runtime descriptions
+
+module m01
+  type :: t1
+    integer :: n
+  end type
+!CHECK: .c.t1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.n,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .dt.t1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=4_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL())
+!CHECK: .n.n, SAVE, TARGET: ObjectEntity type: CHARACTER(2_8,1) init:"n"
+!CHECK: .n.t1, SAVE, TARGET: ObjectEntity type: CHARACTER(2_8,1) init:"t1"
+end module
+
+module m02
+  type :: parent
+    integer :: pn
+  end type
+  type, extends(parent) :: child
+    integer :: cn
+  end type
+!CHECK: .c.child, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.parent,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.parent, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.pn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .dt.child, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,parent=.dt.parent,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL())
+!CHECK: .dt.parent, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL())
+end module
+
+module m03
+  type :: kpdt(k)
+    integer(kind=1), kind :: k = 1
+    real(kind=k) :: a
+  end type
+  type(kpdt(4)) :: x
+!CHECK: .c.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=1_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .dt.kpdt, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.kpdt,parent=NULL(),uninstantiated=NULL(),kindparameter=.kp.kpdt,lenparameterkind=NULL())
+!CHECK: .dt.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,parent=NULL(),uninstantiated=.dt.kpdt,kindparameter=.kp.kpdt.0,lenparameterkind=NULL(),component=.c.kpdt.0,procptr=NULL(),special=NULL())
+!CHECK: .kp.kpdt, SAVE, TARGET: ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::1_8]
+!CHECK: .kp.kpdt.0, SAVE, TARGET: ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::4_8]
+end module
+
+module m04
+  type :: tbps
+   contains
+    procedure :: b2 => s1
+    procedure :: b1 => s1
+  end type
+ contains
+  subroutine s1(x)
+    class(tbps), intent(in) :: x
+  end subroutine
+!CHECK: .dt.tbps, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.tbps,name=.n.tbps,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL())
+!CHECK: .v.tbps, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=s1,name=.n.b1),binding(proc=s1,name=.n.b2)]
+end module
+
+module m05
+  type :: t
+    procedure(s1), pointer :: p1 => s1
+  end type
+ contains
+  subroutine s1(x)
+    class(t), intent(in) :: x
+  end subroutine
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL())
+!CHECK: .p.t, SAVE, TARGET: ObjectEntity type: TYPE(procptrcomponent) shape: 0_8:0_8 init:[procptrcomponent::procptrcomponent(name=.n.p1,offset=0_8,initialization=s1)]
+end module
+
+module m06
+  type :: t
+   contains
+    procedure :: s1
+    generic :: assignment(=) => s1
+  end type
+  type, extends(t) :: t2
+   contains
+    procedure :: s1 => s2 ! override
+  end type
+ contains
+  subroutine s1(x, y)
+    class(t), intent(out) :: x
+    class(t), intent(in) :: y
+  end subroutine
+  subroutine s2(x, y)
+    class(t2), intent(out) :: x
+    class(t), intent(in) :: y
+  end subroutine
+!CHECK: .c.t2, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
+!CHECK: .dt.t2, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,parent=.dt.t,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL())
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=4_1,rank=0_1,isargdescriptorset=3_1,proc=s1)]
+!CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
+!CHECK: .v.t2, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s2,name=.n.s1)]
+end module
+
+module m07
+  type :: t
+   contains
+    procedure :: s1
+    generic :: assignment(=) => s1
+  end type
+ contains
+  impure elemental subroutine s1(x, y)
+    class(t), intent(out) :: x
+    class(t), intent(in) :: y
+  end subroutine
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,rank=0_1,isargdescriptorset=3_1,proc=s1)]
+!CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
+end module
+
+module m08
+  type :: t
+   contains
+    final :: s1, s2, s3
+  end type
+ contains
+  subroutine s1(x)
+    type(t) :: x(:)
+  end subroutine
+  subroutine s2(x)
+    type(t) :: x(3,3)
+  end subroutine
+  impure elemental subroutine s3(x)
+    type(t) :: x
+  end subroutine
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:2_8 init:[specialbinding::specialbinding(which=8_1,rank=1_1,isargdescriptorset=1_1,proc=s1),specialbinding(which=8_1,rank=2_1,isargdescriptorset=0_1,proc=s2),specialbinding(which=9_1,rank=0_1,isargdescriptorset=0_1,proc=s3)]
+end module
+
+module m09
+  type :: t
+   contains
+    procedure :: rf, ru, wf, wu
+    generic :: read(formatted) => rf
+    generic :: read(unformatted) => ru
+    generic :: write(formatted) => wf
+    generic :: write(unformatted) => wu
+  end type
+ contains
+  subroutine rf(x,u,iot,v,iostat,iomsg)
+    class(t), intent(inout) :: x
+    integer, intent(in) :: u
+    character(len=*), intent(in) :: iot
+    integer, intent(in) :: v(:)
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
+  end subroutine
+  subroutine ru(x,u,iostat,iomsg)
+    class(t), intent(inout) :: x
+    integer, intent(in) :: u
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
+  end subroutine
+  subroutine wf(x,u,iot,v,iostat,iomsg)
+    class(t), intent(in) :: x
+    integer, intent(in) :: u
+    character(len=*), intent(in) :: iot
+    integer, intent(in) :: v(:)
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
+  end subroutine
+  subroutine wu(x,u,iostat,iomsg)
+    class(t), intent(in) :: x
+    integer, intent(in) :: u
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
+  end subroutine
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=16_1,rank=0_1,isargdescriptorset=1_1,proc=rf),specialbinding(which=17_1,rank=0_1,isargdescriptorset=1_1,proc=ru),specialbinding(which=18_1,rank=0_1,isargdescriptorset=1_1,proc=wf),specialbinding(which=19_1,rank=0_1,isargdescriptorset=1_1,proc=wu)]
+!CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:3_8 init:[binding::binding(proc=rf,name=.n.rf),binding(proc=ru,name=.n.ru),binding(proc=wf,name=.n.wf),binding(proc=wu,name=.n.wu)]
+end module
+
+module m10
+  type :: t
+  end type
+  interface read(formatted)
+    procedure :: rf
+  end interface
+  interface read(unformatted)
+    procedure :: ru
+  end interface
+  interface write(formatted)
+    procedure ::wf
+  end interface
+  interface write(unformatted)
+    procedure :: wu
+  end interface
+ contains
+  subroutine rf(x,u,iot,v,iostat,iomsg)
+    type(t), intent(inout) :: x
+    integer, intent(in) :: u
+    character(len=*), intent(in) :: iot
+    integer, intent(in) :: v(:)
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
+  end subroutine
+  subroutine ru(x,u,iostat,iomsg)
+    type(t), intent(inout) :: x
+    integer, intent(in) :: u
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
+  end subroutine
+  subroutine wf(x,u,iot,v,iostat,iomsg)
+    type(t), intent(in) :: x
+    integer, intent(in) :: u
+    character(len=*), intent(in) :: iot
+    integer, intent(in) :: v(:)
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
+  end subroutine
+  subroutine wu(x,u,iostat,iomsg)
+    type(t), intent(in) :: x
+    integer, intent(in) :: u
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
+  end subroutine
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=16_1,rank=0_1,isargdescriptorset=0_1,proc=rf),specialbinding(which=17_1,rank=0_1,isargdescriptorset=0_1,proc=ru),specialbinding(which=18_1,rank=0_1,isargdescriptorset=0_1,proc=wf),specialbinding(which=19_1,rank=0_1,isargdescriptorset=0_1,proc=wu)]
+end module
+
+module m11
+  real, target :: target
+  type :: t(len)
+    integer(kind=8), len :: len
+    real, allocatable :: allocatable(:)
+    real, pointer :: pointer => target
+    character(len=len) :: chauto
+    real :: automatic(len)
+  end type
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t)
+!CHECK: .lpk.t, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
+ contains
+  subroutine s1(x)
+!CHECK: .b.t.1.allocatable, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=1_1,value=0_8),value(genre=1_1,value=0_8)],shape=[2,1])
+!CHECK: .b.t.1.automatic, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=2_1,value=1_8),value(genre=3_1,value=0_8)],shape=[2,1])
+!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.allocatable,initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL()),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=target)]
+!CHECK: .dt.t.1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,parent=NULL(),uninstantiated=.dt.t,kindparameter=NULL(),lenparameterkind=.lpk.t.1,component=.c.t.1,procptr=NULL(),special=NULL())
+!CHECK: .lpk.t.1, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
+    type(t(*)), intent(in) :: x
+  end subroutine
+end module

flang/tools/f18/CMakeLists.txt

target_link_libraries(f18
   FortranCommon
   FortranParser
   FortranEvaluate
   FortranSemantics
   FortranLower
 )
 
 set(MODULES
+  "__fortran_builtins"
+  "__fortran_type_info"
   "ieee_arithmetic"
   "ieee_exceptions"
   "ieee_features"
   "iso_c_binding"
   "iso_fortran_env"
   "omp_lib"
   "__fortran_builtins"
+  "__fortran_type_info"
 )
 
 set(include ${FLANG_BINARY_DIR}/include/flang)
 target_include_directories(f18
   PRIVATE
   ${CMAKE_CURRENT_BINARY_DIR}
 )
 
 # Create module files directly from the top-level module source directory
 foreach(filename ${MODULES})
-  if(${filename} MATCHES "__fortran_builtins")
+  if(${filename} MATCHES "__fortran_type_info")
     set(depends "")
+  elseif(${filename} MATCHES "__fortran_builtins")
+    set(depends ${include}/__fortran_type_info.mod)
   else()
     set(depends ${include}/__fortran_builtins.mod)
   endif()
   add_custom_command(OUTPUT ${include}/${filename}.mod
     COMMAND f18 -fparse-only -I${include}
       ${FLANG_SOURCE_DIR}/module/${filename}.f90
     WORKING_DIRECTORY ${include}
     DEPENDS f18 ${FLANG_SOURCE_DIR}/module/${filename}.f90 ${depends}

flang/tools/f18/f18.cpp

 #include "flang/Parser/dump-parse-tree.h"
 #include "flang/Parser/message.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Parser/parsing.h"
 #include "flang/Parser/provenance.h"
 #include "flang/Parser/unparse.h"
 #include "flang/Semantics/expression.h"
+#include "flang/Semantics/runtime-type-info.h"
 #include "flang/Semantics/semantics.h"
 #include "flang/Semantics/unparse-with-symbols.h"
 #include "llvm/Support/Errno.h"
 #include "llvm/Support/FileSystem.h"
 #include "llvm/Support/Program.h"
 #include "llvm/Support/Signals.h"
 #include "llvm/Support/raw_ostream.h"
 #include <cstdio>
std::string CompileFortran(std::string path, Fortran::parser::Options options,
   }
   if (!driver.debugNoSemantics || driver.dumpSymbols ||
       driver.dumpUnparseWithSymbols || driver.getDefinition ||
       driver.getSymbolsSources) {
     Fortran::semantics::Semantics semantics{semanticsContext, parseTree,
         parsing.cooked().AsCharBlock(), driver.debugModuleWriter};
     semantics.Perform();
     semantics.EmitMessages(llvm::errs());
+    if (semantics.AnyFatalError()) {
       if (driver.dumpSymbols) {
         semantics.DumpSymbols(llvm::outs());
       }
-    if (semantics.AnyFatalError()) {
       llvm::errs() << driver.prefix << "semantic errors in " << path << '\n';
       exitStatus = EXIT_FAILURE;
       if (driver.dumpParseTree) {
         Fortran::parser::DumpTree(llvm::outs(), parseTree, &asFortran);
       }
       return {};
     }
+    auto tables{
+        Fortran::semantics::BuildRuntimeDerivedTypeTables(semanticsContext)};
+    if (!tables.schemata) {
+      llvm::errs() << driver.prefix
+                   << "could not find module file for __fortran_type_info\n";
+    }
+    if (driver.dumpSymbols) {
+      semantics.DumpSymbols(llvm::outs());
+    }
     if (driver.dumpUnparseWithSymbols) {
       Fortran::semantics::UnparseWithSymbols(
           llvm::outs(), parseTree, driver.encoding);
       return {};
     }
     if (driver.getSymbolsSources) {
       semantics.DumpSymbolsSources(llvm::outs());
       return {};