[flang][hlfir] Make the parent type the first component (llvm#69348)

Type extension is currently handled in FIR by inlining the parents
components as the first member of the record type.

This is not correct from a memory layout point of view since the storage
size of the parent type may be bigger than the sum of the size of its
component (due to alignment requirement). To avoid making FIR types
target dependent and fix this issue, make the parent component a single
component with the parent type at the beginning of the record type.

This also simplifies addressing since parent component is now a "normal"
component that can be designated with hlfir.designate.

StructureComponent lowering however is a bit more complex since the
symbols in the structure component may refer to subcomponents of parent
types.

Notes:
1. The fix is only done in HLFIR for now, a similar fix should be done
in ConvertExpr.cpp to fix the path without HLFIR (I will likely still do
it in a new patch since it would be an annoying bug to investigate for
people testing flang without HLFIR).
2. The private component extra mangling is useless after this patch. I
will remove it after 1.
3. The "parent component" TODO in constant CTOR is free to implement for
HLFIR after this patch, but I would rather remove it and test it in a
different patch.

Author: jeanPerier

flang/include/flang/Lower/ConvertType.h

@@ -48,6 +48,8 @@ struct SomeType;
 namespace semantics {
 class Symbol;
 class DerivedTypeSpec;
+class DerivedTypeDetails;
+class Scope;
 } // namespace semantics
 
 namespace lower {
@@ -97,6 +99,34 @@ class TypeBuilder {
 using namespace evaluate;
 FOR_EACH_SPECIFIC_TYPE(extern template class TypeBuilder, )
 
+/// A helper class to reverse iterate through the component names of a derived
+/// type, including the parent component and the component of the parents. This
+/// is useful to deal with StructureConstructor lowering.
+class ComponentReverseIterator {
+public:
+  ComponentReverseIterator(const Fortran::semantics::DerivedTypeSpec &derived) {
+    setCurrentType(derived);
+  }
+  /// Does the current type has a component with \name (does not look-up the
+  /// components of the parent if any)? If there is a match, the iterator
+  /// is advanced to the search result.
+  bool lookup(const Fortran::parser::CharBlock &name) {
+    componentIt = std::find(componentIt, componentItEnd, name);
+    return componentIt != componentItEnd;
+  };
+
+  /// Advance iterator to the last components of the current type parent.
+  const Fortran::semantics::DerivedTypeSpec &advanceToParentType();
+
+private:
+  void setCurrentType(const Fortran::semantics::DerivedTypeSpec &derived);
+  const Fortran::semantics::DerivedTypeSpec *currentParentType = nullptr;
+  const Fortran::semantics::DerivedTypeDetails *currentTypeDetails = nullptr;
+  using name_iterator =
+      std::list<Fortran::parser::CharBlock>::const_reverse_iterator;
+  name_iterator componentIt{};
+  name_iterator componentItEnd{};
+};
 } // namespace lower
 } // namespace Fortran
 

flang/include/flang/Semantics/tools.h

@@ -509,7 +509,7 @@ template <ComponentKind componentKind> class ComponentIterator {
       explicit ComponentPathNode(const DerivedTypeSpec &derived)
           : derived_{derived} {
         if constexpr (componentKind == ComponentKind::Scope) {
-          const Scope &scope{DEREF(derived.scope())};
+          const Scope &scope{DEREF(derived.GetScope())};
           nameIterator_ = scope.cbegin();
           nameEnd_ = scope.cend();
         } else {

flang/include/flang/Semantics/type.h

@@ -261,6 +261,8 @@ class DerivedTypeSpec {
   const SourceName &name() const { return name_; }
   const Symbol &typeSymbol() const { return typeSymbol_; }
   const Scope *scope() const { return scope_; }
+  // Return scope_ if it is set, or the typeSymbol_ scope otherwise.
+  const Scope *GetScope() const;
   void set_scope(const Scope &);
   void ReplaceScope(const Scope &);
   const RawParameters &rawParameters() const { return rawParameters_; }

flang/lib/Lower/ConvertConstant.cpp

@@ -347,91 +347,160 @@ genConstantValue(Fortran::lower::AbstractConverter &converter,
                  mlir::Location loc,
                  const Fortran::lower::SomeExpr &constantExpr);
 
+static mlir::Value genStructureComponentInit(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    const Fortran::semantics::Symbol &sym, const Fortran::lower::SomeExpr &expr,
+    mlir::Value res) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  fir::RecordType recTy = mlir::cast<fir::RecordType>(res.getType());
+  std::string name = converter.getRecordTypeFieldName(sym);
+  mlir::Type componentTy = recTy.getType(name);
+  auto fieldTy = fir::FieldType::get(recTy.getContext());
+  assert(componentTy && "failed to retrieve component");
+  // FIXME: type parameters must come from the derived-type-spec
+  auto field = builder.create<fir::FieldIndexOp>(
+      loc, fieldTy, name, recTy,
+      /*typeParams=*/mlir::ValueRange{} /*TODO*/);
+
+  if (Fortran::semantics::IsAllocatable(sym))
+    TODO(loc, "allocatable component in structure constructor");
+
+  if (Fortran::semantics::IsPointer(sym)) {
+    mlir::Value initialTarget =
+        Fortran::lower::genInitialDataTarget(converter, loc, componentTy, expr);
+    res = builder.create<fir::InsertValueOp>(
+        loc, recTy, res, initialTarget,
+        builder.getArrayAttr(field.getAttributes()));
+    return res;
+  }
+
+  if (Fortran::lower::isDerivedTypeWithLenParameters(sym))
+    TODO(loc, "component with length parameters in structure constructor");
+
+  // Special handling for scalar c_ptr/c_funptr constants. The array constant
+  // must fall through to genConstantValue() below.
+  if (Fortran::semantics::IsBuiltinCPtr(sym) && sym.Rank() == 0 &&
+      (Fortran::evaluate::GetLastSymbol(expr) ||
+       Fortran::evaluate::IsNullPointer(expr))) {
+    // Builtin c_ptr and c_funptr have special handling because designators
+    // and NULL() are handled as initial values for them as an extension
+    // (otherwise only c_ptr_null/c_funptr_null are allowed and these are
+    // replaced by structure constructors by semantics, so GetLastSymbol
+    // returns nothing).
+
+    // The Ev::Expr is an initializer that is a pointer target (e.g., 'x' or
+    // NULL()) that must be inserted into an intermediate cptr record value's
+    // address field, which ought to be an intptr_t on the target.
+    mlir::Value addr = fir::getBase(
+        Fortran::lower::genExtAddrInInitializer(converter, loc, expr));
+    if (addr.getType().isa<fir::BoxProcType>())
+      addr = builder.create<fir::BoxAddrOp>(loc, addr);
+    assert((fir::isa_ref_type(addr.getType()) ||
+            addr.getType().isa<mlir::FunctionType>()) &&
+           "expect reference type for address field");
+    assert(fir::isa_derived(componentTy) &&
+           "expect C_PTR, C_FUNPTR to be a record");
+    auto cPtrRecTy = componentTy.cast<fir::RecordType>();
+    llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName;
+    mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName);
+    auto addrField = builder.create<fir::FieldIndexOp>(
+        loc, fieldTy, addrFieldName, componentTy,
+        /*typeParams=*/mlir::ValueRange{});
+    mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr);
+    auto undef = builder.create<fir::UndefOp>(loc, componentTy);
+    addr = builder.create<fir::InsertValueOp>(
+        loc, componentTy, undef, castAddr,
+        builder.getArrayAttr(addrField.getAttributes()));
+    res = builder.create<fir::InsertValueOp>(
+        loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes()));
+    return res;
+  }
+
+  mlir::Value val = fir::getBase(genConstantValue(converter, loc, expr));
+  assert(!fir::isa_ref_type(val.getType()) && "expecting a constant value");
+  mlir::Value castVal = builder.createConvert(loc, componentTy, val);
+  res = builder.create<fir::InsertValueOp>(
+      loc, recTy, res, castVal, builder.getArrayAttr(field.getAttributes()));
+  return res;
+}
+
 // Generate a StructureConstructor inlined (returns raw fir.type<T> value,
 // not the address of a global constant).
 static mlir::Value genInlinedStructureCtorLitImpl(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     const Fortran::evaluate::StructureConstructor &ctor, mlir::Type type) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   auto recTy = type.cast<fir::RecordType>();
-  auto fieldTy = fir::FieldType::get(type.getContext());
-  mlir::Value res = builder.create<fir::UndefOp>(loc, recTy);
-
-  for (const auto &[sym, expr] : ctor.values()) {
-    // Parent components need more work because they do not appear in the
-    // fir.rec type.
-    if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp))
-      TODO(loc, "parent component in structure constructor");
-
-    std::string name = converter.getRecordTypeFieldName(sym);
-    mlir::Type componentTy = recTy.getType(name);
-    assert(componentTy && "failed to retrieve component");
-    // FIXME: type parameters must come from the derived-type-spec
-    auto field = builder.create<fir::FieldIndexOp>(
-        loc, fieldTy, name, type,
-        /*typeParams=*/mlir::ValueRange{} /*TODO*/);
 
