1 //===-- ConvertConstant.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 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ 10 // 11 //===----------------------------------------------------------------------===// 12 13 #include "flang/Lower/ConvertConstant.h" 14 #include "flang/Evaluate/expression.h" 15 #include "flang/Lower/AbstractConverter.h" 16 #include "flang/Lower/BuiltinModules.h" 17 #include "flang/Lower/ConvertExprToHLFIR.h" 18 #include "flang/Lower/ConvertType.h" 19 #include "flang/Lower/ConvertVariable.h" 20 #include "flang/Lower/Mangler.h" 21 #include "flang/Lower/StatementContext.h" 22 #include "flang/Lower/SymbolMap.h" 23 #include "flang/Optimizer/Builder/Complex.h" 24 #include "flang/Optimizer/Builder/MutableBox.h" 25 #include "flang/Optimizer/Builder/Todo.h" 26 27 #include <algorithm> 28 29 /// Convert string, \p s, to an APFloat value. Recognize and handle Inf and 30 /// NaN strings as well. \p s is assumed to not contain any spaces. 31 static llvm::APFloat consAPFloat(const llvm::fltSemantics &fsem, 32 llvm::StringRef s) { 33 assert(!s.contains(' ')); 34 if (s.compare_insensitive("-inf") == 0) 35 return llvm::APFloat::getInf(fsem, /*negative=*/true); 36 if (s.compare_insensitive("inf") == 0 || s.compare_insensitive("+inf") == 0) 37 return llvm::APFloat::getInf(fsem); 38 // TODO: Add support for quiet and signaling NaNs. 39 if (s.compare_insensitive("-nan") == 0) 40 return llvm::APFloat::getNaN(fsem, /*negative=*/true); 41 if (s.compare_insensitive("nan") == 0 || s.compare_insensitive("+nan") == 0) 42 return llvm::APFloat::getNaN(fsem); 43 return {fsem, s}; 44 } 45 46 //===----------------------------------------------------------------------===// 47 // Fortran::lower::tryCreatingDenseGlobal implementation 48 //===----------------------------------------------------------------------===// 49 50 /// Generate an mlir attribute from a literal value 51 template <Fortran::common::TypeCategory TC, int KIND> 52 static mlir::Attribute convertToAttribute( 53 fir::FirOpBuilder &builder, 54 const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> &value, 55 mlir::Type type) { 56 if constexpr (TC == Fortran::common::TypeCategory::Integer) { 57 if constexpr (KIND <= 8) 58 return builder.getIntegerAttr(type, value.ToInt64()); 59 else { 60 static_assert(KIND <= 16, "integers with KIND > 16 are not supported"); 61 return builder.getIntegerAttr( 62 type, llvm::APInt(KIND * 8, 63 {value.ToUInt64(), value.SHIFTR(64).ToUInt64()})); 64 } 65 } else if constexpr (TC == Fortran::common::TypeCategory::Logical) { 66 return builder.getIntegerAttr(type, value.IsTrue()); 67 } else { 68 auto getFloatAttr = [&](const auto &value, mlir::Type type) { 69 std::string str = value.DumpHexadecimal(); 70 auto floatVal = 71 consAPFloat(builder.getKindMap().getFloatSemantics(KIND), str); 72 return builder.getFloatAttr(type, floatVal); 73 }; 74 75 if constexpr (TC == Fortran::common::TypeCategory::Real) { 76 return getFloatAttr(value, type); 77 } else { 78 static_assert(TC == Fortran::common::TypeCategory::Complex, 79 "type values cannot be converted to attributes"); 80 mlir::Type eleTy = mlir::cast<mlir::ComplexType>(type).getElementType(); 81 llvm::SmallVector<mlir::Attribute, 2> attrs = { 82 getFloatAttr(value.REAL(), eleTy), 83 getFloatAttr(value.AIMAG(), eleTy)}; 84 return builder.getArrayAttr(attrs); 85 } 86 } 87 return {}; 88 } 89 90 namespace { 91 /// Helper class to lower an array constant to a global with an MLIR dense 92 /// attribute. 93 /// 94 /// If we have an array of integer, real, complex, or logical, then we can 95 /// create a global array with the dense attribute. 96 /// 97 /// The mlir tensor type can only handle integer, real, complex, or logical. 98 /// It does not currently support nested structures. 99 class DenseGlobalBuilder { 100 public: 101 static fir::GlobalOp tryCreating(fir::FirOpBuilder &builder, 102 mlir::Location loc, mlir::Type symTy, 103 llvm::StringRef globalName, 104 mlir::StringAttr linkage, bool isConst, 105 const Fortran::lower::SomeExpr &initExpr, 106 cuf::DataAttributeAttr dataAttr) { 107 DenseGlobalBuilder globalBuilder; 108 Fortran::common::visit( 109 Fortran::common::visitors{ 110 [&](const Fortran::evaluate::Expr<Fortran::evaluate::SomeLogical> & 111 x) { globalBuilder.tryConvertingToAttributes(builder, x); }, 112 [&](const Fortran::evaluate::Expr<Fortran::evaluate::SomeInteger> & 113 x) { globalBuilder.tryConvertingToAttributes(builder, x); }, 114 [&](const Fortran::evaluate::Expr<Fortran::evaluate::SomeReal> &x) { 115 globalBuilder.tryConvertingToAttributes(builder, x); 116 }, 117 [&](const Fortran::evaluate::Expr<Fortran::evaluate::SomeComplex> & 118 x) { globalBuilder.tryConvertingToAttributes(builder, x); }, 119 [](const auto &) {}, 120 }, 121 initExpr.u); 122 return globalBuilder.tryCreatingGlobal(builder, loc, symTy, globalName, 123 linkage, isConst, dataAttr); 124 } 125 126 template <Fortran::common::TypeCategory TC, int KIND> 127 static fir::GlobalOp tryCreating( 128 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type symTy, 129 llvm::StringRef globalName, mlir::StringAttr linkage, bool isConst, 130 const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>> 131 &constant, 132 cuf::DataAttributeAttr dataAttr) { 133 DenseGlobalBuilder globalBuilder; 134 globalBuilder.tryConvertingToAttributes(builder, constant); 135 return globalBuilder.tryCreatingGlobal(builder, loc, symTy, globalName, 136 linkage, isConst, dataAttr); 137 } 138 139 private: 140 DenseGlobalBuilder() = default; 141 142 /// Try converting an evaluate::Constant to a list of MLIR attributes. 143 template <Fortran::common::TypeCategory TC, int KIND> 144 void tryConvertingToAttributes( 145 fir::FirOpBuilder &builder, 146 const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>> 147 &constant) { 148 static_assert(TC != Fortran::common::TypeCategory::Character, 149 "must be numerical or logical"); 150 auto attrTc = TC == Fortran::common::TypeCategory::Logical 151 ? Fortran::common::TypeCategory::Integer 152 : TC; 153 attributeElementType = Fortran::lower::getFIRType( 154 builder.getContext(), attrTc, KIND, std::nullopt); 155 for (auto element : constant.values()) 156 attributes.push_back( 157 convertToAttribute<TC, KIND>(builder, element, attributeElementType)); 158 } 159 160 /// Try converting an evaluate::Expr to a list of MLIR attributes. 161 template <typename SomeCat> 162 void tryConvertingToAttributes(fir::FirOpBuilder &builder, 163 const Fortran::evaluate::Expr<SomeCat> &expr) { 164 Fortran::common::visit( 165 [&](const auto &x) { 166 using TR = Fortran::evaluate::ResultType<decltype(x)>; 167 if (const auto *constant = 168 std::get_if<Fortran::evaluate::Constant<TR>>(&x.u)) 169 tryConvertingToAttributes<TR::category, TR::kind>(builder, 170 *constant); 171 }, 172 expr.u); 173 } 174 175 /// Create a fir::Global if MLIR attributes have been successfully created by 176 /// tryConvertingToAttributes. 177 fir::GlobalOp tryCreatingGlobal(fir::FirOpBuilder &builder, 178 mlir::Location loc, mlir::Type symTy, 179 llvm::StringRef globalName, 180 mlir::StringAttr linkage, bool isConst, 181 cuf::DataAttributeAttr dataAttr) const { 182 // Not a "trivial" intrinsic constant array, or empty array. 183 if (!attributeElementType || attributes.empty()) 184 return {}; 185 186 assert(mlir::isa<fir::SequenceType>(symTy) && "expecting an array global"); 187 auto arrTy = mlir::cast<fir::SequenceType>(symTy); 188 llvm::SmallVector<int64_t> tensorShape(arrTy.getShape()); 189 std::reverse(tensorShape.begin(), tensorShape.end()); 190 auto tensorTy = 191 mlir::RankedTensorType::get(tensorShape, attributeElementType); 192 auto init = mlir::DenseElementsAttr::get(tensorTy, attributes); 193 return builder.createGlobal(loc, symTy, globalName, linkage, init, isConst, 194 /*isTarget=*/false, dataAttr); 195 } 196 197 llvm::SmallVector<mlir::Attribute> attributes; 198 mlir::Type attributeElementType; 199 }; 200 } // namespace 201 202 fir::GlobalOp Fortran::lower::tryCreatingDenseGlobal( 203 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type symTy, 204 llvm::StringRef globalName, mlir::StringAttr linkage, bool isConst, 205 const Fortran::lower::SomeExpr &initExpr, cuf::DataAttributeAttr dataAttr) { 206 return DenseGlobalBuilder::tryCreating(builder, loc, symTy, globalName, 207 linkage, isConst, initExpr, dataAttr); 208 } 209 210 //===----------------------------------------------------------------------===// 211 // Fortran::lower::convertConstant 212 // Lower a constant to a fir::ExtendedValue. 213 //===----------------------------------------------------------------------===// 214 215 /// Generate a real constant with a value `value`. 216 template <int KIND> 217 static mlir::Value genRealConstant(fir::FirOpBuilder &builder, 218 mlir::Location loc, 219 const llvm::APFloat &value) { 220 mlir::Type fltTy = Fortran::lower::convertReal(builder.getContext(), KIND); 221 return builder.createRealConstant(loc, fltTy, value); 222 } 223 224 /// Convert a scalar literal constant to IR. 225 template <Fortran::common::TypeCategory TC, int KIND> 226 static mlir::Value genScalarLit( 227 fir::FirOpBuilder &builder, mlir::Location loc, 228 const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> &value) { 229 if constexpr (TC == Fortran::common::TypeCategory::Integer || 230 TC == Fortran::common::TypeCategory::Unsigned) { 231 // MLIR requires constants to be signless 232 mlir::Type ty = Fortran::lower::getFIRType( 233 builder.getContext(), Fortran::common::TypeCategory::Integer, KIND, 234 std::nullopt); 235 if (KIND == 16) { 236 auto bigInt = llvm::APInt(ty.getIntOrFloatBitWidth(), 237 TC == Fortran::common::TypeCategory::Unsigned 238 ? value.UnsignedDecimal() 239 : value.SignedDecimal(), 240 10); 241 return builder.create<mlir::arith::ConstantOp>( 242 loc, ty, mlir::IntegerAttr::get(ty, bigInt)); 243 } 244 return builder.createIntegerConstant(loc, ty, value.ToInt64()); 245 } else if constexpr (TC == Fortran::common::TypeCategory::Logical) { 246 return builder.createBool(loc, value.IsTrue()); 247 } else if constexpr (TC == Fortran::common::TypeCategory::Real) { 248 std::string str = value.DumpHexadecimal(); 249 if constexpr (KIND == 2) { 250 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEhalf(), str); 251 return genRealConstant<KIND>(builder, loc, floatVal); 252 } else if constexpr (KIND == 3) { 253 auto floatVal = consAPFloat(llvm::APFloatBase::BFloat(), str); 254 return genRealConstant<KIND>(builder, loc, floatVal); 255 } else if constexpr (KIND == 4) { 256 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEsingle(), str); 257 return genRealConstant<KIND>(builder, loc, floatVal); 258 } else if constexpr (KIND == 10) { 259 auto floatVal = consAPFloat(llvm::APFloatBase::x87DoubleExtended(), str); 260 return genRealConstant<KIND>(builder, loc, floatVal); 261 } else if constexpr (KIND == 16) { 262 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEquad(), str); 263 return genRealConstant<KIND>(builder, loc, floatVal); 264 } else { 265 // convert everything else to double 266 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEdouble(), str); 267 return genRealConstant<KIND>(builder, loc, floatVal); 268 } 269 } else if constexpr (TC == Fortran::common::TypeCategory::Complex) { 270 mlir::Value real = genScalarLit<Fortran::common::TypeCategory::Real, KIND>( 271 builder, loc, value.REAL()); 272 mlir::Value imag = genScalarLit<Fortran::common::TypeCategory::Real, KIND>( 273 builder, loc, value.AIMAG()); 274 return fir::factory::Complex{builder, loc}.createComplex(real, imag); 275 } else /*constexpr*/ { 276 llvm_unreachable("unhandled constant"); 277 } 278 } 279 280 /// Create fir::string_lit from a scalar character constant. 281 template <int KIND> 282 static fir::StringLitOp 283 createStringLitOp(fir::FirOpBuilder &builder, mlir::Location loc, 284 const Fortran::evaluate::Scalar<Fortran::evaluate::Type< 285 Fortran::common::TypeCategory::Character, KIND>> &value, 286 [[maybe_unused]] int64_t len) { 287 if constexpr (KIND == 1) { 288 assert(value.size() == static_cast<std::uint64_t>(len)); 289 return builder.createStringLitOp(loc, value); 290 } else { 291 using ET = typename std::decay_t<decltype(value)>::value_type; 292 fir::CharacterType type = 293 fir::CharacterType::get(builder.getContext(), KIND, len); 294 mlir::MLIRContext *context = builder.getContext(); 295 std::int64_t size = static_cast<std::int64_t>(value.size()); 296 mlir::ShapedType shape = mlir::RankedTensorType::get( 297 llvm::ArrayRef<std::int64_t>{size}, 298 mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8)); 299 auto denseAttr = mlir::DenseElementsAttr::get( 300 shape, llvm::ArrayRef<ET>{value.data(), value.size()}); 301 auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist()); 302 mlir::NamedAttribute dataAttr(denseTag, denseAttr); 303 auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size()); 304 mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len)); 305 llvm::SmallVector<mlir::NamedAttribute> attrs = {dataAttr, sizeAttr}; 306 return builder.create<fir::StringLitOp>( 307 loc, llvm::ArrayRef<mlir::Type>{type}, std::nullopt, attrs); 308 } 309 } 310 311 /// Convert a scalar literal CHARACTER to IR. 312 template <int KIND> 313 static mlir::Value 314 genScalarLit(fir::FirOpBuilder &builder, mlir::Location loc, 315 const Fortran::evaluate::Scalar<Fortran::evaluate::Type< 316 Fortran::common::TypeCategory::Character, KIND>> &value, 317 int64_t len, bool outlineInReadOnlyMemory) { 318 // When in an initializer context, construct the literal op itself and do 319 // not construct another constant object in rodata. 320 if (!outlineInReadOnlyMemory) 321 return createStringLitOp<KIND>(builder, loc, value, len); 322 323 // Otherwise, the string is in a plain old expression so "outline" the value 324 // in read only data by hash consing it to a constant literal object. 325 326 // ASCII global constants are created using an mlir string attribute. 327 if constexpr (KIND == 1) { 328 return fir::getBase(fir::factory::createStringLiteral(builder, loc, value)); 329 } 330 331 auto size = builder.getKindMap().getCharacterBitsize(KIND) / 8 * value.size(); 332 llvm::StringRef strVal(reinterpret_cast<const char *>(value.c_str()), size); 333 std::string globalName = fir::factory::uniqueCGIdent( 334 KIND == 1 ? "cl"s : "cl"s + std::to_string(KIND), strVal); 335 fir::GlobalOp global = builder.getNamedGlobal(globalName); 336 fir::CharacterType type = 337 fir::CharacterType::get(builder.getContext(), KIND, len); 338 if (!global) 339 global = builder.createGlobalConstant( 340 loc, type, globalName, 341 [&](fir::FirOpBuilder &builder) { 342 fir::StringLitOp str = 343 createStringLitOp<KIND>(builder, loc, value, len); 344 builder.create<fir::HasValueOp>(loc, str); 345 }, 346 builder.createLinkOnceLinkage()); 347 return builder.create<fir::AddrOfOp>(loc, global.resultType(), 348 global.getSymbol()); 349 } 350 351 // Helper to generate StructureConstructor component values. 352 static fir::ExtendedValue 353 genConstantValue(Fortran::lower::AbstractConverter &converter, 354 mlir::Location loc, 355 const Fortran::lower::SomeExpr &constantExpr); 356 357 static mlir::Value genStructureComponentInit( 358 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 359 const Fortran::semantics::Symbol &sym, const Fortran::lower::SomeExpr &expr, 360 mlir::Value res) { 361 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 362 fir::RecordType recTy = mlir::cast<fir::RecordType>(res.getType()); 363 std::string name = converter.getRecordTypeFieldName(sym); 364 mlir::Type componentTy = recTy.getType(name); 365 auto fieldTy = fir::FieldType::get(recTy.getContext()); 366 assert(componentTy && "failed to retrieve component"); 367 // FIXME: type parameters must come from the derived-type-spec 368 auto field = builder.create<fir::FieldIndexOp>( 369 loc, fieldTy, name, recTy, 370 /*typeParams=*/mlir::ValueRange{} /*TODO*/); 371 372 if (Fortran::semantics::IsAllocatable(sym)) { 373 if (!Fortran::evaluate::IsNullPointer(expr)) { 374 fir::emitFatalError(loc, "constant structure constructor with an " 375 "allocatable component value that is not NULL"); 376 } else { 377 // Handle NULL() initialization 378 mlir::Value componentValue{fir::factory::createUnallocatedBox( 379 builder, loc, componentTy, std::nullopt)}; 380 componentValue = builder.createConvert(loc, componentTy, componentValue); 381 382 return builder.create<fir::InsertValueOp>( 383 loc, recTy, res, componentValue, 384 builder.getArrayAttr(field.getAttributes())); 385 } 386 } 387 388 if (Fortran::semantics::IsPointer(sym)) { 389 mlir::Value initialTarget; 390 if (Fortran::semantics::IsProcedure(sym)) { 391 if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr)) 392 initialTarget = 393 fir::factory::createNullBoxProc(builder, loc, componentTy); 394 else { 395 Fortran::lower::SymMap globalOpSymMap; 396 Fortran::lower::StatementContext stmtCtx; 397 auto box{getBase(Fortran::lower::convertExprToAddress( 398 loc, converter, expr, globalOpSymMap, stmtCtx))}; 399 initialTarget = builder.createConvert(loc, componentTy, box); 400 } 401 } else 402 initialTarget = Fortran::lower::genInitialDataTarget(converter, loc, 403 componentTy, expr); 404 res = builder.create<fir::InsertValueOp>( 405 loc, recTy, res, initialTarget, 406 builder.getArrayAttr(field.getAttributes())); 407 return res; 408 } 409 410 if (Fortran::lower::isDerivedTypeWithLenParameters(sym)) 411 TODO(loc, "component with length parameters in structure constructor"); 412 413 // Special handling for scalar c_ptr/c_funptr constants. The array constant 414 // must fall through to genConstantValue() below. 415 if (Fortran::semantics::IsBuiltinCPtr(sym) && sym.Rank() == 0 && 416 (Fortran::evaluate::GetLastSymbol(expr) || 417 Fortran::evaluate::IsNullPointer(expr))) { 418 // Builtin c_ptr and c_funptr have special handling because designators 419 // and NULL() are handled as initial values for them as an extension 420 // (otherwise only c_ptr_null/c_funptr_null are allowed and these are 421 // replaced by structure constructors by semantics, so GetLastSymbol 422 // returns nothing). 423 424 // The Ev::Expr is an initializer that is a pointer target (e.g., 'x' or 425 // NULL()) that must be inserted into an intermediate cptr record value's 426 // address field, which ought to be an intptr_t on the target. 427 mlir::Value addr = fir::getBase( 428 Fortran::lower::genExtAddrInInitializer(converter, loc, expr)); 429 if (mlir::isa<fir::BoxProcType>(addr.getType())) 430 addr = builder.create<fir::BoxAddrOp>(loc, addr); 431 assert((fir::isa_ref_type(addr.getType()) || 432 mlir::isa<mlir::FunctionType>(addr.getType())) && 433 "expect reference type for address field"); 434 assert(fir::isa_derived(componentTy) && 435 "expect C_PTR, C_FUNPTR to be a record"); 436 auto cPtrRecTy = mlir::cast<fir::RecordType>(componentTy); 437 llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName; 438 mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName); 439 auto addrField = builder.create<fir::FieldIndexOp>( 440 loc, fieldTy, addrFieldName, componentTy, 441 /*typeParams=*/mlir::ValueRange{}); 442 mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr); 443 auto undef = builder.create<fir::UndefOp>(loc, componentTy); 444 addr = builder.create<fir::InsertValueOp>( 445 loc, componentTy, undef, castAddr, 446 builder.getArrayAttr(addrField.getAttributes())); 447 res = builder.create<fir::InsertValueOp>( 448 loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes())); 449 return res; 450 } 451 452 mlir::Value val = fir::getBase(genConstantValue(converter, loc, expr)); 453 assert(!fir::isa_ref_type(val.getType()) && "expecting a constant value"); 454 mlir::Value castVal = builder.createConvert(loc, componentTy, val); 455 res = builder.create<fir::InsertValueOp>( 456 loc, recTy, res, castVal, builder.getArrayAttr(field.getAttributes())); 457 return res; 458 } 459 460 // Generate a StructureConstructor inlined (returns raw fir.type<T> value, 461 // not the address of a global constant). 462 static mlir::Value genInlinedStructureCtorLitImpl( 463 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 464 const Fortran::evaluate::StructureConstructor &ctor, mlir::Type type) { 465 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 466 auto recTy = mlir::cast<fir::RecordType>(type); 467 468 if (!converter.getLoweringOptions().getLowerToHighLevelFIR()) { 469 mlir::Value res = builder.create<fir::UndefOp>(loc, recTy); 470 for (const auto &[sym, expr] : ctor.values()) { 471 // Parent components need more work because they do not appear in the 472 // fir.rec type. 473 if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp)) 474 TODO(loc, "parent component in structure constructor"); 475 res = genStructureComponentInit(converter, loc, sym, expr.value(), res); 476 } 477 return res; 478 } 479 480 auto fieldTy = fir::FieldType::get(recTy.getContext()); 481 mlir::Value res{}; 482 // When the first structure component values belong to some parent type PT 483 // and the next values belong to a type extension ET, a new undef for ET must 484 // be created and the previous PT value inserted into it. There may 485 // be empty parent types in between ET and PT, hence the list and while loop. 486 auto insertParentValueIntoExtension = [&](mlir::Type typeExtension) { 487 assert(res && "res must be set"); 488 llvm::SmallVector<mlir::Type> parentTypes = {typeExtension}; 489 while (true) { 490 fir::RecordType last = mlir::cast<fir::RecordType>(parentTypes.back()); 491 mlir::Type next = 492 last.getType(0); // parent components are first in HLFIR. 493 if (next != res.getType()) 494 parentTypes.push_back(next); 495 else 496 break; 497 } 498 for (mlir::Type parentType : llvm::reverse(parentTypes)) { 499 auto undef = builder.create<fir::UndefOp>(loc, parentType); 500 fir::RecordType parentRecTy = mlir::cast<fir::RecordType>(parentType); 501 auto field = builder.create<fir::FieldIndexOp>( 502 loc, fieldTy, parentRecTy.getTypeList()[0].first, parentType, 503 /*typeParams=*/mlir::ValueRange{} /*TODO*/); 504 res = builder.create<fir::InsertValueOp>( 505 loc, parentRecTy, undef, res, 506 builder.getArrayAttr(field.getAttributes())); 507 } 508 }; 509 510 const Fortran::semantics::DerivedTypeSpec *curentType = nullptr; 511 for (const auto &[sym, expr] : ctor.values()) { 512 const Fortran::semantics::DerivedTypeSpec *componentParentType = 513 sym->owner().derivedTypeSpec(); 514 assert(componentParentType && "failed to retrieve component parent type"); 515 if (!res) { 516 mlir::Type parentType = converter.genType(*componentParentType); 517 curentType = componentParentType; 518 res = builder.create<fir::UndefOp>(loc, parentType); 519 } else if (*componentParentType != *curentType) { 520 mlir::Type parentType = converter.genType(*componentParentType); 521 insertParentValueIntoExtension(parentType); 522 curentType = componentParentType; 523 } 524 res = genStructureComponentInit(converter, loc, sym, expr.value(), res); 525 } 526 527 if (!res) // structure constructor for empty type. 528 return builder.create<fir::UndefOp>(loc, recTy); 529 530 // The last component may belong to a parent type. 531 if (res.getType() != recTy) 532 insertParentValueIntoExtension(recTy); 533 return res; 534 } 535 536 static mlir::Value genScalarLit( 537 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 538 const Fortran::evaluate::Scalar<Fortran::evaluate::SomeDerived> &value, 539 mlir::Type eleTy, bool outlineBigConstantsInReadOnlyMemory) { 540 if (!outlineBigConstantsInReadOnlyMemory) 541 return genInlinedStructureCtorLitImpl(converter, loc, value, eleTy); 542 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 543 auto expr = std::make_unique<Fortran::lower::SomeExpr>(toEvExpr( 544 Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived>(value))); 545 llvm::StringRef globalName = 546 converter.getUniqueLitName(loc, std::move(expr), eleTy); 547 fir::GlobalOp global = builder.getNamedGlobal(globalName); 548 if (!global) { 549 global = builder.createGlobalConstant( 550 loc, eleTy, globalName, 551 [&](fir::FirOpBuilder &builder) { 552 mlir::Value result = 553 genInlinedStructureCtorLitImpl(converter, loc, value, eleTy); 554 builder.create<fir::HasValueOp>(loc, result); 555 }, 556 builder.createInternalLinkage()); 557 } 558 return builder.create<fir::AddrOfOp>(loc, global.resultType(), 559 global.getSymbol()); 560 } 561 562 /// Create an evaluate::Constant<T> array to a fir.array<> value 563 /// built with a chain of fir.insert or fir.insert_on_range operations. 564 /// This is intended to be called when building the body of a fir.global. 565 template <typename T> 566 static mlir::Value 567 genInlinedArrayLit(Fortran::lower::AbstractConverter &converter, 568 mlir::Location loc, mlir::Type arrayTy, 569 const Fortran::evaluate::Constant<T> &con) { 570 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 571 mlir::IndexType idxTy = builder.getIndexType(); 572 Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); 573 auto createIdx = [&]() { 574 llvm::SmallVector<mlir::Attribute> idx; 575 for (size_t i = 0; i < subscripts.size(); ++i) 576 idx.push_back( 577 builder.getIntegerAttr(idxTy, subscripts[i] - con.lbounds()[i])); 578 return idx; 579 }; 580 mlir::Value array = builder.create<fir::UndefOp>(loc, arrayTy); 581 if (Fortran::evaluate::GetSize(con.shape()) == 0) 582 return array; 583 if constexpr (T::category == Fortran::common::TypeCategory::Character) { 584 do { 585 mlir::Value elementVal = 586 genScalarLit<T::kind>(builder, loc, con.At(subscripts), con.LEN(), 587 /*outlineInReadOnlyMemory=*/false); 588 array = builder.create<fir::InsertValueOp>( 589 loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx())); 590 } while (con.IncrementSubscripts(subscripts)); 591 } else if constexpr (T::category == Fortran::common::TypeCategory::Derived) { 592 do { 593 mlir::Type eleTy = 594 mlir::cast<fir::SequenceType>(arrayTy).getElementType(); 595 mlir::Value elementVal = 596 genScalarLit(converter, loc, con.At(subscripts), eleTy, 597 /*outlineInReadOnlyMemory=*/false); 598 array = builder.create<fir::InsertValueOp>( 599 loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx())); 600 } while (con.IncrementSubscripts(subscripts)); 601 } else { 602 llvm::SmallVector<mlir::Attribute> rangeStartIdx; 603 uint64_t rangeSize = 0; 604 mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getElementType(); 605 do { 606 auto getElementVal = [&]() { 607 return builder.createConvert(loc, eleTy, 608 genScalarLit<T::category, T::kind>( 609 builder, loc, con.At(subscripts))); 610 }; 611 Fortran::evaluate::ConstantSubscripts nextSubscripts = subscripts; 612 bool nextIsSame = con.IncrementSubscripts(nextSubscripts) && 613 con.At(subscripts) == con.At(nextSubscripts); 614 if (!rangeSize && !nextIsSame) { // single (non-range) value 615 array = builder.create<fir::InsertValueOp>( 616 loc, arrayTy, array, getElementVal(), 617 builder.getArrayAttr(createIdx())); 618 } else if (!rangeSize) { // start a range 619 rangeStartIdx = createIdx(); 620 rangeSize = 1; 621 } else if (nextIsSame) { // expand a range 622 ++rangeSize; 623 } else { // end a range 624 llvm::SmallVector<int64_t> rangeBounds; 625 llvm::SmallVector<mlir::Attribute> idx = createIdx(); 626 for (size_t i = 0; i < idx.size(); ++i) { 627 rangeBounds.push_back(mlir::cast<mlir::IntegerAttr>(rangeStartIdx[i]) 628 .getValue() 629 .getSExtValue()); 630 rangeBounds.push_back( 631 mlir::cast<mlir::IntegerAttr>(idx[i]).getValue().getSExtValue()); 632 } 633 array = builder.create<fir::InsertOnRangeOp>( 634 loc, arrayTy, array, getElementVal(), 635 builder.getIndexVectorAttr(rangeBounds)); 636 rangeSize = 0; 637 } 638 } while (con.IncrementSubscripts(subscripts)); 639 } 640 return array; 641 } 642 643 /// Convert an evaluate::Constant<T> array into a fir.ref<fir.array<>> value 644 /// that points to the storage of a fir.global in read only memory and is 645 /// initialized with the value of the constant. 646 /// This should not be called while generating the body of a fir.global. 647 template <typename T> 648 static mlir::Value 649 genOutlineArrayLit(Fortran::lower::AbstractConverter &converter, 650 mlir::Location loc, mlir::Type arrayTy, 651 const Fortran::evaluate::Constant<T> &constant) { 652 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 653 mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getElementType(); 654 llvm::StringRef globalName = converter.getUniqueLitName( 655 loc, std::make_unique<Fortran::lower::SomeExpr>(toEvExpr(constant)), 656 eleTy); 657 fir::GlobalOp global = builder.getNamedGlobal(globalName); 658 if (!global) { 659 // Using a dense attribute for the initial value instead of creating an 660 // intialization body speeds up MLIR/LLVM compilation, but this is not 661 // always possible. 662 if constexpr (T::category == Fortran::common::TypeCategory::Logical || 663 T::category == Fortran::common::TypeCategory::Integer || 664 T::category == Fortran::common::TypeCategory::Real || 665 T::category == Fortran::common::TypeCategory::Complex) { 666 global = DenseGlobalBuilder::tryCreating( 667 builder, loc, arrayTy, globalName, builder.createInternalLinkage(), 668 true, constant, {}); 669 } 670 if (!global) 671 // If the number of elements of the array is huge, the compilation may 672 // use a lot of memory and take a very long time to complete. 673 // Empirical evidence shows that an array with 150000 elements of 674 // complex type takes roughly 30 seconds to compile and uses 4GB of RAM, 675 // on a modern machine. 676 // It would be nice to add a driver switch to control the array size 677 // after which flang should not continue to compile. 678 global = builder.createGlobalConstant( 679 loc, arrayTy, globalName, 680 [&](fir::FirOpBuilder &builder) { 681 mlir::Value result = 682 genInlinedArrayLit(converter, loc, arrayTy, constant); 683 builder.create<fir::HasValueOp>(loc, result); 684 }, 685 builder.createInternalLinkage()); 686 } 687 return builder.create<fir::AddrOfOp>(loc, global.resultType(), 688 global.getSymbol()); 689 } 690 691 /// Convert an evaluate::Constant<T> array into an fir::ExtendedValue. 692 template <typename T> 693 static fir::ExtendedValue 694 genArrayLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 695 const Fortran::evaluate::Constant<T> &con, 696 bool outlineInReadOnlyMemory) { 697 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 698 Fortran::evaluate::ConstantSubscript size = 699 Fortran::evaluate::GetSize(con.shape()); 700 if (size > std::numeric_limits<std::uint32_t>::max()) 701 // llvm::SmallVector has limited size 702 TODO(loc, "Creation of very large array constants"); 703 fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); 704 llvm::SmallVector<std::int64_t> typeParams; 705 if constexpr (T::category == Fortran::common::TypeCategory::Character) 706 typeParams.push_back(con.LEN()); 707 mlir::Type eleTy; 708 if constexpr (T::category == Fortran::common::TypeCategory::Derived) 709 eleTy = Fortran::lower::translateDerivedTypeToFIRType( 710 converter, con.GetType().GetDerivedTypeSpec()); 711 else 712 eleTy = Fortran::lower::getFIRType(builder.getContext(), T::category, 713 T::kind, typeParams); 714 auto arrayTy = fir::SequenceType::get(shape, eleTy); 715 mlir::Value array = outlineInReadOnlyMemory 716 ? genOutlineArrayLit(converter, loc, arrayTy, con) 717 : genInlinedArrayLit(converter, loc, arrayTy, con); 718 719 mlir::IndexType idxTy = builder.getIndexType(); 720 llvm::SmallVector<mlir::Value> extents; 721 for (auto extent : shape) 722 extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); 723 // Convert lower bounds if they are not all ones. 724 llvm::SmallVector<mlir::Value> lbounds; 725 if (llvm::any_of(con.lbounds(), [](auto lb) { return lb != 1; })) 726 for (auto lb : con.lbounds()) 727 lbounds.push_back(builder.createIntegerConstant(loc, idxTy, lb)); 728 729 if constexpr (T::category == Fortran::common::TypeCategory::Character) { 730 mlir::Value len = builder.createIntegerConstant(loc, idxTy, con.LEN()); 731 return fir::CharArrayBoxValue{array, len, extents, lbounds}; 732 } else { 733 return fir::ArrayBoxValue{array, extents, lbounds}; 734 } 735 } 736 737 template <typename T> 738 fir::ExtendedValue Fortran::lower::ConstantBuilder<T>::gen( 739 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 740 const Fortran::evaluate::Constant<T> &constant, 741 bool outlineBigConstantsInReadOnlyMemory) { 742 if (constant.Rank() > 0) 743 return genArrayLit(converter, loc, constant, 744 outlineBigConstantsInReadOnlyMemory); 745 std::optional<Fortran::evaluate::Scalar<T>> opt = constant.GetScalarValue(); 746 assert(opt.has_value() && "constant has no value"); 747 if constexpr (T::category == Fortran::common::TypeCategory::Character) { 748 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 749 auto value = 750 genScalarLit<T::kind>(builder, loc, opt.value(), constant.LEN(), 751 outlineBigConstantsInReadOnlyMemory); 752 mlir::Value len = builder.createIntegerConstant( 753 loc, builder.getCharacterLengthType(), constant.LEN()); 754 return fir::CharBoxValue{value, len}; 755 } else if constexpr (T::category == Fortran::common::TypeCategory::Derived) { 756 mlir::Type eleTy = Fortran::lower::translateDerivedTypeToFIRType( 757 converter, opt->GetType().GetDerivedTypeSpec()); 758 return genScalarLit(converter, loc, *opt, eleTy, 759 outlineBigConstantsInReadOnlyMemory); 760 } else { 761 return genScalarLit<T::category, T::kind>(converter.getFirOpBuilder(), loc, 762 opt.value()); 763 } 764 } 765 766 static fir::ExtendedValue 767 genConstantValue(Fortran::lower::AbstractConverter &converter, 768 mlir::Location loc, 769 const Fortran::evaluate::Expr<Fortran::evaluate::SomeDerived> 770 &constantExpr) { 771 if (const auto *constant = std::get_if< 772 Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived>>( 773 &constantExpr.u)) 774 return Fortran::lower::convertConstant(converter, loc, *constant, 775 /*outline=*/false); 776 if (const auto *structCtor = 777 std::get_if<Fortran::evaluate::StructureConstructor>(&constantExpr.u)) 778 return Fortran::lower::genInlinedStructureCtorLit(converter, loc, 779 *structCtor); 780 fir::emitFatalError(loc, "not a constant derived type expression"); 781 } 782 783 template <Fortran::common::TypeCategory TC, int KIND> 784 static fir::ExtendedValue genConstantValue( 785 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 786 const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC, KIND>> 787 &constantExpr) { 788 using T = Fortran::evaluate::Type<TC, KIND>; 789 if (const auto *constant = 790 std::get_if<Fortran::evaluate::Constant<T>>(&constantExpr.u)) 791 return Fortran::lower::convertConstant(converter, loc, *constant, 792 /*outline=*/false); 793 fir::emitFatalError(loc, "not an evaluate::Constant<T>"); 794 } 795 796 static fir::ExtendedValue 797 genConstantValue(Fortran::lower::AbstractConverter &converter, 798 mlir::Location loc, 799 const Fortran::lower::SomeExpr &constantExpr) { 800 return Fortran::common::visit( 801 [&](const auto &x) -> fir::ExtendedValue { 802 using T = std::decay_t<decltype(x)>; 803 if constexpr (Fortran::common::HasMember< 804 T, Fortran::lower::CategoryExpression>) { 805 if constexpr (T::Result::category == 806 Fortran::common::TypeCategory::Derived) { 807 return genConstantValue(converter, loc, x); 808 } else { 809 return Fortran::common::visit( 810 [&](const auto &preciseKind) { 811 return genConstantValue(converter, loc, preciseKind); 812 }, 813 x.u); 814 } 815 } else { 816 fir::emitFatalError(loc, "unexpected typeless constant value"); 817 } 818 }, 819 constantExpr.u); 820 } 821 822 fir::ExtendedValue Fortran::lower::genInlinedStructureCtorLit( 823 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 824 const Fortran::evaluate::StructureConstructor &ctor) { 825 mlir::Type type = Fortran::lower::translateDerivedTypeToFIRType( 826 converter, ctor.derivedTypeSpec()); 827 return genInlinedStructureCtorLitImpl(converter, loc, ctor, type); 828 } 829 830 using namespace Fortran::evaluate; 831 FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::ConstantBuilder, ) 832