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 24 #define DEBUG_TYPE "flang-lower-type" 25 26 //===--------------------------------------------------------------------===// 27 // Intrinsic type translation helpers 28 //===--------------------------------------------------------------------===// 29 30 static mlir::Type genRealType(mlir::MLIRContext *context, int kind) { 31 if (Fortran::evaluate::IsValidKindOfIntrinsicType( 32 Fortran::common::TypeCategory::Real, kind)) { 33 switch (kind) { 34 case 2: 35 return mlir::FloatType::getF16(context); 36 case 3: 37 return mlir::FloatType::getBF16(context); 38 case 4: 39 return mlir::FloatType::getF32(context); 40 case 8: 41 return mlir::FloatType::getF64(context); 42 case 10: 43 return mlir::FloatType::getF80(context); 44 case 16: 45 return mlir::FloatType::getF128(context); 46 } 47 } 48 llvm_unreachable("REAL type translation not implemented"); 49 } 50 51 template <int KIND> 52 int getIntegerBits() { 53 return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 54 KIND>::Scalar::bits; 55 } 56 static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind) { 57 if (Fortran::evaluate::IsValidKindOfIntrinsicType( 58 Fortran::common::TypeCategory::Integer, kind)) { 59 switch (kind) { 60 case 1: 61 return mlir::IntegerType::get(context, getIntegerBits<1>()); 62 case 2: 63 return mlir::IntegerType::get(context, getIntegerBits<2>()); 64 case 4: 65 return mlir::IntegerType::get(context, getIntegerBits<4>()); 66 case 8: 67 return mlir::IntegerType::get(context, getIntegerBits<8>()); 68 case 16: 69 return mlir::IntegerType::get(context, getIntegerBits<16>()); 70 } 71 } 72 llvm_unreachable("INTEGER kind not translated"); 73 } 74 75 static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) { 76 if (Fortran::evaluate::IsValidKindOfIntrinsicType( 77 Fortran::common::TypeCategory::Logical, KIND)) 78 return fir::LogicalType::get(context, KIND); 79 return {}; 80 } 81 82 static mlir::Type genCharacterType( 83 mlir::MLIRContext *context, int KIND, 84 Fortran::lower::LenParameterTy len = fir::CharacterType::unknownLen()) { 85 if (Fortran::evaluate::IsValidKindOfIntrinsicType( 86 Fortran::common::TypeCategory::Character, KIND)) 87 return fir::CharacterType::get(context, KIND, len); 88 return {}; 89 } 90 91 static mlir::Type genComplexType(mlir::MLIRContext *context, int KIND) { 92 if (Fortran::evaluate::IsValidKindOfIntrinsicType( 93 Fortran::common::TypeCategory::Complex, KIND)) 94 return fir::ComplexType::get(context, KIND); 95 return {}; 96 } 97 98 static mlir::Type 99 genFIRType(mlir::MLIRContext *context, Fortran::common::TypeCategory tc, 100 int kind, 101 llvm::ArrayRef<Fortran::lower::LenParameterTy> lenParameters) { 102 switch (tc) { 103 case Fortran::common::TypeCategory::Real: 104 return genRealType(context, kind); 105 case Fortran::common::TypeCategory::Integer: 106 return genIntegerType(context, kind); 107 case Fortran::common::TypeCategory::Complex: 108 return genComplexType(context, kind); 109 case Fortran::common::TypeCategory::Logical: 110 return genLogicalType(context, kind); 111 case Fortran::common::TypeCategory::Character: 112 if (!lenParameters.empty()) 113 return genCharacterType(context, kind, lenParameters[0]); 114 return genCharacterType(context, kind); 115 default: 116 break; 117 } 118 llvm_unreachable("unhandled type category"); 119 } 120 121 //===--------------------------------------------------------------------===// 122 // Symbol and expression type translation 123 //===--------------------------------------------------------------------===// 124 125 /// TypeBuilderImpl translates expression and symbol type taking into account 126 /// their shape and length parameters. For symbols, attributes such as 127 /// ALLOCATABLE or POINTER are reflected in the fir type. 128 /// It uses evaluate::DynamicType and evaluate::Shape when possible to 129 /// avoid re-implementing type/shape analysis here. 130 /// Do not use the FirOpBuilder from the AbstractConverter to get fir/mlir types 131 /// since it is not guaranteed to exist yet when we lower types. 132 namespace { 133 struct TypeBuilderImpl { 134 135 TypeBuilderImpl(Fortran::lower::AbstractConverter &converter) 136 : converter{converter}, context{&converter.getMLIRContext()} {} 137 138 template <typename A> 139 mlir::Type genExprType(const A &expr) { 140 std::optional<Fortran::evaluate::DynamicType> dynamicType = expr.GetType(); 141 if (!dynamicType) 142 return genTypelessExprType(expr); 143 Fortran::common::TypeCategory category = dynamicType->category(); 144 145 mlir::Type baseType; 146 bool isPolymorphic = (dynamicType->IsPolymorphic() || 147 dynamicType->IsUnlimitedPolymorphic()) && 148 !dynamicType->IsAssumedType(); 149 if (dynamicType->IsUnlimitedPolymorphic()) { 150 baseType = mlir::NoneType::get(context); 151 } else if (category == Fortran::common::TypeCategory::Derived) { 152 baseType = genDerivedType(dynamicType->GetDerivedTypeSpec()); 153 } else { 154 // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER 155 llvm::SmallVector<Fortran::lower::LenParameterTy> params; 156 translateLenParameters(params, category, expr); 157 baseType = genFIRType(context, category, dynamicType->kind(), params); 158 } 159 std::optional<Fortran::evaluate::Shape> shapeExpr = 160 Fortran::evaluate::GetShape(converter.getFoldingContext(), expr); 161 fir::SequenceType::Shape shape; 162 if (shapeExpr) { 163 translateShape(shape, std::move(*shapeExpr)); 164 } else { 165 // Shape static analysis cannot return something useful for the shape. 166 // Use unknown extents. 167 int rank = expr.Rank(); 168 if (rank < 0) 169 TODO(converter.getCurrentLocation(), "assumed rank expression types"); 170 for (int dim = 0; dim < rank; ++dim) 171 shape.emplace_back(fir::SequenceType::getUnknownExtent()); 172 } 173 174 if (!shape.empty()) { 175 if (isPolymorphic) 176 return fir::ClassType::get(fir::SequenceType::get(shape, baseType)); 177 return fir::SequenceType::get(shape, baseType); 178 } 179 if (isPolymorphic) 180 return fir::ClassType::get(baseType); 181 return baseType; 182 } 183 184 template <typename A> 185 void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) { 186 for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) { 187 fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent(); 188 if (std::optional<std::int64_t> constantExtent = 189 toInt64(std::move(extentExpr))) 190 extent = *constantExtent; 191 shape.push_back(extent); 192 } 193 } 194 195 template <typename A> 196 std::optional<std::int64_t> toInt64(A &&expr) { 197 return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( 198 converter.getFoldingContext(), std::move(expr))); 199 } 200 201 template <typename A> 202 mlir::Type genTypelessExprType(const A &expr) { 203 fir::emitFatalError(converter.getCurrentLocation(), "not a typeless expr"); 204 } 205 206 mlir::Type genTypelessExprType(const Fortran::lower::SomeExpr &expr) { 207 return std::visit( 208 Fortran::common::visitors{ 209 [&](const Fortran::evaluate::BOZLiteralConstant &) -> mlir::Type { 210 return mlir::NoneType::get(context); 211 }, 212 [&](const Fortran::evaluate::NullPointer &) -> mlir::Type { 213 return fir::ReferenceType::get(mlir::NoneType::get(context)); 214 }, 215 [&](const Fortran::evaluate::ProcedureDesignator &proc) 216 -> mlir::Type { 217 return Fortran::lower::translateSignature(proc, converter); 218 }, 219 [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type { 220 return mlir::NoneType::get(context); 221 }, 222 [](const auto &x) -> mlir::Type { 223 using T = std::decay_t<decltype(x)>; 224 static_assert(!Fortran::common::HasMember< 225 T, Fortran::evaluate::TypelessExpression>, 226 "missing typeless expr handling"); 227 llvm::report_fatal_error("not a typeless expression"); 228 }, 229 }, 230 expr.u); 231 } 232 233 mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol, 234 bool isAlloc = false, bool isPtr = false) { 235 mlir::Location loc = converter.genLocation(symbol.name()); 236 mlir::Type ty; 237 // If the symbol is not the same as the ultimate one (i.e, it is host or use 238 // associated), all the symbol properties are the ones of the ultimate 239 // symbol but the volatile and asynchronous attributes that may differ. To 240 // avoid issues with helper functions that would not follow association 241 // links, the fir type is built based on the ultimate symbol. This relies 242 // on the fact volatile and asynchronous are not reflected in fir types. 243 const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate(); 244 if (Fortran::semantics::IsProcedurePointer(ultimate)) 245 TODO(loc, "procedure pointers"); 246 if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) { 247 if (const Fortran::semantics::IntrinsicTypeSpec *tySpec = 248 type->AsIntrinsic()) { 249 int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value(); 250 llvm::SmallVector<Fortran::lower::LenParameterTy> params; 251 translateLenParameters(params, tySpec->category(), ultimate); 252 ty = genFIRType(context, tySpec->category(), kind, params); 253 } else if (type->IsPolymorphic() && 254 !converter.getLoweringOptions().getPolymorphicTypeImpl()) { 255 // TODO is kept under experimental flag until feature is complete. 256 TODO(loc, "support for polymorphic types"); 257 } else if (type->IsUnlimitedPolymorphic()) { 258 ty = mlir::NoneType::get(context); 259 } else if (const Fortran::semantics::DerivedTypeSpec *tySpec = 260 type->AsDerived()) { 261 ty = genDerivedType(*tySpec); 262 } else { 263 fir::emitFatalError(loc, "symbol's type must have a type spec"); 264 } 265 } else { 266 fir::emitFatalError(loc, "symbol must have a type"); 267 } 268 bool isPolymorphic = (Fortran::semantics::IsPolymorphic(symbol) || 269 Fortran::semantics::IsUnlimitedPolymorphic(symbol)) && 270 !Fortran::semantics::IsAssumedType(symbol); 271 if (ultimate.IsObjectArray()) { 272 auto shapeExpr = Fortran::evaluate::GetShapeHelper{ 273 converter.getFoldingContext()}(ultimate); 274 if (!shapeExpr) 275 TODO(loc, "assumed rank symbol type"); 276 fir::SequenceType::Shape shape; 277 translateShape(shape, std::move(*shapeExpr)); 278 ty = fir::SequenceType::get(shape, ty); 279 } 280 if (Fortran::semantics::IsPointer(symbol)) 281 return fir::wrapInClassOrBoxType(fir::PointerType::get(ty), 282 isPolymorphic); 283 if (Fortran::semantics::IsAllocatable(symbol)) 284 return fir::wrapInClassOrBoxType(fir::HeapType::get(ty), isPolymorphic); 285 // isPtr and isAlloc are variable that were promoted to be on the 286 // heap or to be pointers, but they do not have Fortran allocatable 287 // or pointer semantics, so do not use box for them. 288 if (isPtr) 289 return fir::PointerType::get(ty); 290 if (isAlloc) 291 return fir::HeapType::get(ty); 292 if (isPolymorphic) 293 return fir::ClassType::get(ty); 294 return ty; 295 } 296 297 /// Does \p component has non deferred lower bounds that are not compile time 298 /// constant 1. 299 static bool componentHasNonDefaultLowerBounds( 300 const Fortran::semantics::Symbol &component) { 301 if (const auto *objDetails = 302 component.detailsIf<Fortran::semantics::ObjectEntityDetails>()) 303 for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape()) 304 if (auto lb = bounds.lbound().GetExplicit()) 305 if (auto constant = Fortran::evaluate::ToInt64(*lb)) 306 if (!constant || *constant != 1) 307 return true; 308 return false; 309 } 310 311 mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) { 312 std::vector<std::pair<std::string, mlir::Type>> ps; 313 std::vector<std::pair<std::string, mlir::Type>> cs; 314 const Fortran::semantics::Symbol &typeSymbol = tySpec.typeSymbol(); 315 if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(typeSymbol)) 316 return ty; 317 318 auto rec = fir::RecordType::get(context, 319 Fortran::lower::mangle::mangleName(tySpec)); 320 // Maintain the stack of types for recursive references. 321 derivedTypeInConstruction.emplace_back(typeSymbol, rec); 322 323 // Gather the record type fields. 324 // (1) The data components. 325 for (const auto &field : 326 Fortran::semantics::OrderedComponentIterator(tySpec)) { 327 // Lowering is assuming non deferred component lower bounds are always 1. 328 // Catch any situations where this is not true for now. 329 if (!converter.getLoweringOptions().getLowerToHighLevelFIR() && 330 componentHasNonDefaultLowerBounds(field)) 331 TODO(converter.genLocation(field.name()), 332 "derived type components with non default lower bounds"); 333 if (IsProcedure(field)) 334 TODO(converter.genLocation(field.name()), "procedure components"); 335 mlir::Type ty = genSymbolType(field); 336 // Do not add the parent component (component of the parents are 337 // added and should be sufficient, the parent component would 338 // duplicate the fields). 339 if (field.test(Fortran::semantics::Symbol::Flag::ParentComp)) 340 continue; 341 cs.emplace_back(field.name().ToString(), ty); 342 } 343 344 // (2) The LEN type parameters. 345 for (const auto ¶m : 346 Fortran::semantics::OrderParameterDeclarations(typeSymbol)) 347 if (param->get<Fortran::semantics::TypeParamDetails>().attr() == 348 Fortran::common::TypeParamAttr::Len) 349 ps.emplace_back(param->name().ToString(), genSymbolType(*param)); 350 351 rec.finalize(ps, cs); 352 popDerivedTypeInConstruction(); 353 354 mlir::Location loc = converter.genLocation(typeSymbol.name()); 355 if (!ps.empty()) { 356 // This type is a PDT (parametric derived type). Create the functions to 357 // use for allocation, dereferencing, and address arithmetic here. 358 TODO(loc, "parameterized derived types"); 359 } 360 LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n'); 361 362 converter.registerDispatchTableInfo(loc, &tySpec); 363 364 // Generate the type descriptor object if any 365 if (const Fortran::semantics::Scope *derivedScope = 366 tySpec.scope() ? tySpec.scope() : tySpec.typeSymbol().scope()) 367 if (const Fortran::semantics::Symbol *typeInfoSym = 368 derivedScope->runtimeDerivedTypeDescription()) 369 converter.registerRuntimeTypeInfo(loc, *typeInfoSym); 370 return rec; 371 } 372 373 // To get the character length from a symbol, make an fold a designator for 374 // the symbol to cover the case where the symbol is an assumed length named 375 // constant and its length comes from its init expression length. 376 template <int Kind> 377 fir::SequenceType::Extent 378 getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) { 379 using TC = 380 Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>; 381 auto designator = Fortran::evaluate::Fold( 382 converter.getFoldingContext(), 383 Fortran::evaluate::Expr<TC>{Fortran::evaluate::Designator<TC>{symbol}}); 384 if (auto len = toInt64(std::move(designator.LEN()))) 385 return *len; 386 return fir::SequenceType::getUnknownExtent(); 387 } 388 389 template <typename T> 390 void translateLenParameters( 391 llvm::SmallVectorImpl<Fortran::lower::LenParameterTy> ¶ms, 392 Fortran::common::TypeCategory category, const T &exprOrSym) { 393 if (category == Fortran::common::TypeCategory::Character) 394 params.push_back(getCharacterLength(exprOrSym)); 395 else if (category == Fortran::common::TypeCategory::Derived) 396 TODO(converter.getCurrentLocation(), "derived type length parameters"); 397 } 398 Fortran::lower::LenParameterTy 399 getCharacterLength(const Fortran::semantics::Symbol &symbol) { 400 const Fortran::semantics::DeclTypeSpec *type = symbol.GetType(); 401 if (!type || 402 type->category() != Fortran::semantics::DeclTypeSpec::Character || 403 !type->AsIntrinsic()) 404 llvm::report_fatal_error("not a character symbol"); 405 int kind = 406 toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value(); 407 switch (kind) { 408 case 1: 409 return getCharacterLengthHelper<1>(symbol); 410 case 2: 411 return getCharacterLengthHelper<2>(symbol); 412 case 4: 413 return getCharacterLengthHelper<4>(symbol); 414 } 415 llvm_unreachable("unknown character kind"); 416 } 417 418 template <typename A> 419 Fortran::lower::LenParameterTy getCharacterLength(const A &expr) { 420 return fir::SequenceType::getUnknownExtent(); 421 } 422 423 template <typename T> 424 Fortran::lower::LenParameterTy 425 getCharacterLength(const Fortran::evaluate::FunctionRef<T> &funcRef) { 426 if (auto constantLen = toInt64(funcRef.LEN())) 427 return *constantLen; 428 return fir::SequenceType::getUnknownExtent(); 429 } 430 431 Fortran::lower::LenParameterTy 432 getCharacterLength(const Fortran::lower::SomeExpr &expr) { 433 // Do not use dynamic type length here. We would miss constant 434 // lengths opportunities because dynamic type only has the length 435 // if it comes from a declaration. 436 if (const auto *charExpr = std::get_if< 437 Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>( 438 &expr.u)) { 439 if (auto constantLen = toInt64(charExpr->LEN())) 440 return *constantLen; 441 } else if (auto dynamicType = expr.GetType()) { 442 // When generating derived type type descriptor as structure constructor, 443 // semantics wraps designators to data component initialization into 444 // CLASS(*), regardless of their actual type. 445 // GetType() will recover the actual symbol type as the dynamic type, so 446 // getCharacterLength may be reached even if expr is packaged as an 447 // Expr<SomeDerived> instead of an Expr<SomeChar>. 448 // Just use the dynamic type here again to retrieve the length. 449 if (auto constantLen = toInt64(dynamicType->GetCharLength())) 450 return *constantLen; 451 } 452 return fir::SequenceType::getUnknownExtent(); 453 } 454 455 mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) { 456 return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer()); 457 } 458 459 /// Derived type can be recursive. That is, pointer components of a derived 460 /// type `t` have type `t`. This helper returns `t` if it is already being 461 /// lowered to avoid infinite loops. 462 mlir::Type getTypeIfDerivedAlreadyInConstruction( 463 const Fortran::lower::SymbolRef derivedSym) const { 464 for (const auto &[sym, type] : derivedTypeInConstruction) 465 if (sym == derivedSym) 466 return type; 467 return {}; 468 } 469 470 void popDerivedTypeInConstruction() { 471 assert(!derivedTypeInConstruction.empty()); 472 derivedTypeInConstruction.pop_back(); 473 } 474 475 /// Stack derived type being processed to avoid infinite loops in case of 476 /// recursive derived types. The depth of derived types is expected to be 477 /// shallow (<10), so a SmallVector is sufficient. 478 llvm::SmallVector<std::pair<const Fortran::lower::SymbolRef, mlir::Type>> 479 derivedTypeInConstruction; 480 Fortran::lower::AbstractConverter &converter; 481 mlir::MLIRContext *context; 482 }; 483 } // namespace 484 485 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context, 486 Fortran::common::TypeCategory tc, 487 int kind, 488 llvm::ArrayRef<LenParameterTy> params) { 489 return genFIRType(context, tc, kind, params); 490 } 491 492 mlir::Type Fortran::lower::translateDerivedTypeToFIRType( 493 Fortran::lower::AbstractConverter &converter, 494 const Fortran::semantics::DerivedTypeSpec &tySpec) { 495 return TypeBuilderImpl{converter}.genDerivedType(tySpec); 496 } 497 498 mlir::Type Fortran::lower::translateSomeExprToFIRType( 499 Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) { 500 return TypeBuilderImpl{converter}.genExprType(expr); 501 } 502 503 mlir::Type Fortran::lower::translateSymbolToFIRType( 504 Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) { 505 return TypeBuilderImpl{converter}.genSymbolType(symbol); 506 } 507 508 mlir::Type Fortran::lower::translateVariableToFIRType( 509 Fortran::lower::AbstractConverter &converter, 510 const Fortran::lower::pft::Variable &var) { 511 return TypeBuilderImpl{converter}.genVariableType(var); 512 } 513 514 mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) { 515 return genRealType(context, kind); 516 } 517 518 bool Fortran::lower::isDerivedTypeWithLenParameters( 519 const Fortran::semantics::Symbol &sym) { 520 if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) 521 if (const Fortran::semantics::DerivedTypeSpec *derived = 522 declTy->AsDerived()) 523 return Fortran::semantics::CountLenParameters(*derived) > 0; 524 return false; 525 } 526 527 template <typename T> 528 mlir::Type Fortran::lower::TypeBuilder<T>::genType( 529 Fortran::lower::AbstractConverter &converter, 530 const Fortran::evaluate::FunctionRef<T> &funcRef) { 531 return TypeBuilderImpl{converter}.genExprType(funcRef); 532 } 533 534 using namespace Fortran::evaluate; 535 using namespace Fortran::common; 536 FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::TypeBuilder, ) 537