-    if (Fortran::semantics::IsAllocatable(sym))
-      TODO(loc, "allocatable component in structure constructor");
+  if (!converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+    mlir::Value res = builder.create<fir::UndefOp>(loc, recTy);
+    for (const auto &[sym, expr] : ctor.values()) {
+      // Parent components need more work because they do not appear in the
+      // fir.rec type.
+      if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp))
+        TODO(loc, "parent component in structure constructor");
+      res = genStructureComponentInit(converter, loc, sym, expr.value(), res);
+    }
+    return res;
+  }
 
-    if (Fortran::semantics::IsPointer(sym)) {
-      mlir::Value initialTarget = Fortran::lower::genInitialDataTarget(
-          converter, loc, componentTy, expr.value());
+  auto fieldTy = fir::FieldType::get(recTy.getContext());
+  mlir::Value res{};
+  // When the first structure component values belong to some parent type PT
+  // and the next values belong to a type extension ET, a new undef for ET must
+  // be created and the previous PT value inserted into it. There may
+  // be empty parent types in between ET and PT, hence the list and while loop.
+  auto insertParentValueIntoExtension = [&](mlir::Type typeExtension) {
+    assert(res && "res must be set");
+    llvm::SmallVector<mlir::Type> parentTypes = {typeExtension};
+    while (true) {
+      fir::RecordType last = mlir::cast<fir::RecordType>(parentTypes.back());
+      mlir::Type next =
+          last.getType(0); // parent components are first in HLFIR.
+      if (next != res.getType())
+        parentTypes.push_back(next);
+      else
+        break;
+    }
+    for (mlir::Type parentType : llvm::reverse(parentTypes)) {
+      auto undef = builder.create<fir::UndefOp>(loc, parentType);
+      fir::RecordType parentRecTy = mlir::cast<fir::RecordType>(parentType);
+      auto field = builder.create<fir::FieldIndexOp>(
+          loc, fieldTy, parentRecTy.getTypeList()[0].first, parentType,
+          /*typeParams=*/mlir::ValueRange{} /*TODO*/);
       res = builder.create<fir::InsertValueOp>(
-          loc, recTy, res, initialTarget,
+          loc, parentRecTy, undef, res,
           builder.getArrayAttr(field.getAttributes()));
-      continue;
     }
+  };
 
-    if (Fortran::lower::isDerivedTypeWithLenParameters(sym))
-      TODO(loc, "component with length parameters in structure constructor");
-
-    // Special handling for scalar c_ptr/c_funptr constants. The array constant
-    // must fall through to genConstantValue() below.
-    if (Fortran::semantics::IsBuiltinCPtr(sym) && sym->Rank() == 0 &&
-        (Fortran::evaluate::GetLastSymbol(expr.value()) ||
-         Fortran::evaluate::IsNullPointer(expr.value()))) {
-      // Builtin c_ptr and c_funptr have special handling because designators
-      // and NULL() are handled as initial values for them as an extension
-      // (otherwise only c_ptr_null/c_funptr_null are allowed and these are
-      // replaced by structure constructors by semantics, so GetLastSymbol
-      // returns nothing).
-
-      // The Ev::Expr is an initializer that is a pointer target (e.g., 'x' or
-      // NULL()) that must be inserted into an intermediate cptr record value's
-      // address field, which ought to be an intptr_t on the target.
-      mlir::Value addr = fir::getBase(Fortran::lower::genExtAddrInInitializer(
-          converter, loc, expr.value()));
-      if (addr.getType().isa<fir::BoxProcType>())
-        addr = builder.create<fir::BoxAddrOp>(loc, addr);
-      assert((fir::isa_ref_type(addr.getType()) ||
-              addr.getType().isa<mlir::FunctionType>()) &&
-             "expect reference type for address field");
-      assert(fir::isa_derived(componentTy) &&
-             "expect C_PTR, C_FUNPTR to be a record");
-      auto cPtrRecTy = componentTy.cast<fir::RecordType>();
-      llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName;
-      mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName);
-      auto addrField = builder.create<fir::FieldIndexOp>(
-          loc, fieldTy, addrFieldName, componentTy,
-          /*typeParams=*/mlir::ValueRange{});
-      mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr);
-      auto undef = builder.create<fir::UndefOp>(loc, componentTy);
-      addr = builder.create<fir::InsertValueOp>(
-          loc, componentTy, undef, castAddr,
-          builder.getArrayAttr(addrField.getAttributes()));
-      res = builder.create<fir::InsertValueOp>(
-          loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes()));
-      continue;
+  const Fortran::semantics::DerivedTypeSpec *curentType = nullptr;
+  for (const auto &[sym, expr] : ctor.values()) {
+    // This TODO is not needed here anymore, but should be removed in a separate
+    // patch.
+    if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp))
+      TODO(loc, "parent component in structure constructor");
+    const Fortran::semantics::DerivedTypeSpec *componentParentType =
+        sym->owner().derivedTypeSpec();
+    assert(componentParentType && "failed to retrieve component parent type");
+    if (!res) {
+      mlir::Type parentType = converter.genType(*componentParentType);
+      curentType = componentParentType;
+      res = builder.create<fir::UndefOp>(loc, parentType);
+    } else if (*componentParentType != *curentType) {
+      mlir::Type parentType = converter.genType(*componentParentType);
+      insertParentValueIntoExtension(parentType);
+      curentType = componentParentType;
     }
-
-    mlir::Value val =
-        fir::getBase(genConstantValue(converter, loc, expr.value()));
-    assert(!fir::isa_ref_type(val.getType()) && "expecting a constant value");
-    mlir::Value castVal = builder.createConvert(loc, componentTy, val);
-    res = builder.create<fir::InsertValueOp>(
-        loc, recTy, res, castVal, builder.getArrayAttr(field.getAttributes()));
+    res = genStructureComponentInit(converter, loc, sym, expr.value(), res);
   }
+
+  if (!res) // structure constructor for empty type.
+    return builder.create<fir::UndefOp>(loc, recTy);
+
+  // The last component may belong to a parent type.
+  if (res.getType() != recTy)
+    insertParentValueIntoExtension(recTy);
   return res;
 }