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 ¶m : 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> ¶ms, 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 = ¤tParentType->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, ) 679