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 if (dynamicType->IsUnlimitedPolymorphic()) { 147 baseType = mlir::NoneType::get(context); 148 } else if (category == Fortran::common::TypeCategory::Derived) { 149 baseType = genDerivedType(dynamicType->GetDerivedTypeSpec()); 150 } else { 151 // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER 152 llvm::SmallVector<Fortran::lower::LenParameterTy> params; 153 translateLenParameters(params, category, expr); 154 baseType = genFIRType(context, category, dynamicType->kind(), params); 155 } 156 std::optional<Fortran::evaluate::Shape> shapeExpr = 157 Fortran::evaluate::GetShape(converter.getFoldingContext(), expr); 158 fir::SequenceType::Shape shape; 159 if (shapeExpr) { 160 translateShape(shape, std::move(*shapeExpr)); 161 } else { 162 // Shape static analysis cannot return something useful for the shape. 163 // Use unknown extents. 164 int rank = expr.Rank(); 165 if (rank < 0) 166 TODO(converter.getCurrentLocation(), "assumed rank expression types"); 167 for (int dim = 0; dim < rank; ++dim) 168 shape.emplace_back(fir::SequenceType::getUnknownExtent()); 169 } 170 if (!shape.empty()) 171 return fir::SequenceType::get(shape, baseType); 172 return baseType; 173 } 174 175 template <typename A> 176 void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) { 177 for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) { 178 fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent(); 179 if (std::optional<std::int64_t> constantExtent = 180 toInt64(std::move(extentExpr))) 181 extent = *constantExtent; 182 shape.push_back(extent); 183 } 184 } 185 186 template <typename A> 187 std::optional<std::int64_t> toInt64(A &&expr) { 188 return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( 189 converter.getFoldingContext(), std::move(expr))); 190 } 191 192 template <typename A> 193 mlir::Type genTypelessExprType(const A &expr) { 194 fir::emitFatalError(converter.getCurrentLocation(), "not a typeless expr"); 195 } 196 197 mlir::Type genTypelessExprType(const Fortran::lower::SomeExpr &expr) { 198 return std::visit( 199 Fortran::common::visitors{ 200 [&](const Fortran::evaluate::BOZLiteralConstant &) -> mlir::Type { 201 return mlir::NoneType::get(context); 202 }, 203 [&](const Fortran::evaluate::NullPointer &) -> mlir::Type { 204 return fir::ReferenceType::get(mlir::NoneType::get(context)); 205 }, 206 [&](const Fortran::evaluate::ProcedureDesignator &proc) 207 -> mlir::Type { 208 return Fortran::lower::translateSignature(proc, converter); 209 }, 210 [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type { 211 return mlir::NoneType::get(context); 212 }, 213 [](const auto &x) -> mlir::Type { 214 using T = std::decay_t<decltype(x)>; 215 static_assert(!Fortran::common::HasMember< 216 T, Fortran::evaluate::TypelessExpression>, 217 "missing typeless expr handling"); 218 llvm::report_fatal_error("not a typeless expression"); 219 }, 220 }, 221 expr.u); 222 } 223 224 mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol, 225 bool isAlloc = false, bool isPtr = false) { 226 mlir::Location loc = converter.genLocation(symbol.name()); 227 mlir::Type ty; 228 // If the symbol is not the same as the ultimate one (i.e, it is host or use 229 // associated), all the symbol properties are the ones of the ultimate 230 // symbol but the volatile and asynchronous attributes that may differ. To 231 // avoid issues with helper functions that would not follow association 232 // links, the fir type is built based on the ultimate symbol. This relies 233 // on the fact volatile and asynchronous are not reflected in fir types. 234 const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate(); 235 if (Fortran::semantics::IsProcedurePointer(ultimate)) 236 TODO(loc, "procedure pointers"); 237 if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) { 238 if (const Fortran::semantics::IntrinsicTypeSpec *tySpec = 239 type->AsIntrinsic()) { 240 int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value(); 241 llvm::SmallVector<Fortran::lower::LenParameterTy> params; 242 translateLenParameters(params, tySpec->category(), ultimate); 243 ty = genFIRType(context, tySpec->category(), kind, params); 244 } else if (type->IsPolymorphic() && 245 !converter.getLoweringOptions().getPolymorphicTypeImpl()) { 246 // TODO is kept under experimental flag until feature is complete. 247 TODO(loc, "support for polymorphic types"); 248 } else if (type->IsUnlimitedPolymorphic()) { 249 ty = mlir::NoneType::get(context); 250 } else if (const Fortran::semantics::DerivedTypeSpec *tySpec = 251 type->AsDerived()) { 252 ty = genDerivedType(*tySpec); 253 } else { 254 fir::emitFatalError(loc, "symbol's type must have a type spec"); 255 } 256 } else { 257 fir::emitFatalError(loc, "symbol must have a type"); 258 } 259 if (ultimate.IsObjectArray()) { 260 auto shapeExpr = Fortran::evaluate::GetShapeHelper{ 261 converter.getFoldingContext()}(ultimate); 262 if (!shapeExpr) 263 TODO(loc, "assumed rank symbol type"); 264 fir::SequenceType::Shape shape; 265 translateShape(shape, std::move(*shapeExpr)); 266 ty = fir::SequenceType::get(shape, ty); 267 } 268 if (Fortran::semantics::IsPointer(symbol)) 269 return fir::wrapInClassOrBoxType( 270 fir::PointerType::get(ty), Fortran::semantics::IsPolymorphic(symbol)); 271 if (Fortran::semantics::IsAllocatable(symbol)) 272 return fir::wrapInClassOrBoxType( 273 fir::HeapType::get(ty), Fortran::semantics::IsPolymorphic(symbol)); 274 // isPtr and isAlloc are variable that were promoted to be on the 275 // heap or to be pointers, but they do not have Fortran allocatable 276 // or pointer semantics, so do not use box for them. 277 if (isPtr) 278 return fir::PointerType::get(ty); 279 if (isAlloc) 280 return fir::HeapType::get(ty); 281 return ty; 282 } 283 284 /// Does \p component has non deferred lower bounds that are not compile time 285 /// constant 1. 286 static bool componentHasNonDefaultLowerBounds( 287 const Fortran::semantics::Symbol &component) { 288 if (const auto *objDetails = 289 component.detailsIf<Fortran::semantics::ObjectEntityDetails>()) 290 for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape()) 291 if (auto lb = bounds.lbound().GetExplicit()) 292 if (auto constant = Fortran::evaluate::ToInt64(*lb)) 293 if (!constant || *constant != 1) 294 return true; 295 return false; 296 } 297 298 mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) { 299 std::vector<std::pair<std::string, mlir::Type>> ps; 300 std::vector<std::pair<std::string, mlir::Type>> cs; 301 const Fortran::semantics::Symbol &typeSymbol = tySpec.typeSymbol(); 302 if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(typeSymbol)) 303 return ty; 304 305 if (Fortran::semantics::IsFinalizable(tySpec)) 306 TODO(converter.genLocation(tySpec.name()), "derived type finalization"); 307 308 auto rec = fir::RecordType::get(context, 309 Fortran::lower::mangle::mangleName(tySpec)); 310 // Maintain the stack of types for recursive references. 311 derivedTypeInConstruction.emplace_back(typeSymbol, rec); 312 313 // Gather the record type fields. 314 // (1) The data components. 315 for (const auto &field : 316 Fortran::semantics::OrderedComponentIterator(tySpec)) { 317 // Lowering is assuming non deferred component lower bounds are always 1. 318 // Catch any situations where this is not true for now. 319 if (!converter.getLoweringOptions().getLowerToHighLevelFIR() && 320 componentHasNonDefaultLowerBounds(field)) 321 TODO(converter.genLocation(field.name()), 322 "derived type components with non default lower bounds"); 323 if (IsProcedure(field)) 324 TODO(converter.genLocation(field.name()), "procedure components"); 325 mlir::Type ty = genSymbolType(field); 326 // Do not add the parent component (component of the parents are 327 // added and should be sufficient, the parent component would 328 // duplicate the fields). 329 if (field.test(Fortran::semantics::Symbol::Flag::ParentComp)) 330 continue; 331 cs.emplace_back(field.name().ToString(), ty); 332 } 333 334 // (2) The LEN type parameters. 335 for (const auto ¶m : 336 Fortran::semantics::OrderParameterDeclarations(typeSymbol)) 337 if (param->get<Fortran::semantics::TypeParamDetails>().attr() == 338 Fortran::common::TypeParamAttr::Len) 339 ps.emplace_back(param->name().ToString(), genSymbolType(*param)); 340 341 rec.finalize(ps, cs); 342 popDerivedTypeInConstruction(); 343 344 mlir::Location loc = converter.genLocation(typeSymbol.name()); 345 if (!ps.empty()) { 346 // This type is a PDT (parametric derived type). Create the functions to 347 // use for allocation, dereferencing, and address arithmetic here. 348 TODO(loc, "parameterized derived types"); 349 } 350 LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n'); 351 352 converter.registerDispatchTableInfo(loc, &tySpec); 353 354 // Generate the type descriptor object if any 355 if (const Fortran::semantics::Scope *derivedScope = 356 tySpec.scope() ? tySpec.scope() : tySpec.typeSymbol().scope()) 357 if (const Fortran::semantics::Symbol *typeInfoSym = 358 derivedScope->runtimeDerivedTypeDescription()) 359 converter.registerRuntimeTypeInfo(loc, *typeInfoSym); 360 return rec; 361 } 362 363 // To get the character length from a symbol, make an fold a designator for 364 // the symbol to cover the case where the symbol is an assumed length named 365 // constant and its length comes from its init expression length. 366 template <int Kind> 367 fir::SequenceType::Extent 368 getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) { 369 using TC = 370 Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>; 371 auto designator = Fortran::evaluate::Fold( 372 converter.getFoldingContext(), 373 Fortran::evaluate::Expr<TC>{Fortran::evaluate::Designator<TC>{symbol}}); 374 if (auto len = toInt64(std::move(designator.LEN()))) 375 return *len; 376 return fir::SequenceType::getUnknownExtent(); 377 } 378 379 template <typename T> 380 void translateLenParameters( 381 llvm::SmallVectorImpl<Fortran::lower::LenParameterTy> ¶ms, 382 Fortran::common::TypeCategory category, const T &exprOrSym) { 383 if (category == Fortran::common::TypeCategory::Character) 384 params.push_back(getCharacterLength(exprOrSym)); 385 else if (category == Fortran::common::TypeCategory::Derived) 386 TODO(converter.getCurrentLocation(), "derived type length parameters"); 387 } 388 Fortran::lower::LenParameterTy 389 getCharacterLength(const Fortran::semantics::Symbol &symbol) { 390 const Fortran::semantics::DeclTypeSpec *type = symbol.GetType(); 391 if (!type || 392 type->category() != Fortran::semantics::DeclTypeSpec::Character || 393 !type->AsIntrinsic()) 394 llvm::report_fatal_error("not a character symbol"); 395 int kind = 396 toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value(); 397 switch (kind) { 398 case 1: 399 return getCharacterLengthHelper<1>(symbol); 400 case 2: 401 return getCharacterLengthHelper<2>(symbol); 402 case 4: 403 return getCharacterLengthHelper<4>(symbol); 404 } 405 llvm_unreachable("unknown character kind"); 406 } 407 408 template <typename A> 409 Fortran::lower::LenParameterTy getCharacterLength(const A &expr) { 410 return fir::SequenceType::getUnknownExtent(); 411 } 412 Fortran::lower::LenParameterTy 413 getCharacterLength(const Fortran::lower::SomeExpr &expr) { 414 // Do not use dynamic type length here. We would miss constant 415 // lengths opportunities because dynamic type only has the length 416 // if it comes from a declaration. 417 auto charExpr = 418 std::get<Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>( 419 expr.u); 420 if (auto constantLen = toInt64(charExpr.LEN())) 421 return *constantLen; 422 return fir::SequenceType::getUnknownExtent(); 423 } 424 425 mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) { 426 return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer()); 427 } 428 429 /// Derived type can be recursive. That is, pointer components of a derived 430 /// type `t` have type `t`. This helper returns `t` if it is already being 431 /// lowered to avoid infinite loops. 432 mlir::Type getTypeIfDerivedAlreadyInConstruction( 433 const Fortran::lower::SymbolRef derivedSym) const { 434 for (const auto &[sym, type] : derivedTypeInConstruction) 435 if (sym == derivedSym) 436 return type; 437 return {}; 438 } 439 440 void popDerivedTypeInConstruction() { 441 assert(!derivedTypeInConstruction.empty()); 442 derivedTypeInConstruction.pop_back(); 443 } 444 445 /// Stack derived type being processed to avoid infinite loops in case of 446 /// recursive derived types. The depth of derived types is expected to be 447 /// shallow (<10), so a SmallVector is sufficient. 448 llvm::SmallVector<std::pair<const Fortran::lower::SymbolRef, mlir::Type>> 449 derivedTypeInConstruction; 450 Fortran::lower::AbstractConverter &converter; 451 mlir::MLIRContext *context; 452 }; 453 } // namespace 454 455 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context, 456 Fortran::common::TypeCategory tc, 457 int kind, 458 llvm::ArrayRef<LenParameterTy> params) { 459 return genFIRType(context, tc, kind, params); 460 } 461 462 mlir::Type Fortran::lower::translateDerivedTypeToFIRType( 463 Fortran::lower::AbstractConverter &converter, 464 const Fortran::semantics::DerivedTypeSpec &tySpec) { 465 return TypeBuilderImpl{converter}.genDerivedType(tySpec); 466 } 467 468 mlir::Type Fortran::lower::translateSomeExprToFIRType( 469 Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) { 470 return TypeBuilderImpl{converter}.genExprType(expr); 471 } 472 473 mlir::Type Fortran::lower::translateSymbolToFIRType( 474 Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) { 475 return TypeBuilderImpl{converter}.genSymbolType(symbol); 476 } 477 478 mlir::Type Fortran::lower::translateVariableToFIRType( 479 Fortran::lower::AbstractConverter &converter, 480 const Fortran::lower::pft::Variable &var) { 481 return TypeBuilderImpl{converter}.genVariableType(var); 482 } 483 484 mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) { 485 return genRealType(context, kind); 486 } 487 488 bool Fortran::lower::isDerivedTypeWithLenParameters( 489 const Fortran::semantics::Symbol &sym) { 490 if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) 491 if (const Fortran::semantics::DerivedTypeSpec *derived = 492 declTy->AsDerived()) 493 return Fortran::semantics::CountLenParameters(*derived) > 0; 494 return false; 495 } 496 497 template <typename T> 498 mlir::Type Fortran::lower::TypeBuilder<T>::genType( 499 Fortran::lower::AbstractConverter &converter, 500 const Fortran::evaluate::FunctionRef<T> &funcRef) { 501 return TypeBuilderImpl{converter}.genExprType(funcRef); 502 } 503 504 using namespace Fortran::evaluate; 505 using namespace Fortran::common; 506 FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::TypeBuilder, ) 507