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 mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND, 231 std::nullopt); 232 if (KIND == 16) { 233 auto bigInt = 234 llvm::APInt(ty.getIntOrFloatBitWidth(), value.SignedDecimal(), 10); 235 return builder.create<mlir::arith::ConstantOp>( 236 loc, ty, mlir::IntegerAttr::get(ty, bigInt)); 237 } 238 return builder.createIntegerConstant(loc, ty, value.ToInt64()); 239 } else if constexpr (TC == Fortran::common::TypeCategory::Logical) { 240 return builder.createBool(loc, value.IsTrue()); 241 } else if constexpr (TC == Fortran::common::TypeCategory::Real) { 242 std::string str = value.DumpHexadecimal(); 243 if constexpr (KIND == 2) { 244 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEhalf(), str); 245 return genRealConstant<KIND>(builder, loc, floatVal); 246 } else if constexpr (KIND == 3) { 247 auto floatVal = consAPFloat(llvm::APFloatBase::BFloat(), str); 248 return genRealConstant<KIND>(builder, loc, floatVal); 249 } else if constexpr (KIND == 4) { 250 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEsingle(), str); 251 return genRealConstant<KIND>(builder, loc, floatVal); 252 } else if constexpr (KIND == 10) { 253 auto floatVal = consAPFloat(llvm::APFloatBase::x87DoubleExtended(), str); 254 return genRealConstant<KIND>(builder, loc, floatVal); 255 } else if constexpr (KIND == 16) { 256 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEquad(), str); 257 return genRealConstant<KIND>(builder, loc, floatVal); 258 } else { 259 // convert everything else to double 260 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEdouble(), str); 261 return genRealConstant<KIND>(builder, loc, floatVal); 262 } 263 } else if constexpr (TC == Fortran::common::TypeCategory::Complex) { 264 mlir::Value real = genScalarLit<Fortran::common::TypeCategory::Real, KIND>( 265 builder, loc, value.REAL()); 266 mlir::Value imag = genScalarLit<Fortran::common::TypeCategory::Real, KIND>( 267 builder, loc, value.AIMAG()); 268 return fir::factory::Complex{builder, loc}.createComplex(real, imag); 269 } else /*constexpr*/ { 270 llvm_unreachable("unhandled constant"); 271 } 272 } 273 274 /// Create fir::string_lit from a scalar character constant. 275 template <int KIND> 276 static fir::StringLitOp 277 createStringLitOp(fir::FirOpBuilder &builder, mlir::Location loc, 278 const Fortran::evaluate::Scalar<Fortran::evaluate::Type< 279 Fortran::common::TypeCategory::Character, KIND>> &value, 280 [[maybe_unused]] int64_t len) { 281 if constexpr (KIND == 1) { 282 assert(value.size() == static_cast<std::uint64_t>(len)); 283 return builder.createStringLitOp(loc, value); 284 } else { 285 using ET = typename std::decay_t<decltype(value)>::value_type; 286 fir::CharacterType type = 287 fir::CharacterType::get(builder.getContext(), KIND, len); 288 mlir::MLIRContext *context = builder.getContext(); 289 std::int64_t size = static_cast<std::int64_t>(value.size()); 290 mlir::ShapedType shape = mlir::RankedTensorType::get( 291 llvm::ArrayRef<std::int64_t>{size}, 292 mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8)); 293 auto denseAttr = mlir::DenseElementsAttr::get( 294 shape, llvm::ArrayRef<ET>{value.data(), value.size()}); 295 auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist()); 296 mlir::NamedAttribute dataAttr(denseTag, denseAttr); 297 auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size()); 298 mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len)); 299 llvm::SmallVector<mlir::NamedAttribute> attrs = {dataAttr, sizeAttr}; 300 return builder.create<fir::StringLitOp>( 301 loc, llvm::ArrayRef<mlir::Type>{type}, std::nullopt, attrs); 302 } 303 } 304 305 /// Convert a scalar literal CHARACTER to IR. 306 template <int KIND> 307 static mlir::Value 308 genScalarLit(fir::FirOpBuilder &builder, mlir::Location loc, 309 const Fortran::evaluate::Scalar<Fortran::evaluate::Type< 310 Fortran::common::TypeCategory::Character, KIND>> &value, 311 int64_t len, bool outlineInReadOnlyMemory) { 312 // When in an initializer context, construct the literal op itself and do 313 // not construct another constant object in rodata. 314 if (!outlineInReadOnlyMemory) 315 return createStringLitOp<KIND>(builder, loc, value, len); 316 317 // Otherwise, the string is in a plain old expression so "outline" the value 318 // in read only data by hash consing it to a constant literal object. 319 320 // ASCII global constants are created using an mlir string attribute. 321 if constexpr (KIND == 1) { 322 return fir::getBase(fir::factory::createStringLiteral(builder, loc, value)); 323 } 324 325 auto size = builder.getKindMap().getCharacterBitsize(KIND) / 8 * value.size(); 326 llvm::StringRef strVal(reinterpret_cast<const char *>(value.c_str()), size); 327 std::string globalName = fir::factory::uniqueCGIdent( 328 KIND == 1 ? "cl"s : "cl"s + std::to_string(KIND), strVal); 329 fir::GlobalOp global = builder.getNamedGlobal(globalName); 330 fir::CharacterType type = 331 fir::CharacterType::get(builder.getContext(), KIND, len); 332 if (!global) 333 global = builder.createGlobalConstant( 334 loc, type, globalName, 335 [&](fir::FirOpBuilder &builder) { 336 fir::StringLitOp str = 337 createStringLitOp<KIND>(builder, loc, value, len); 338 builder.create<fir::HasValueOp>(loc, str); 339 }, 340 builder.createLinkOnceLinkage()); 341 return builder.create<fir::AddrOfOp>(loc, global.resultType(), 342 global.getSymbol()); 343 } 344 345 // Helper to generate StructureConstructor component values. 346 static fir::ExtendedValue 347 genConstantValue(Fortran::lower::AbstractConverter &converter, 348 mlir::Location loc, 349 const Fortran::lower::SomeExpr &constantExpr); 350 351 static mlir::Value genStructureComponentInit( 352 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 353 const Fortran::semantics::Symbol &sym, const Fortran::lower::SomeExpr &expr, 354 mlir::Value res) { 355 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 356 fir::RecordType recTy = mlir::cast<fir::RecordType>(res.getType()); 357 std::string name = converter.getRecordTypeFieldName(sym); 358 mlir::Type componentTy = recTy.getType(name); 359 auto fieldTy = fir::FieldType::get(recTy.getContext()); 360 assert(componentTy && "failed to retrieve component"); 361 // FIXME: type parameters must come from the derived-type-spec 362 auto field = builder.create<fir::FieldIndexOp>( 363 loc, fieldTy, name, recTy, 364 /*typeParams=*/mlir::ValueRange{} /*TODO*/); 365 366 if (Fortran::semantics::IsAllocatable(sym)) { 367 if (!Fortran::evaluate::IsNullPointer(expr)) { 368 fir::emitFatalError(loc, "constant structure constructor with an " 369 "allocatable component value that is not NULL"); 370 } else { 371 // Handle NULL() initialization 372 mlir::Value componentValue{fir::factory::createUnallocatedBox( 373 builder, loc, componentTy, std::nullopt)}; 374 componentValue = builder.createConvert(loc, componentTy, componentValue); 375 376 return builder.create<fir::InsertValueOp>( 377 loc, recTy, res, componentValue, 378 builder.getArrayAttr(field.getAttributes())); 379 } 380 } 381 382 if (Fortran::semantics::IsPointer(sym)) { 383 mlir::Value initialTarget; 384 if (Fortran::semantics::IsProcedure(sym)) { 385 if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr)) 386 initialTarget = 387 fir::factory::createNullBoxProc(builder, loc, componentTy); 388 else { 389 Fortran::lower::SymMap globalOpSymMap; 390 Fortran::lower::StatementContext stmtCtx; 391 auto box{getBase(Fortran::lower::convertExprToAddress( 392 loc, converter, expr, globalOpSymMap, stmtCtx))}; 393 initialTarget = builder.createConvert(loc, componentTy, box); 394 } 395 } else 396 initialTarget = Fortran::lower::genInitialDataTarget(converter, loc, 397 componentTy, expr); 398 res = builder.create<fir::InsertValueOp>( 399 loc, recTy, res, initialTarget, 400 builder.getArrayAttr(field.getAttributes())); 401 return res; 402 } 403 404 if (Fortran::lower::isDerivedTypeWithLenParameters(sym)) 405 TODO(loc, "component with length parameters in structure constructor"); 406 407 // Special handling for scalar c_ptr/c_funptr constants. The array constant 408 // must fall through to genConstantValue() below. 409 if (Fortran::semantics::IsBuiltinCPtr(sym) && sym.Rank() == 0 && 410 (Fortran::evaluate::GetLastSymbol(expr) || 411 Fortran::evaluate::IsNullPointer(expr))) { 412 // Builtin c_ptr and c_funptr have special handling because designators 413 // and NULL() are handled as initial values for them as an extension 414 // (otherwise only c_ptr_null/c_funptr_null are allowed and these are 415 // replaced by structure constructors by semantics, so GetLastSymbol 416 // returns nothing). 417 418 // The Ev::Expr is an initializer that is a pointer target (e.g., 'x' or 419 // NULL()) that must be inserted into an intermediate cptr record value's 420 // address field, which ought to be an intptr_t on the target. 421 mlir::Value addr = fir::getBase( 422 Fortran::lower::genExtAddrInInitializer(converter, loc, expr)); 423 if (mlir::isa<fir::BoxProcType>(addr.getType())) 424 addr = builder.create<fir::BoxAddrOp>(loc, addr); 425 assert((fir::isa_ref_type(addr.getType()) || 426 mlir::isa<mlir::FunctionType>(addr.getType())) && 427 "expect reference type for address field"); 428 assert(fir::isa_derived(componentTy) && 429 "expect C_PTR, C_FUNPTR to be a record"); 430 auto cPtrRecTy = mlir::cast<fir::RecordType>(componentTy); 431 llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName; 432 mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName); 433 auto addrField = builder.create<fir::FieldIndexOp>( 434 loc, fieldTy, addrFieldName, componentTy, 435 /*typeParams=*/mlir::ValueRange{}); 436 mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr); 437 auto undef = builder.create<fir::UndefOp>(loc, componentTy); 438 addr = builder.create<fir::InsertValueOp>( 439 loc, componentTy, undef, castAddr, 440 builder.getArrayAttr(addrField.getAttributes())); 441 res = builder.create<fir::InsertValueOp>( 442 loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes())); 443 return res; 444 } 445 446 mlir::Value val = fir::getBase(genConstantValue(converter, loc, expr)); 447 assert(!fir::isa_ref_type(val.getType()) && "expecting a constant value"); 448 mlir::Value castVal = builder.createConvert(loc, componentTy, val); 449 res = builder.create<fir::InsertValueOp>( 450 loc, recTy, res, castVal, builder.getArrayAttr(field.getAttributes())); 451 return res; 452 } 453 454 // Generate a StructureConstructor inlined (returns raw fir.type<T> value, 455 // not the address of a global constant). 456 static mlir::Value genInlinedStructureCtorLitImpl( 457 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 458 const Fortran::evaluate::StructureConstructor &ctor, mlir::Type type) { 459 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 460 auto recTy = mlir::cast<fir::RecordType>(type); 461 462 if (!converter.getLoweringOptions().getLowerToHighLevelFIR()) { 463 mlir::Value res = builder.create<fir::UndefOp>(loc, recTy); 464 for (const auto &[sym, expr] : ctor.values()) { 465 // Parent components need more work because they do not appear in the 466 // fir.rec type. 467 if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp)) 468 TODO(loc, "parent component in structure constructor"); 469 res = genStructureComponentInit(converter, loc, sym, expr.value(), res); 470 } 471 return res; 472 } 473 474 auto fieldTy = fir::FieldType::get(recTy.getContext()); 475 mlir::Value res{}; 476 // When the first structure component values belong to some parent type PT 477 // and the next values belong to a type extension ET, a new undef for ET must 478 // be created and the previous PT value inserted into it. There may 479 // be empty parent types in between ET and PT, hence the list and while loop. 480 auto insertParentValueIntoExtension = [&](mlir::Type typeExtension) { 481 assert(res && "res must be set"); 482 llvm::SmallVector<mlir::Type> parentTypes = {typeExtension}; 483 while (true) { 484 fir::RecordType last = mlir::cast<fir::RecordType>(parentTypes.back()); 485 mlir::Type next = 486 last.getType(0); // parent components are first in HLFIR. 487 if (next != res.getType()) 488 parentTypes.push_back(next); 489 else 490 break; 491 } 492 for (mlir::Type parentType : llvm::reverse(parentTypes)) { 493 auto undef = builder.create<fir::UndefOp>(loc, parentType); 494 fir::RecordType parentRecTy = mlir::cast<fir::RecordType>(parentType); 495 auto field = builder.create<fir::FieldIndexOp>( 496 loc, fieldTy, parentRecTy.getTypeList()[0].first, parentType, 497 /*typeParams=*/mlir::ValueRange{} /*TODO*/); 498 res = builder.create<fir::InsertValueOp>( 499 loc, parentRecTy, undef, res, 500 builder.getArrayAttr(field.getAttributes())); 501 } 502 }; 503 504 const Fortran::semantics::DerivedTypeSpec *curentType = nullptr; 505 for (const auto &[sym, expr] : ctor.values()) { 506 const Fortran::semantics::DerivedTypeSpec *componentParentType = 507 sym->owner().derivedTypeSpec(); 508 assert(componentParentType && "failed to retrieve component parent type"); 509 if (!res) { 510 mlir::Type parentType = converter.genType(*componentParentType); 511 curentType = componentParentType; 512 res = builder.create<fir::UndefOp>(loc, parentType); 513 } else if (*componentParentType != *curentType) { 514 mlir::Type parentType = converter.genType(*componentParentType); 515 insertParentValueIntoExtension(parentType); 516 curentType = componentParentType; 517 } 518 res = genStructureComponentInit(converter, loc, sym, expr.value(), res); 519 } 520 521 if (!res) // structure constructor for empty type. 522 return builder.create<fir::UndefOp>(loc, recTy); 523 524 // The last component may belong to a parent type. 525 if (res.getType() != recTy) 526 insertParentValueIntoExtension(recTy); 527 return res; 528 } 529 530 static mlir::Value genScalarLit( 531 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 532 const Fortran::evaluate::Scalar<Fortran::evaluate::SomeDerived> &value, 533 mlir::Type eleTy, bool outlineBigConstantsInReadOnlyMemory) { 534 if (!outlineBigConstantsInReadOnlyMemory) 535 return genInlinedStructureCtorLitImpl(converter, loc, value, eleTy); 536 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 537 auto expr = std::make_unique<Fortran::lower::SomeExpr>(toEvExpr( 538 Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived>(value))); 539 llvm::StringRef globalName = 540 converter.getUniqueLitName(loc, std::move(expr), eleTy); 541 fir::GlobalOp global = builder.getNamedGlobal(globalName); 542 if (!global) { 543 global = builder.createGlobalConstant( 544 loc, eleTy, globalName, 545 [&](fir::FirOpBuilder &builder) { 546 mlir::Value result = 547 genInlinedStructureCtorLitImpl(converter, loc, value, eleTy); 548 builder.create<fir::HasValueOp>(loc, result); 549 }, 550 builder.createInternalLinkage()); 551 } 552 return builder.create<fir::AddrOfOp>(loc, global.resultType(), 553 global.getSymbol()); 554 } 555 556 /// Create an evaluate::Constant<T> array to a fir.array<> value 557 /// built with a chain of fir.insert or fir.insert_on_range operations. 558 /// This is intended to be called when building the body of a fir.global. 559 template <typename T> 560 static mlir::Value 561 genInlinedArrayLit(Fortran::lower::AbstractConverter &converter, 562 mlir::Location loc, mlir::Type arrayTy, 563 const Fortran::evaluate::Constant<T> &con) { 564 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 565 mlir::IndexType idxTy = builder.getIndexType(); 566 Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); 567 auto createIdx = [&]() { 568 llvm::SmallVector<mlir::Attribute> idx; 569 for (size_t i = 0; i < subscripts.size(); ++i) 570 idx.push_back( 571 builder.getIntegerAttr(idxTy, subscripts[i] - con.lbounds()[i])); 572 return idx; 573 }; 574 mlir::Value array = builder.create<fir::UndefOp>(loc, arrayTy); 575 if (Fortran::evaluate::GetSize(con.shape()) == 0) 576 return array; 577 if constexpr (T::category == Fortran::common::TypeCategory::Character) { 578 do { 579 mlir::Value elementVal = 580 genScalarLit<T::kind>(builder, loc, con.At(subscripts), con.LEN(), 581 /*outlineInReadOnlyMemory=*/false); 582 array = builder.create<fir::InsertValueOp>( 583 loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx())); 584 } while (con.IncrementSubscripts(subscripts)); 585 } else if constexpr (T::category == Fortran::common::TypeCategory::Derived) { 586 do { 587 mlir::Type eleTy = 588 mlir::cast<fir::SequenceType>(arrayTy).getElementType(); 589 mlir::Value elementVal = 590 genScalarLit(converter, loc, con.At(subscripts), eleTy, 591 /*outlineInReadOnlyMemory=*/false); 592 array = builder.create<fir::InsertValueOp>( 593 loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx())); 594 } while (con.IncrementSubscripts(subscripts)); 595 } else { 596 llvm::SmallVector<mlir::Attribute> rangeStartIdx; 597 uint64_t rangeSize = 0; 598 mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getElementType(); 599 do { 600 auto getElementVal = [&]() { 601 return builder.createConvert(loc, eleTy, 602 genScalarLit<T::category, T::kind>( 603 builder, loc, con.At(subscripts))); 604 }; 605 Fortran::evaluate::ConstantSubscripts nextSubscripts = subscripts; 606 bool nextIsSame = con.IncrementSubscripts(nextSubscripts) && 607 con.At(subscripts) == con.At(nextSubscripts); 608 if (!rangeSize && !nextIsSame) { // single (non-range) value 609 array = builder.create<fir::InsertValueOp>( 610 loc, arrayTy, array, getElementVal(), 611 builder.getArrayAttr(createIdx())); 612 } else if (!rangeSize) { // start a range 613 rangeStartIdx = createIdx(); 614 rangeSize = 1; 615 } else if (nextIsSame) { // expand a range 616 ++rangeSize; 617 } else { // end a range 618 llvm::SmallVector<int64_t> rangeBounds; 619 llvm::SmallVector<mlir::Attribute> idx = createIdx(); 620 for (size_t i = 0; i < idx.size(); ++i) { 621 rangeBounds.push_back(mlir::cast<mlir::IntegerAttr>(rangeStartIdx[i]) 622 .getValue() 623 .getSExtValue()); 624 rangeBounds.push_back( 625 mlir::cast<mlir::IntegerAttr>(idx[i]).getValue().getSExtValue()); 626 } 627 array = builder.create<fir::InsertOnRangeOp>( 628 loc, arrayTy, array, getElementVal(), 629 builder.getIndexVectorAttr(rangeBounds)); 630 rangeSize = 0; 631 } 632 } while (con.IncrementSubscripts(subscripts)); 633 } 634 return array; 635 } 636 637 /// Convert an evaluate::Constant<T> array into a fir.ref<fir.array<>> value 638 /// that points to the storage of a fir.global in read only memory and is 639 /// initialized with the value of the constant. 640 /// This should not be called while generating the body of a fir.global. 641 template <typename T> 642 static mlir::Value 643 genOutlineArrayLit(Fortran::lower::AbstractConverter &converter, 644 mlir::Location loc, mlir::Type arrayTy, 645 const Fortran::evaluate::Constant<T> &constant) { 646 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 647 mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getElementType(); 648 llvm::StringRef globalName = converter.getUniqueLitName( 649 loc, std::make_unique<Fortran::lower::SomeExpr>(toEvExpr(constant)), 650 eleTy); 651 fir::GlobalOp global = builder.getNamedGlobal(globalName); 652 if (!global) { 653 // Using a dense attribute for the initial value instead of creating an 654 // intialization body speeds up MLIR/LLVM compilation, but this is not 655 // always possible. 656 if constexpr (T::category == Fortran::common::TypeCategory::Logical || 657 T::category == Fortran::common::TypeCategory::Integer || 658 T::category == Fortran::common::TypeCategory::Real || 659 T::category == Fortran::common::TypeCategory::Complex) { 660 global = DenseGlobalBuilder::tryCreating( 661 builder, loc, arrayTy, globalName, builder.createInternalLinkage(), 662 true, constant, {}); 663 } 664 if (!global) 665 // If the number of elements of the array is huge, the compilation may 666 // use a lot of memory and take a very long time to complete. 667 // Empirical evidence shows that an array with 150000 elements of 668 // complex type takes roughly 30 seconds to compile and uses 4GB of RAM, 669 // on a modern machine. 670 // It would be nice to add a driver switch to control the array size 671 // after which flang should not continue to compile. 672 global = builder.createGlobalConstant( 673 loc, arrayTy, globalName, 674 [&](fir::FirOpBuilder &builder) { 675 mlir::Value result = 676 genInlinedArrayLit(converter, loc, arrayTy, constant); 677 builder.create<fir::HasValueOp>(loc, result); 678 }, 679 builder.createInternalLinkage()); 680 } 681 return builder.create<fir::AddrOfOp>(loc, global.resultType(), 682 global.getSymbol()); 683 } 684 685 /// Convert an evaluate::Constant<T> array into an fir::ExtendedValue. 686 template <typename T> 687 static fir::ExtendedValue 688 genArrayLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 689 const Fortran::evaluate::Constant<T> &con, 690 bool outlineInReadOnlyMemory) { 691 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 692 Fortran::evaluate::ConstantSubscript size = 693 Fortran::evaluate::GetSize(con.shape()); 694 if (size > std::numeric_limits<std::uint32_t>::max()) 695 // llvm::SmallVector has limited size 696 TODO(loc, "Creation of very large array constants"); 697 fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); 698 llvm::SmallVector<std::int64_t> typeParams; 699 if constexpr (T::category == Fortran::common::TypeCategory::Character) 700 typeParams.push_back(con.LEN()); 701 mlir::Type eleTy; 702 if constexpr (T::category == Fortran::common::TypeCategory::Derived) 703 eleTy = Fortran::lower::translateDerivedTypeToFIRType( 704 converter, con.GetType().GetDerivedTypeSpec()); 705 else 706 eleTy = Fortran::lower::getFIRType(builder.getContext(), T::category, 707 T::kind, typeParams); 708 auto arrayTy = fir::SequenceType::get(shape, eleTy); 709 mlir::Value array = outlineInReadOnlyMemory 710 ? genOutlineArrayLit(converter, loc, arrayTy, con) 711 : genInlinedArrayLit(converter, loc, arrayTy, con); 712 713 mlir::IndexType idxTy = builder.getIndexType(); 714 llvm::SmallVector<mlir::Value> extents; 715 for (auto extent : shape) 716 extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); 717 // Convert lower bounds if they are not all ones. 718 llvm::SmallVector<mlir::Value> lbounds; 719 if (llvm::any_of(con.lbounds(), [](auto lb) { return lb != 1; })) 720 for (auto lb : con.lbounds()) 721 lbounds.push_back(builder.createIntegerConstant(loc, idxTy, lb)); 722 723 if constexpr (T::category == Fortran::common::TypeCategory::Character) { 724 mlir::Value len = builder.createIntegerConstant(loc, idxTy, con.LEN()); 725 return fir::CharArrayBoxValue{array, len, extents, lbounds}; 726 } else { 727 return fir::ArrayBoxValue{array, extents, lbounds}; 728 } 729 } 730 731 template <typename T> 732 fir::ExtendedValue Fortran::lower::ConstantBuilder<T>::gen( 733 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 734 const Fortran::evaluate::Constant<T> &constant, 735 bool outlineBigConstantsInReadOnlyMemory) { 736 if (constant.Rank() > 0) 737 return genArrayLit(converter, loc, constant, 738 outlineBigConstantsInReadOnlyMemory); 739 std::optional<Fortran::evaluate::Scalar<T>> opt = constant.GetScalarValue(); 740 assert(opt.has_value() && "constant has no value"); 741 if constexpr (T::category == Fortran::common::TypeCategory::Character) { 742 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 743 auto value = 744 genScalarLit<T::kind>(builder, loc, opt.value(), constant.LEN(), 745 outlineBigConstantsInReadOnlyMemory); 746 mlir::Value len = builder.createIntegerConstant( 747 loc, builder.getCharacterLengthType(), constant.LEN()); 748 return fir::CharBoxValue{value, len}; 749 } else if constexpr (T::category == Fortran::common::TypeCategory::Derived) { 750 mlir::Type eleTy = Fortran::lower::translateDerivedTypeToFIRType( 751 converter, opt->GetType().GetDerivedTypeSpec()); 752 return genScalarLit(converter, loc, *opt, eleTy, 753 outlineBigConstantsInReadOnlyMemory); 754 } else { 755 return genScalarLit<T::category, T::kind>(converter.getFirOpBuilder(), loc, 756 opt.value()); 757 } 758 } 759 760 static fir::ExtendedValue 761 genConstantValue(Fortran::lower::AbstractConverter &converter, 762 mlir::Location loc, 763 const Fortran::evaluate::Expr<Fortran::evaluate::SomeDerived> 764 &constantExpr) { 765 if (const auto *constant = std::get_if< 766 Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived>>( 767 &constantExpr.u)) 768 return Fortran::lower::convertConstant(converter, loc, *constant, 769 /*outline=*/false); 770 if (const auto *structCtor = 771 std::get_if<Fortran::evaluate::StructureConstructor>(&constantExpr.u)) 772 return Fortran::lower::genInlinedStructureCtorLit(converter, loc, 773 *structCtor); 774 fir::emitFatalError(loc, "not a constant derived type expression"); 775 } 776 777 template <Fortran::common::TypeCategory TC, int KIND> 778 static fir::ExtendedValue genConstantValue( 779 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 780 const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC, KIND>> 781 &constantExpr) { 782 using T = Fortran::evaluate::Type<TC, KIND>; 783 if (const auto *constant = 784 std::get_if<Fortran::evaluate::Constant<T>>(&constantExpr.u)) 785 return Fortran::lower::convertConstant(converter, loc, *constant, 786 /*outline=*/false); 787 fir::emitFatalError(loc, "not an evaluate::Constant<T>"); 788 } 789 790 static fir::ExtendedValue 791 genConstantValue(Fortran::lower::AbstractConverter &converter, 792 mlir::Location loc, 793 const Fortran::lower::SomeExpr &constantExpr) { 794 return Fortran::common::visit( 795 [&](const auto &x) -> fir::ExtendedValue { 796 using T = std::decay_t<decltype(x)>; 797 if constexpr (Fortran::common::HasMember< 798 T, Fortran::lower::CategoryExpression>) { 799 if constexpr (T::Result::category == 800 Fortran::common::TypeCategory::Derived) { 801 return genConstantValue(converter, loc, x); 802 } else { 803 return Fortran::common::visit( 804 [&](const auto &preciseKind) { 805 return genConstantValue(converter, loc, preciseKind); 806 }, 807 x.u); 808 } 809 } else { 810 fir::emitFatalError(loc, "unexpected typeless constant value"); 811 } 812 }, 813 constantExpr.u); 814 } 815 816 fir::ExtendedValue Fortran::lower::genInlinedStructureCtorLit( 817 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 818 const Fortran::evaluate::StructureConstructor &ctor) { 819 mlir::Type type = Fortran::lower::translateDerivedTypeToFIRType( 820 converter, ctor.derivedTypeSpec()); 821 return genInlinedStructureCtorLitImpl(converter, loc, ctor, type); 822 } 823 824 using namespace Fortran::evaluate; 825 FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::ConstantBuilder, ) 826