flang/lib/Lower/ConvertType.cpp

   1 //===-- ConvertType.cpp ---------------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "flang/Lower/ConvertType.h"
  10 #include "flang/Lower/AbstractConverter.h"
  11 #include "flang/Lower/CallInterface.h"
  12 #include "flang/Lower/ConvertVariable.h"
  13 #include "flang/Lower/Mangler.h"
  14 #include "flang/Lower/PFTBuilder.h"
  15 #include "flang/Lower/Support/Utils.h"
  16 #include "flang/Optimizer/Builder/Todo.h"
  17 #include "flang/Optimizer/Dialect/FIRType.h"
  18 #include "flang/Semantics/tools.h"
  19 #include "flang/Semantics/type.h"
  20 #include "mlir/IR/Builders.h"
  21 #include "mlir/IR/BuiltinTypes.h"
  22 #include "llvm/Support/Debug.h"
  23 #include "llvm/TargetParser/Host.h"
  24 #include "llvm/TargetParser/Triple.h"
  25
  26 #define DEBUG_TYPE "flang-lower-type"
  27
  28 using Fortran::common::VectorElementCategory;
  29
  30 //===--------------------------------------------------------------------===//
  31 // Intrinsic type translation helpers
  32 //===--------------------------------------------------------------------===//
  33
  34 static mlir::Type genRealType(mlir::MLIRContext *context, int kind) {
  35   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
  36           Fortran::common::TypeCategory::Real, kind)) {
  37     switch (kind) {
  38     case 2:
  39       return mlir::Float16Type::get(context);
  40     case 3:
  41       return mlir::BFloat16Type::get(context);
  42     case 4:
  43       return mlir::Float32Type::get(context);
  44     case 8:
  45       return mlir::Float64Type::get(context);
  46     case 10:
  47       return mlir::Float80Type::get(context);
  48     case 16:
  49       return mlir::Float128Type::get(context);
  50     }
  51   }
  52   llvm_unreachable("REAL type translation not implemented");
  53 }
  54
  55 template <int KIND>
  56 int getIntegerBits() {
  57   return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
  58                                  KIND>::Scalar::bits;
  59 }
  60 static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind,
  61                                  bool isUnsigned = false) {
  62   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
  63           Fortran::common::TypeCategory::Integer, kind)) {
  64     mlir::IntegerType::SignednessSemantics signedness =
  65         (isUnsigned ? mlir::IntegerType::SignednessSemantics::Unsigned
  66                     : mlir::IntegerType::SignednessSemantics::Signless);
  67
  68     switch (kind) {
  69     case 1:
  70       return mlir::IntegerType::get(context, getIntegerBits<1>(), signedness);
  71     case 2:
  72       return mlir::IntegerType::get(context, getIntegerBits<2>(), signedness);
  73     case 4:
  74       return mlir::IntegerType::get(context, getIntegerBits<4>(), signedness);
  75     case 8:
  76       return mlir::IntegerType::get(context, getIntegerBits<8>(), signedness);
  77     case 16:
  78       return mlir::IntegerType::get(context, getIntegerBits<16>(), signedness);
  79     }
  80   }
  81   llvm_unreachable("INTEGER or UNSIGNED kind not translated");
  82 }
  83
  84 static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) {
  85   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
  86           Fortran::common::TypeCategory::Logical, KIND))
  87     return fir::LogicalType::get(context, KIND);
  88   return {};
  89 }
  90
  91 static mlir::Type genCharacterType(
  92     mlir::MLIRContext *context, int KIND,
  93     Fortran::lower::LenParameterTy len = fir::CharacterType::unknownLen()) {
  94   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
  95           Fortran::common::TypeCategory::Character, KIND))
  96     return fir::CharacterType::get(context, KIND, len);
  97   return {};
  98 }
  99
 100 static mlir::Type genComplexType(mlir::MLIRContext *context, int KIND) {
 101   return mlir::ComplexType::get(genRealType(context, KIND));
 102 }
 103
 104 static mlir::Type
 105 genFIRType(mlir::MLIRContext *context, Fortran::common::TypeCategory tc,
 106            int kind,
 107            llvm::ArrayRef<Fortran::lower::LenParameterTy> lenParameters) {
 108   switch (tc) {
 109   case Fortran::common::TypeCategory::Real:
 110     return genRealType(context, kind);
 111   case Fortran::common::TypeCategory::Integer:
 112     return genIntegerType(context, kind, false);
 113   case Fortran::common::TypeCategory::Unsigned:
 114     return genIntegerType(context, kind, true);
 115   case Fortran::common::TypeCategory::Complex:
 116     return genComplexType(context, kind);
 117   case Fortran::common::TypeCategory::Logical:
 118     return genLogicalType(context, kind);
 119   case Fortran::common::TypeCategory::Character:
 120     if (!lenParameters.empty())
 121       return genCharacterType(context, kind, lenParameters[0]);
 122     return genCharacterType(context, kind);
 123   default:
 124     break;
 125   }
 126   llvm_unreachable("unhandled type category");
 127 }
 128
 129 //===--------------------------------------------------------------------===//
 130 // Symbol and expression type translation
 131 //===--------------------------------------------------------------------===//
 132
 133 /// TypeBuilderImpl translates expression and symbol type taking into account
 134 /// their shape and length parameters. For symbols, attributes such as
 135 /// ALLOCATABLE or POINTER are reflected in the fir type.
 136 /// It uses evaluate::DynamicType and evaluate::Shape when possible to
 137 /// avoid re-implementing type/shape analysis here.
 138 /// Do not use the FirOpBuilder from the AbstractConverter to get fir/mlir types
 139 /// since it is not guaranteed to exist yet when we lower types.
 140 namespace {
 141 struct TypeBuilderImpl {
 142
 143   TypeBuilderImpl(Fortran::lower::AbstractConverter &converter)
 144       : derivedTypeInConstruction{converter.getTypeConstructionStack()},
 145         converter{converter}, context{&converter.getMLIRContext()} {}
 146
 147   template <typename A>
 148   mlir::Type genExprType(const A &expr) {
 149     std::optional<Fortran::evaluate::DynamicType> dynamicType = expr.GetType();
 150     if (!dynamicType)
 151       return genTypelessExprType(expr);
 152     Fortran::common::TypeCategory category = dynamicType->category();
 153
 154     mlir::Type baseType;
 155     bool isPolymorphic = (dynamicType->IsPolymorphic() ||
 156                           dynamicType->IsUnlimitedPolymorphic()) &&
 157                          !dynamicType->IsAssumedType();
 158     if (dynamicType->IsUnlimitedPolymorphic()) {
 159       baseType = mlir::NoneType::get(context);
 160     } else if (category == Fortran::common::TypeCategory::Derived) {
 161       baseType = genDerivedType(dynamicType->GetDerivedTypeSpec());
 162     } else {
 163       // INTEGER, UNSIGNED, REAL, COMPLEX, CHARACTER, LOGICAL
 164       llvm::SmallVector<Fortran::lower::LenParameterTy> params;
 165       translateLenParameters(params, category, expr);
 166       baseType = genFIRType(context, category, dynamicType->kind(), params);
 167     }
 168     std::optional<Fortran::evaluate::Shape> shapeExpr =
 169         Fortran::evaluate::GetShape(converter.getFoldingContext(), expr);
 170     fir::SequenceType::Shape shape;
 171     if (shapeExpr) {
 172       translateShape(shape, std::move(*shapeExpr));
 173     } else {
 174       // Shape static analysis cannot return something useful for the shape.
 175       // Use unknown extents.
 176       int rank = expr.Rank();
 177       if (rank < 0)
 178         TODO(converter.getCurrentLocation(), "assumed rank expression types");
 179       for (int dim = 0; dim < rank; ++dim)
 180         shape.emplace_back(fir::SequenceType::getUnknownExtent());
 181     }
 182
 183     if (!shape.empty()) {
 184       if (isPolymorphic)
 185         return fir::ClassType::get(fir::SequenceType::get(shape, baseType));
 186       return fir::SequenceType::get(shape, baseType);
 187     }
 188     if (isPolymorphic)
 189       return fir::ClassType::get(baseType);
 190     return baseType;
 191   }
 192
 193   template <typename A>
 194   void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) {
 195     for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) {
 196       fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent();
 197       if (std::optional<std::int64_t> constantExtent =
 198               toInt64(std::move(extentExpr)))
 199         extent = *constantExtent;
 200       shape.push_back(extent);
 201     }
 202   }
 203
 204   template <typename A>
 205   std::optional<std::int64_t> toInt64(A &&expr) {
 206     return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
 207         converter.getFoldingContext(), std::move(expr)));
 208   }
 209
 210   template <typename A>
 211   mlir::Type genTypelessExprType(const A &expr) {
 212     fir::emitFatalError(converter.getCurrentLocation(), "not a typeless expr");
 213   }
 214
 215   mlir::Type genTypelessExprType(const Fortran::lower::SomeExpr &expr) {
 216     return Fortran::common::visit(
 217         Fortran::common::visitors{
 218             [&](const Fortran::evaluate::BOZLiteralConstant &) -> mlir::Type {
 219               return mlir::NoneType::get(context);
 220             },
 221             [&](const Fortran::evaluate::NullPointer &) -> mlir::Type {
 222               return fir::ReferenceType::get(mlir::NoneType::get(context));
 223             },
 224             [&](const Fortran::evaluate::ProcedureDesignator &proc)
 225                 -> mlir::Type {
 226               return Fortran::lower::translateSignature(proc, converter);
 227             },
 228             [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type {
 229               return mlir::NoneType::get(context);
 230             },
 231             [](const auto &x) -> mlir::Type {
 232               using T = std::decay_t<decltype(x)>;
 233               static_assert(!Fortran::common::HasMember<
 234                                 T, Fortran::evaluate::TypelessExpression>,
 235                             "missing typeless expr handling");
 236               llvm::report_fatal_error("not a typeless expression");
 237             },
 238         },
 239         expr.u);
 240   }
 241
 242   mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
 243                            bool isAlloc = false, bool isPtr = false) {
 244     mlir::Location loc = converter.genLocation(symbol.name());
 245     mlir::Type ty;
 246     // If the symbol is not the same as the ultimate one (i.e, it is host or use
 247     // associated), all the symbol properties are the ones of the ultimate
 248     // symbol but the volatile and asynchronous attributes that may differ. To
 249     // avoid issues with helper functions that would not follow association
 250     // links, the fir type is built based on the ultimate symbol. This relies
 251     // on the fact volatile and asynchronous are not reflected in fir types.
 252     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
 253
 254     if (Fortran::semantics::IsProcedurePointer(ultimate)) {
 255       Fortran::evaluate::ProcedureDesignator proc(ultimate);
 256       auto procTy{Fortran::lower::translateSignature(proc, converter)};
 257       return fir::BoxProcType::get(context, procTy);
 258     }
 259
 260     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
 261       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
 262               type->AsIntrinsic()) {
 263         int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
 264         llvm::SmallVector<Fortran::lower::LenParameterTy> params;
 265         translateLenParameters(params, tySpec->category(), ultimate);
 266         ty = genFIRType(context, tySpec->category(), kind, params);
 267       } else if (type->IsUnlimitedPolymorphic()) {
 268         ty = mlir::NoneType::get(context);
 269       } else if (const Fortran::semantics::DerivedTypeSpec *tySpec =
 270                      type->AsDerived()) {
 271         ty = genDerivedType(*tySpec);
 272       } else {
 273         fir::emitFatalError(loc, "symbol's type must have a type spec");
 274       }
 275     } else {
 276       fir::emitFatalError(loc, "symbol must have a type");
 277     }
 278     bool isPolymorphic = (Fortran::semantics::IsPolymorphic(symbol) ||
 279                           Fortran::semantics::IsUnlimitedPolymorphic(symbol)) &&
 280                          !Fortran::semantics::IsAssumedType(symbol);
 281     if (ultimate.IsObjectArray()) {
 282       auto shapeExpr =
 283           Fortran::evaluate::GetShape(converter.getFoldingContext(), ultimate);
 284       fir::SequenceType::Shape shape;
 285       // If there is no shapExpr, this is an assumed-rank, and the empty shape
 286       // will build the desired fir.array<*:T> type.
 287       if (shapeExpr)
 288         translateShape(shape, std::move(*shapeExpr));
 289       ty = fir::SequenceType::get(shape, ty);
 290     }
 291     if (Fortran::semantics::IsPointer(symbol))
 292       return fir::wrapInClassOrBoxType(fir::PointerType::get(ty),
 293                                        isPolymorphic);
 294     if (Fortran::semantics::IsAllocatable(symbol))
 295       return fir::wrapInClassOrBoxType(fir::HeapType::get(ty), isPolymorphic);
 296     // isPtr and isAlloc are variable that were promoted to be on the
 297     // heap or to be pointers, but they do not have Fortran allocatable
 298     // or pointer semantics, so do not use box for them.
 299     if (isPtr)
 300       return fir::PointerType::get(ty);
 301     if (isAlloc)
 302       return fir::HeapType::get(ty);
 303     if (isPolymorphic)
 304       return fir::ClassType::get(ty);
 305     return ty;
 306   }
 307
 308   /// Does \p component has non deferred lower bounds that are not compile time
 309   /// constant 1.
 310   static bool componentHasNonDefaultLowerBounds(
 311       const Fortran::semantics::Symbol &component) {
 312     if (const auto *objDetails =
 313             component.detailsIf<Fortran::semantics::ObjectEntityDetails>())
 314       for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
 315         if (auto lb = bounds.lbound().GetExplicit())
 316           if (auto constant = Fortran::evaluate::ToInt64(*lb))
 317             if (!constant || *constant != 1)
 318               return true;
 319     return false;
 320   }
 321
 322   mlir::Type genVectorType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
 323     assert(tySpec.scope() && "Missing scope for Vector type");
 324     auto vectorSize{tySpec.scope()->size()};
 325     switch (tySpec.category()) {
 326       SWITCH_COVERS_ALL_CASES
 327     case (Fortran::semantics::DerivedTypeSpec::Category::IntrinsicVector): {
 328       int64_t vecElemKind;
 329       int64_t vecElemCategory;
 330
 331       for (const auto &pair : tySpec.parameters()) {
 332         if (pair.first == "element_category") {
 333           vecElemCategory =
 334               Fortran::evaluate::ToInt64(pair.second.GetExplicit())
 335                   .value_or(-1);
 336         } else if (pair.first == "element_kind") {
 337           vecElemKind =
 338               Fortran::evaluate::ToInt64(pair.second.GetExplicit()).value_or(0);
 339         }
 340       }
 341
 342       assert((vecElemCategory >= 0 &&
 343               static_cast<size_t>(vecElemCategory) <
 344                   Fortran::common::VectorElementCategory_enumSize) &&
 345              "Vector element type is not specified");
 346       assert(vecElemKind && "Vector element kind is not specified");
 347
 348       int64_t numOfElements = vectorSize / vecElemKind;
 349       switch (static_cast<VectorElementCategory>(vecElemCategory)) {
 350         SWITCH_COVERS_ALL_CASES
 351       case VectorElementCategory::Integer:
 352         return fir::VectorType::get(numOfElements,
 353                                     genIntegerType(context, vecElemKind));
 354       case VectorElementCategory::Unsigned:
 355         return fir::VectorType::get(numOfElements,
 356                                     genIntegerType(context, vecElemKind, true));
 357       case VectorElementCategory::Real:
 358         return fir::VectorType::get(numOfElements,
 359                                     genRealType(context, vecElemKind));
 360       }
 361       break;
 362     }
 363     case (Fortran::semantics::DerivedTypeSpec::Category::PairVector):
 364     case (Fortran::semantics::DerivedTypeSpec::Category::QuadVector):
 365       return fir::VectorType::get(vectorSize * 8,
 366                                   mlir::IntegerType::get(context, 1));
 367     case (Fortran::semantics::DerivedTypeSpec::Category::DerivedType):
 368       Fortran::common::die("Vector element type not implemented");
 369     }
 370   }
 371
 372   mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
 373     std::vector<std::pair<std::string, mlir::Type>> ps;
 374     std::vector<std::pair<std::string, mlir::Type>> cs;
 375     if (tySpec.IsVectorType()) {
 376       return genVectorType(tySpec);
 377     }
 378
 379     const Fortran::semantics::Symbol &typeSymbol = tySpec.typeSymbol();
 380     const Fortran::semantics::Scope &derivedScope = DEREF(tySpec.GetScope());
 381     if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(derivedScope))
 382       return ty;
 383
 384     auto rec = fir::RecordType::get(context, converter.mangleName(tySpec));
 385     // Maintain the stack of types for recursive references and to speed-up
 386     // the derived type constructions that can be expensive for derived type
 387     // with dozens of components/parents (modern Fortran).
 388     derivedTypeInConstruction.try_emplace(&derivedScope, rec);
 389
 390     auto targetTriple{llvm::Triple(
 391         llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))};
 392     // Always generate packed FIR struct type for bind(c) derived type for AIX
 393     if (targetTriple.getOS() == llvm::Triple::OSType::AIX &&
 394         tySpec.typeSymbol().attrs().test(Fortran::semantics::Attr::BIND_C) &&
 395         !IsIsoCType(&tySpec) && !fir::isa_builtin_cdevptr_type(rec)) {
 396       rec.pack(true);
 397     }
 398
 399     // Gather the record type fields.
 400     // (1) The data components.
 401     if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
 402       size_t prev_offset{0};
 403       unsigned padCounter{0};
 404       // In HLFIR the parent component is the first fir.type component.
 405       for (const auto &componentName :
 406            typeSymbol.get<Fortran::semantics::DerivedTypeDetails>()
 407                .componentNames()) {
 408         auto scopeIter = derivedScope.find(componentName);
 409         assert(scopeIter != derivedScope.cend() &&
 410                "failed to find derived type component symbol");
 411         const Fortran::semantics::Symbol &component = scopeIter->second.get();
 412         mlir::Type ty = genSymbolType(component);
 413         if (rec.isPacked()) {
 414           auto compSize{component.size()};
 415           auto compOffset{component.offset()};
 416
 417           if (prev_offset < compOffset) {
 418             size_t pad{compOffset - prev_offset};
 419             mlir::Type i8Ty{mlir::IntegerType::get(context, 8)};
 420             fir::SequenceType::Shape shape{static_cast<int64_t>(pad)};
 421             mlir::Type padTy{fir::SequenceType::get(shape, i8Ty)};
 422             prev_offset += pad;
 423             cs.emplace_back("__padding" + std::to_string(padCounter++), padTy);
 424           }
 425           prev_offset += compSize;
 426         }
 427         cs.emplace_back(converter.getRecordTypeFieldName(component), ty);
 428         if (rec.isPacked()) {
 429           // For the last component, determine if any padding is needed.
 430           if (componentName ==
 431               typeSymbol.get<Fortran::semantics::DerivedTypeDetails>()
 432                   .componentNames()
 433                   .back()) {
 434             auto compEnd{component.offset() + component.size()};
 435             if (compEnd < derivedScope.size()) {
 436               size_t pad{derivedScope.size() - compEnd};
 437               mlir::Type i8Ty{mlir::IntegerType::get(context, 8)};
 438               fir::SequenceType::Shape shape{static_cast<int64_t>(pad)};
 439               mlir::Type padTy{fir::SequenceType::get(shape, i8Ty)};
 440               cs.emplace_back("__padding" + std::to_string(padCounter++),
 441                               padTy);
 442             }
 443           }
 444         }
 445       }
 446     } else {
 447       for (const auto &component :
 448            Fortran::semantics::OrderedComponentIterator(tySpec)) {
 449         // In the lowering to FIR the parent component does not appear in the
 450         // fir.type and its components are inlined at the beginning of the
 451         // fir.type<>.
 452         // FIXME: this strategy leads to bugs because padding should be inserted
 453         // after the component of the parents so that the next components do not
 454         // end-up in the parent storage if the sum of the parent's component
 455         // storage size is not a multiple of the parent type storage alignment.
 456
 457         // Lowering is assuming non deferred component lower bounds are
 458         // always 1. Catch any situations where this is not true for now.
 459         if (componentHasNonDefaultLowerBounds(component))
 460           TODO(converter.genLocation(component.name()),
 461                "derived type components with non default lower bounds");
 462         if (IsProcedure(component))
 463           TODO(converter.genLocation(component.name()), "procedure components");
 464         mlir::Type ty = genSymbolType(component);
 465         // Do not add the parent component (component of the parents are
 466         // added and should be sufficient, the parent component would
 467         // duplicate the fields). Note that genSymbolType must be called above
 468         // on it so that the dispatch table for the parent type still gets
 469         // emitted as needed.
 470         if (component.test(Fortran::semantics::Symbol::Flag::ParentComp))
 471           continue;
 472         cs.emplace_back(converter.getRecordTypeFieldName(component), ty);
 473       }
 474     }
 475
 476     mlir::Location loc = converter.genLocation(typeSymbol.name());
 477     // (2) The LEN type parameters.
 478     for (const auto &param :
 479          Fortran::semantics::OrderParameterDeclarations(typeSymbol))
 480       if (param->get<Fortran::semantics::TypeParamDetails>().attr() ==
 481           Fortran::common::TypeParamAttr::Len) {
 482         TODO(loc, "parameterized derived types");
 483         // TODO: emplace in ps. Beware that param is the symbol in the type
 484         // declaration, not instantiation: its kind may not be a constant.
 485         // The instantiated symbol in tySpec.scope should be used instead.
 486         ps.emplace_back(param->name().ToString(), genSymbolType(*param));
 487       }
 488
 489     rec.finalize(ps, cs);
 490
 491     if (!ps.empty()) {
 492       // TODO: this type is a PDT (parametric derived type) with length
 493       // parameter. Create the functions to use for allocation, dereferencing,
 494       // and address arithmetic here.
 495     }
 496     LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n');
 497
 498     // Generate the type descriptor object if any
 499     if (const Fortran::semantics::Symbol *typeInfoSym =
 500             derivedScope.runtimeDerivedTypeDescription())
 501       converter.registerTypeInfo(loc, *typeInfoSym, tySpec, rec);
 502     return rec;
 503   }
 504
 505   // To get the character length from a symbol, make an fold a designator for
 506   // the symbol to cover the case where the symbol is an assumed length named
 507   // constant and its length comes from its init expression length.
 508   template <int Kind>
 509   fir::SequenceType::Extent
 510   getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) {
 511     using TC =
 512         Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;
 513     auto designator = Fortran::evaluate::Fold(
 514         converter.getFoldingContext(),
 515         Fortran::evaluate::Expr<TC>{Fortran::evaluate::Designator<TC>{symbol}});
 516     if (auto len = toInt64(std::move(designator.LEN())))
 517       return *len;
 518     return fir::SequenceType::getUnknownExtent();
 519   }
 520
 521   template <typename T>
 522   void translateLenParameters(
 523       llvm::SmallVectorImpl<Fortran::lower::LenParameterTy> &params,
 524       Fortran::common::TypeCategory category, const T &exprOrSym) {
 525     if (category == Fortran::common::TypeCategory::Character)
 526       params.push_back(getCharacterLength(exprOrSym));
 527     else if (category == Fortran::common::TypeCategory::Derived)
 528       TODO(converter.getCurrentLocation(), "derived type length parameters");
 529   }
 530   Fortran::lower::LenParameterTy
 531   getCharacterLength(const Fortran::semantics::Symbol &symbol) {
 532     const Fortran::semantics::DeclTypeSpec *type = symbol.GetType();
 533     if (!type ||
 534         type->category() != Fortran::semantics::DeclTypeSpec::Character ||
 535         !type->AsIntrinsic())
 536       llvm::report_fatal_error("not a character symbol");
 537     int kind =
 538         toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value();
 539     switch (kind) {
 540     case 1:
 541       return getCharacterLengthHelper<1>(symbol);
 542     case 2:
 543       return getCharacterLengthHelper<2>(symbol);
 544     case 4:
 545       return getCharacterLengthHelper<4>(symbol);
 546     }
 547     llvm_unreachable("unknown character kind");
 548   }
 549
 550   template <typename A>
 551   Fortran::lower::LenParameterTy getCharacterLength(const A &expr) {
 552     return fir::SequenceType::getUnknownExtent();
 553   }
 554
 555   template <typename T>
 556   Fortran::lower::LenParameterTy
 557   getCharacterLength(const Fortran::evaluate::FunctionRef<T> &funcRef) {
 558     if (auto constantLen = toInt64(funcRef.LEN()))
 559       return *constantLen;
 560     return fir::SequenceType::getUnknownExtent();
 561   }
 562
 563   Fortran::lower::LenParameterTy
 564   getCharacterLength(const Fortran::lower::SomeExpr &expr) {
 565     // Do not use dynamic type length here. We would miss constant
 566     // lengths opportunities because dynamic type only has the length
 567     // if it comes from a declaration.
 568     if (const auto *charExpr = std::get_if<
 569             Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(
 570             &expr.u)) {
 571       if (auto constantLen = toInt64(charExpr->LEN()))
 572         return *constantLen;
 573     } else if (auto dynamicType = expr.GetType()) {
 574       // When generating derived type type descriptor as structure constructor,
 575       // semantics wraps designators to data component initialization into
 576       // CLASS(*), regardless of their actual type.
 577       // GetType() will recover the actual symbol type as the dynamic type, so
 578       // getCharacterLength may be reached even if expr is packaged as an
 579       // Expr<SomeDerived> instead of an Expr<SomeChar>.
 580       // Just use the dynamic type here again to retrieve the length.
 581       if (auto constantLen = toInt64(dynamicType->GetCharLength()))
 582         return *constantLen;
 583     }
 584     return fir::SequenceType::getUnknownExtent();
 585   }
 586
 587   mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
 588     return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
 589   }
 590
 591   /// Derived type can be recursive. That is, pointer components of a derived
 592   /// type `t` have type `t`. This helper returns `t` if it is already being
 593   /// lowered to avoid infinite loops.
 594   mlir::Type getTypeIfDerivedAlreadyInConstruction(
 595       const Fortran::semantics::Scope &derivedScope) const {
 596     return derivedTypeInConstruction.lookup(&derivedScope);
 597   }
 598
 599   /// Stack derived type being processed to avoid infinite loops in case of
 600   /// recursive derived types. The depth of derived types is expected to be
 601   /// shallow (<10), so a SmallVector is sufficient.
 602   Fortran::lower::TypeConstructionStack &derivedTypeInConstruction;
 603   Fortran::lower::AbstractConverter &converter;
 604   mlir::MLIRContext *context;
 605 };
 606 } // namespace
 607
 608 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
 609                                       Fortran::common::TypeCategory tc,
 610                                       int kind,
 611                                       llvm::ArrayRef<LenParameterTy> params) {
 612   return genFIRType(context, tc, kind, params);
 613 }
 614
 615 mlir::Type Fortran::lower::translateDerivedTypeToFIRType(
 616     Fortran::lower::AbstractConverter &converter,
 617     const Fortran::semantics::DerivedTypeSpec &tySpec) {
 618   return TypeBuilderImpl{converter}.genDerivedType(tySpec);
 619 }
 620
 621 mlir::Type Fortran::lower::translateSomeExprToFIRType(
 622     Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
 623   return TypeBuilderImpl{converter}.genExprType(expr);
 624 }
 625
 626 mlir::Type Fortran::lower::translateSymbolToFIRType(
 627     Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
 628   return TypeBuilderImpl{converter}.genSymbolType(symbol);
 629 }
 630
 631 mlir::Type Fortran::lower::translateVariableToFIRType(
 632     Fortran::lower::AbstractConverter &converter,
 633     const Fortran::lower::pft::Variable &var) {
 634   return TypeBuilderImpl{converter}.genVariableType(var);
 635 }
 636
 637 mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) {
 638   return genRealType(context, kind);
 639 }
 640
 641 bool Fortran::lower::isDerivedTypeWithLenParameters(
 642     const Fortran::semantics::Symbol &sym) {
 643   if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType())
 644     if (const Fortran::semantics::DerivedTypeSpec *derived =
 645             declTy->AsDerived())
 646       return Fortran::semantics::CountLenParameters(*derived) > 0;
 647   return false;
 648 }
 649
 650 template <typename T>
 651 mlir::Type Fortran::lower::TypeBuilder<T>::genType(
 652     Fortran::lower::AbstractConverter &converter,
 653     const Fortran::evaluate::FunctionRef<T> &funcRef) {
 654   return TypeBuilderImpl{converter}.genExprType(funcRef);
 655 }
 656
 657 const Fortran::semantics::DerivedTypeSpec &
 658 Fortran::lower::ComponentReverseIterator::advanceToParentType() {
 659   const Fortran::semantics::Scope *scope = currentParentType->GetScope();
 660   auto parentComp =
 661       DEREF(scope).find(currentTypeDetails->GetParentComponentName().value());
 662   assert(parentComp != scope->cend() && "failed to get parent component");
 663   setCurrentType(parentComp->second->GetType()->derivedTypeSpec());
 664   return *currentParentType;
 665 }
 666
 667 void Fortran::lower::ComponentReverseIterator::setCurrentType(
 668     const Fortran::semantics::DerivedTypeSpec &derived) {
 669   currentParentType = &derived;
 670   currentTypeDetails = &currentParentType->typeSymbol()
 671                             .get<Fortran::semantics::DerivedTypeDetails>();
 672   componentIt = currentTypeDetails->componentNames().crbegin();
 673   componentItEnd = currentTypeDetails->componentNames().crend();
 674 }
 675
 676 using namespace Fortran::evaluate;
 677 using namespace Fortran::common;
 678 FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::TypeBuilder, )