855 lines · cpp
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-exception6//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 and30/// NaN strings as well. \p s is assumed to not contain any spaces.31static 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 implementation48//===----------------------------------------------------------------------===//49 50/// Generate an mlir attribute from a literal value51template <Fortran::common::TypeCategory TC, int KIND>52static 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 90namespace {91/// Helper class to lower an array constant to a global with an MLIR dense92/// attribute.93///94/// If we have an array of integer, real, complex, or logical, then we can95/// 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.99class DenseGlobalBuilder {100public: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 139private: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 using Element =149 Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>>;150 151 static_assert(TC != Fortran::common::TypeCategory::Character,152 "must be numerical or logical");153 auto attrTc = TC == Fortran::common::TypeCategory::Logical154 ? Fortran::common::TypeCategory::Integer155 : TC;156 attributeElementType =157 Fortran::lower::getFIRType(builder.getContext(), attrTc, KIND, {});158 159 const std::vector<Element> &values = constant.values();160 auto sameElements = [&]() -> bool {161 if (values.empty())162 return false;163 164 return std::all_of(values.begin(), values.end(),165 [&](const auto &v) { return v == values.front(); });166 };167 168 if (sameElements()) {169 auto attr = convertToAttribute<TC, KIND>(builder, values.front(),170 attributeElementType);171 attributes.assign(values.size(), attr);172 return;173 }174 175 for (auto element : values)176 attributes.push_back(177 convertToAttribute<TC, KIND>(builder, element, attributeElementType));178 }179 180 /// Try converting an evaluate::Expr to a list of MLIR attributes.181 template <typename SomeCat>182 void tryConvertingToAttributes(fir::FirOpBuilder &builder,183 const Fortran::evaluate::Expr<SomeCat> &expr) {184 Fortran::common::visit(185 [&](const auto &x) {186 using TR = Fortran::evaluate::ResultType<decltype(x)>;187 if (const auto *constant =188 std::get_if<Fortran::evaluate::Constant<TR>>(&x.u))189 tryConvertingToAttributes<TR::category, TR::kind>(builder,190 *constant);191 },192 expr.u);193 }194 195 /// Create a fir::Global if MLIR attributes have been successfully created by196 /// tryConvertingToAttributes.197 fir::GlobalOp tryCreatingGlobal(fir::FirOpBuilder &builder,198 mlir::Location loc, mlir::Type symTy,199 llvm::StringRef globalName,200 mlir::StringAttr linkage, bool isConst,201 cuf::DataAttributeAttr dataAttr) const {202 // Not a "trivial" intrinsic constant array, or empty array.203 if (!attributeElementType || attributes.empty())204 return {};205 206 assert(mlir::isa<fir::SequenceType>(symTy) && "expecting an array global");207 auto arrTy = mlir::cast<fir::SequenceType>(symTy);208 llvm::SmallVector<int64_t> tensorShape(arrTy.getShape());209 std::reverse(tensorShape.begin(), tensorShape.end());210 auto tensorTy =211 mlir::RankedTensorType::get(tensorShape, attributeElementType);212 auto init = mlir::DenseElementsAttr::get(tensorTy, attributes);213 return builder.createGlobal(loc, symTy, globalName, linkage, init, isConst,214 /*isTarget=*/false, dataAttr);215 }216 217 llvm::SmallVector<mlir::Attribute> attributes;218 mlir::Type attributeElementType;219};220} // namespace221 222fir::GlobalOp Fortran::lower::tryCreatingDenseGlobal(223 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type symTy,224 llvm::StringRef globalName, mlir::StringAttr linkage, bool isConst,225 const Fortran::lower::SomeExpr &initExpr, cuf::DataAttributeAttr dataAttr) {226 return DenseGlobalBuilder::tryCreating(builder, loc, symTy, globalName,227 linkage, isConst, initExpr, dataAttr);228}229 230//===----------------------------------------------------------------------===//231// Fortran::lower::convertConstant232// Lower a constant to a fir::ExtendedValue.233//===----------------------------------------------------------------------===//234 235/// Generate a real constant with a value `value`.236template <int KIND>237static mlir::Value genRealConstant(fir::FirOpBuilder &builder,238 mlir::Location loc,239 const llvm::APFloat &value) {240 mlir::Type fltTy = Fortran::lower::convertReal(builder.getContext(), KIND);241 return builder.createRealConstant(loc, fltTy, value);242}243 244/// Convert a scalar literal constant to IR.245template <Fortran::common::TypeCategory TC, int KIND>246static mlir::Value genScalarLit(247 fir::FirOpBuilder &builder, mlir::Location loc,248 const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> &value) {249 if constexpr (TC == Fortran::common::TypeCategory::Integer ||250 TC == Fortran::common::TypeCategory::Unsigned) {251 // MLIR requires constants to be signless252 mlir::Type ty = Fortran::lower::getFIRType(253 builder.getContext(), Fortran::common::TypeCategory::Integer, KIND, {});254 if (KIND == 16) {255 auto bigInt = llvm::APInt(ty.getIntOrFloatBitWidth(),256 TC == Fortran::common::TypeCategory::Unsigned257 ? value.UnsignedDecimal()258 : value.SignedDecimal(),259 10);260 return mlir::arith::ConstantOp::create(261 builder, loc, ty, mlir::IntegerAttr::get(ty, bigInt));262 }263 return builder.createIntegerConstant(loc, ty, value.ToInt64());264 } else if constexpr (TC == Fortran::common::TypeCategory::Logical) {265 return builder.createBool(loc, value.IsTrue());266 } else if constexpr (TC == Fortran::common::TypeCategory::Real) {267 std::string str = value.DumpHexadecimal();268 if constexpr (KIND == 2) {269 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEhalf(), str);270 return genRealConstant<KIND>(builder, loc, floatVal);271 } else if constexpr (KIND == 3) {272 auto floatVal = consAPFloat(llvm::APFloatBase::BFloat(), str);273 return genRealConstant<KIND>(builder, loc, floatVal);274 } else if constexpr (KIND == 4) {275 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEsingle(), str);276 return genRealConstant<KIND>(builder, loc, floatVal);277 } else if constexpr (KIND == 10) {278 auto floatVal = consAPFloat(llvm::APFloatBase::x87DoubleExtended(), str);279 return genRealConstant<KIND>(builder, loc, floatVal);280 } else if constexpr (KIND == 16) {281 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEquad(), str);282 return genRealConstant<KIND>(builder, loc, floatVal);283 } else {284 // convert everything else to double285 auto floatVal = consAPFloat(llvm::APFloatBase::IEEEdouble(), str);286 return genRealConstant<KIND>(builder, loc, floatVal);287 }288 } else if constexpr (TC == Fortran::common::TypeCategory::Complex) {289 mlir::Value real = genScalarLit<Fortran::common::TypeCategory::Real, KIND>(290 builder, loc, value.REAL());291 mlir::Value imag = genScalarLit<Fortran::common::TypeCategory::Real, KIND>(292 builder, loc, value.AIMAG());293 return fir::factory::Complex{builder, loc}.createComplex(real, imag);294 } else /*constexpr*/ {295 llvm_unreachable("unhandled constant");296 }297}298 299/// Create fir::string_lit from a scalar character constant.300template <int KIND>301static fir::StringLitOp302createStringLitOp(fir::FirOpBuilder &builder, mlir::Location loc,303 const Fortran::evaluate::Scalar<Fortran::evaluate::Type<304 Fortran::common::TypeCategory::Character, KIND>> &value,305 [[maybe_unused]] int64_t len) {306 if constexpr (KIND == 1) {307 assert(value.size() == static_cast<std::uint64_t>(len));308 return builder.createStringLitOp(loc, value);309 } else {310 using ET = typename std::decay_t<decltype(value)>::value_type;311 fir::CharacterType type =312 fir::CharacterType::get(builder.getContext(), KIND, len);313 mlir::MLIRContext *context = builder.getContext();314 std::int64_t size = static_cast<std::int64_t>(value.size());315 mlir::ShapedType shape = mlir::RankedTensorType::get(316 llvm::ArrayRef<std::int64_t>{size},317 mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8));318 auto denseAttr = mlir::DenseElementsAttr::get(319 shape, llvm::ArrayRef<ET>{value.data(), value.size()});320 auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist());321 mlir::NamedAttribute dataAttr(denseTag, denseAttr);322 auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size());323 mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len));324 llvm::SmallVector<mlir::NamedAttribute> attrs = {dataAttr, sizeAttr};325 return fir::StringLitOp::create(builder, loc,326 llvm::ArrayRef<mlir::Type>{type},327 mlir::ValueRange{}, attrs);328 }329}330 331/// Convert a scalar literal CHARACTER to IR.332template <int KIND>333static mlir::Value334genScalarLit(fir::FirOpBuilder &builder, mlir::Location loc,335 const Fortran::evaluate::Scalar<Fortran::evaluate::Type<336 Fortran::common::TypeCategory::Character, KIND>> &value,337 int64_t len, bool outlineInReadOnlyMemory) {338 // When in an initializer context, construct the literal op itself and do339 // not construct another constant object in rodata.340 if (!outlineInReadOnlyMemory)341 return createStringLitOp<KIND>(builder, loc, value, len);342 343 // Otherwise, the string is in a plain old expression so "outline" the value344 // in read only data by hash consing it to a constant literal object.345 346 // ASCII global constants are created using an mlir string attribute.347 if constexpr (KIND == 1) {348 return fir::getBase(fir::factory::createStringLiteral(builder, loc, value));349 }350 351 auto size = builder.getKindMap().getCharacterBitsize(KIND) / 8 * value.size();352 llvm::StringRef strVal(reinterpret_cast<const char *>(value.c_str()), size);353 std::string globalName = fir::factory::uniqueCGIdent(354 KIND == 1 ? "cl"s : "cl"s + std::to_string(KIND), strVal);355 fir::GlobalOp global = builder.getNamedGlobal(globalName);356 fir::CharacterType type =357 fir::CharacterType::get(builder.getContext(), KIND, len);358 if (!global)359 global = builder.createGlobalConstant(360 loc, type, globalName,361 [&](fir::FirOpBuilder &builder) {362 fir::StringLitOp str =363 createStringLitOp<KIND>(builder, loc, value, len);364 fir::HasValueOp::create(builder, loc, str);365 },366 builder.createLinkOnceLinkage());367 return fir::AddrOfOp::create(builder, loc, global.resultType(),368 global.getSymbol());369}370 371// Helper to generate StructureConstructor component values.372static fir::ExtendedValue373genConstantValue(Fortran::lower::AbstractConverter &converter,374 mlir::Location loc,375 const Fortran::lower::SomeExpr &constantExpr);376 377static mlir::Value genStructureComponentInit(378 Fortran::lower::AbstractConverter &converter, mlir::Location loc,379 const Fortran::semantics::Symbol &sym, const Fortran::lower::SomeExpr &expr,380 mlir::Value res) {381 fir::FirOpBuilder &builder = converter.getFirOpBuilder();382 fir::RecordType recTy = mlir::cast<fir::RecordType>(res.getType());383 std::string name = converter.getRecordTypeFieldName(sym);384 mlir::Type componentTy = recTy.getType(name);385 auto fieldTy = fir::FieldType::get(recTy.getContext());386 assert(componentTy && "failed to retrieve component");387 // FIXME: type parameters must come from the derived-type-spec388 auto field =389 fir::FieldIndexOp::create(builder, loc, fieldTy, name, recTy,390 /*typeParams=*/mlir::ValueRange{} /*TODO*/);391 392 if (Fortran::semantics::IsAllocatable(sym)) {393 if (!Fortran::evaluate::IsNullPointerOrAllocatable(&expr)) {394 fir::emitFatalError(loc, "constant structure constructor with an "395 "allocatable component value that is not NULL");396 } else {397 // Handle NULL() initialization398 mlir::Value componentValue{399 fir::factory::createUnallocatedBox(builder, loc, componentTy, {})};400 componentValue = builder.createConvert(loc, componentTy, componentValue);401 402 return fir::InsertValueOp::create(403 builder, loc, recTy, res, componentValue,404 builder.getArrayAttr(field.getAttributes()));405 }406 }407 408 if (Fortran::semantics::IsPointer(sym)) {409 mlir::Value initialTarget;410 if (Fortran::semantics::IsProcedure(sym)) {411 if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr))412 initialTarget =413 fir::factory::createNullBoxProc(builder, loc, componentTy);414 else {415 Fortran::lower::SymMap globalOpSymMap;416 Fortran::lower::StatementContext stmtCtx;417 auto box{getBase(Fortran::lower::convertExprToAddress(418 loc, converter, expr, globalOpSymMap, stmtCtx))};419 initialTarget = builder.createConvert(loc, componentTy, box);420 }421 } else422 initialTarget = Fortran::lower::genInitialDataTarget(converter, loc,423 componentTy, expr);424 res =425 fir::InsertValueOp::create(builder, loc, recTy, res, initialTarget,426 builder.getArrayAttr(field.getAttributes()));427 return res;428 }429 430 if (Fortran::lower::isDerivedTypeWithLenParameters(sym))431 TODO(loc, "component with length parameters in structure constructor");432 433 // Special handling for scalar c_ptr/c_funptr constants. The array constant434 // must fall through to genConstantValue() below.435 if (Fortran::semantics::IsBuiltinCPtr(sym) && sym.Rank() == 0 &&436 (Fortran::evaluate::GetLastSymbol(expr) ||437 Fortran::evaluate::IsNullPointer(&expr))) {438 // Builtin c_ptr and c_funptr have special handling because designators439 // and NULL() are handled as initial values for them as an extension440 // (otherwise only c_ptr_null/c_funptr_null are allowed and these are441 // replaced by structure constructors by semantics, so GetLastSymbol442 // returns nothing).443 444 // The Ev::Expr is an initializer that is a pointer target (e.g., 'x' or445 // NULL()) that must be inserted into an intermediate cptr record value's446 // address field, which ought to be an intptr_t on the target.447 mlir::Value addr = fir::getBase(448 Fortran::lower::genExtAddrInInitializer(converter, loc, expr));449 if (mlir::isa<fir::BoxProcType>(addr.getType()))450 addr = fir::BoxAddrOp::create(builder, loc, addr);451 assert((fir::isa_ref_type(addr.getType()) ||452 mlir::isa<mlir::FunctionType>(addr.getType())) &&453 "expect reference type for address field");454 assert(fir::isa_derived(componentTy) &&455 "expect C_PTR, C_FUNPTR to be a record");456 auto cPtrRecTy = mlir::cast<fir::RecordType>(componentTy);457 llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName;458 mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName);459 auto addrField = fir::FieldIndexOp::create(460 builder, loc, fieldTy, addrFieldName, componentTy,461 /*typeParams=*/mlir::ValueRange{});462 mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr);463 auto undef = fir::UndefOp::create(builder, loc, componentTy);464 addr = fir::InsertValueOp::create(465 builder, loc, componentTy, undef, castAddr,466 builder.getArrayAttr(addrField.getAttributes()));467 res =468 fir::InsertValueOp::create(builder, loc, recTy, res, addr,469 builder.getArrayAttr(field.getAttributes()));470 return res;471 }472 473 mlir::Value val = fir::getBase(genConstantValue(converter, loc, expr));474 assert(!fir::isa_ref_type(val.getType()) && "expecting a constant value");475 mlir::Value castVal = builder.createConvert(loc, componentTy, val);476 res = fir::InsertValueOp::create(builder, loc, recTy, res, castVal,477 builder.getArrayAttr(field.getAttributes()));478 return res;479}480 481// Generate a StructureConstructor inlined (returns raw fir.type<T> value,482// not the address of a global constant).483static mlir::Value genInlinedStructureCtorLitImpl(484 Fortran::lower::AbstractConverter &converter, mlir::Location loc,485 const Fortran::evaluate::StructureConstructor &ctor, mlir::Type type) {486 fir::FirOpBuilder &builder = converter.getFirOpBuilder();487 auto recTy = mlir::cast<fir::RecordType>(type);488 489 if (!converter.getLoweringOptions().getLowerToHighLevelFIR()) {490 mlir::Value res = fir::UndefOp::create(builder, loc, recTy);491 for (const auto &[sym, expr] : ctor.values()) {492 // Parent components need more work because they do not appear in the493 // fir.rec type.494 if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp))495 TODO(loc, "parent component in structure constructor");496 res = genStructureComponentInit(converter, loc, sym, expr.value(), res);497 }498 return res;499 }500 501 auto fieldTy = fir::FieldType::get(recTy.getContext());502 mlir::Value res{};503 // When the first structure component values belong to some parent type PT504 // and the next values belong to a type extension ET, a new undef for ET must505 // be created and the previous PT value inserted into it. There may506 // be empty parent types in between ET and PT, hence the list and while loop.507 auto insertParentValueIntoExtension = [&](mlir::Type typeExtension) {508 assert(res && "res must be set");509 llvm::SmallVector<mlir::Type> parentTypes = {typeExtension};510 while (true) {511 fir::RecordType last = mlir::cast<fir::RecordType>(parentTypes.back());512 mlir::Type next =513 last.getType(0); // parent components are first in HLFIR.514 if (next != res.getType())515 parentTypes.push_back(next);516 else517 break;518 }519 for (mlir::Type parentType : llvm::reverse(parentTypes)) {520 auto undef = fir::UndefOp::create(builder, loc, parentType);521 fir::RecordType parentRecTy = mlir::cast<fir::RecordType>(parentType);522 auto field = fir::FieldIndexOp::create(523 builder, loc, fieldTy, parentRecTy.getTypeList()[0].first, parentType,524 /*typeParams=*/mlir::ValueRange{} /*TODO*/);525 res = fir::InsertValueOp::create(526 builder, loc, parentRecTy, undef, res,527 builder.getArrayAttr(field.getAttributes()));528 }529 };530 531 const Fortran::semantics::DerivedTypeSpec *curentType = nullptr;532 for (const auto &[sym, expr] : ctor.values()) {533 const Fortran::semantics::DerivedTypeSpec *componentParentType =534 sym->owner().derivedTypeSpec();535 assert(componentParentType && "failed to retrieve component parent type");536 if (!res) {537 mlir::Type parentType = converter.genType(*componentParentType);538 curentType = componentParentType;539 res = fir::UndefOp::create(builder, loc, parentType);540 } else if (*componentParentType != *curentType) {541 mlir::Type parentType = converter.genType(*componentParentType);542 insertParentValueIntoExtension(parentType);543 curentType = componentParentType;544 }545 res = genStructureComponentInit(converter, loc, sym, expr.value(), res);546 }547 548 if (!res) // structure constructor for empty type.549 return fir::UndefOp::create(builder, loc, recTy);550 551 // The last component may belong to a parent type.552 if (res.getType() != recTy)553 insertParentValueIntoExtension(recTy);554 return res;555}556 557static mlir::Value genScalarLit(558 Fortran::lower::AbstractConverter &converter, mlir::Location loc,559 const Fortran::evaluate::Scalar<Fortran::evaluate::SomeDerived> &value,560 mlir::Type eleTy, bool outlineBigConstantsInReadOnlyMemory) {561 if (!outlineBigConstantsInReadOnlyMemory)562 return genInlinedStructureCtorLitImpl(converter, loc, value, eleTy);563 fir::FirOpBuilder &builder = converter.getFirOpBuilder();564 auto expr = std::make_unique<Fortran::lower::SomeExpr>(toEvExpr(565 Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived>(value)));566 llvm::StringRef globalName =567 converter.getUniqueLitName(loc, std::move(expr), eleTy);568 fir::GlobalOp global = builder.getNamedGlobal(globalName);569 if (!global) {570 global = builder.createGlobalConstant(571 loc, eleTy, globalName,572 [&](fir::FirOpBuilder &builder) {573 mlir::Value result =574 genInlinedStructureCtorLitImpl(converter, loc, value, eleTy);575 fir::HasValueOp::create(builder, loc, result);576 },577 builder.createInternalLinkage());578 }579 return fir::AddrOfOp::create(builder, loc, global.resultType(),580 global.getSymbol());581}582 583/// Create an evaluate::Constant<T> array to a fir.array<> value584/// built with a chain of fir.insert or fir.insert_on_range operations.585/// This is intended to be called when building the body of a fir.global.586template <typename T>587static mlir::Value588genInlinedArrayLit(Fortran::lower::AbstractConverter &converter,589 mlir::Location loc, mlir::Type arrayTy,590 const Fortran::evaluate::Constant<T> &con) {591 fir::FirOpBuilder &builder = converter.getFirOpBuilder();592 mlir::IndexType idxTy = builder.getIndexType();593 Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds();594 auto createIdx = [&]() {595 llvm::SmallVector<mlir::Attribute> idx;596 for (size_t i = 0; i < subscripts.size(); ++i)597 idx.push_back(598 builder.getIntegerAttr(idxTy, subscripts[i] - con.lbounds()[i]));599 return idx;600 };601 mlir::Value array = fir::UndefOp::create(builder, loc, arrayTy);602 if (Fortran::evaluate::GetSize(con.shape()) == 0)603 return array;604 if constexpr (T::category == Fortran::common::TypeCategory::Character) {605 do {606 mlir::Value elementVal =607 genScalarLit<T::kind>(builder, loc, con.At(subscripts), con.LEN(),608 /*outlineInReadOnlyMemory=*/false);609 array =610 fir::InsertValueOp::create(builder, loc, arrayTy, array, elementVal,611 builder.getArrayAttr(createIdx()));612 } while (con.IncrementSubscripts(subscripts));613 } else if constexpr (T::category == Fortran::common::TypeCategory::Derived) {614 do {615 mlir::Type eleTy =616 mlir::cast<fir::SequenceType>(arrayTy).getElementType();617 mlir::Value elementVal =618 genScalarLit(converter, loc, con.At(subscripts), eleTy,619 /*outlineInReadOnlyMemory=*/false);620 array =621 fir::InsertValueOp::create(builder, loc, arrayTy, array, elementVal,622 builder.getArrayAttr(createIdx()));623 } while (con.IncrementSubscripts(subscripts));624 } else {625 llvm::SmallVector<mlir::Attribute> rangeStartIdx;626 uint64_t rangeSize = 0;627 mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getElementType();628 do {629 auto getElementVal = [&]() {630 return builder.createConvert(loc, eleTy,631 genScalarLit<T::category, T::kind>(632 builder, loc, con.At(subscripts)));633 };634 Fortran::evaluate::ConstantSubscripts nextSubscripts = subscripts;635 bool nextIsSame = con.IncrementSubscripts(nextSubscripts) &&636 con.At(subscripts) == con.At(nextSubscripts);637 if (!rangeSize && !nextIsSame) { // single (non-range) value638 array = fir::InsertValueOp::create(builder, loc, arrayTy, array,639 getElementVal(),640 builder.getArrayAttr(createIdx()));641 } else if (!rangeSize) { // start a range642 rangeStartIdx = createIdx();643 rangeSize = 1;644 } else if (nextIsSame) { // expand a range645 ++rangeSize;646 } else { // end a range647 llvm::SmallVector<int64_t> rangeBounds;648 llvm::SmallVector<mlir::Attribute> idx = createIdx();649 for (size_t i = 0; i < idx.size(); ++i) {650 rangeBounds.push_back(mlir::cast<mlir::IntegerAttr>(rangeStartIdx[i])651 .getValue()652 .getSExtValue());653 rangeBounds.push_back(654 mlir::cast<mlir::IntegerAttr>(idx[i]).getValue().getSExtValue());655 }656 array = fir::InsertOnRangeOp::create(657 builder, loc, arrayTy, array, getElementVal(),658 builder.getIndexVectorAttr(rangeBounds));659 rangeSize = 0;660 }661 } while (con.IncrementSubscripts(subscripts));662 }663 return array;664}665 666/// Convert an evaluate::Constant<T> array into a fir.ref<fir.array<>> value667/// that points to the storage of a fir.global in read only memory and is668/// initialized with the value of the constant.669/// This should not be called while generating the body of a fir.global.670template <typename T>671static mlir::Value672genOutlineArrayLit(Fortran::lower::AbstractConverter &converter,673 mlir::Location loc, mlir::Type arrayTy,674 const Fortran::evaluate::Constant<T> &constant) {675 fir::FirOpBuilder &builder = converter.getFirOpBuilder();676 mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getElementType();677 llvm::StringRef globalName = converter.getUniqueLitName(678 loc, std::make_unique<Fortran::lower::SomeExpr>(toEvExpr(constant)),679 eleTy);680 fir::GlobalOp global = builder.getNamedGlobal(globalName);681 if (!global) {682 // Using a dense attribute for the initial value instead of creating an683 // intialization body speeds up MLIR/LLVM compilation, but this is not684 // always possible.685 if constexpr (T::category == Fortran::common::TypeCategory::Logical ||686 T::category == Fortran::common::TypeCategory::Integer ||687 T::category == Fortran::common::TypeCategory::Real ||688 T::category == Fortran::common::TypeCategory::Complex) {689 global = DenseGlobalBuilder::tryCreating(690 builder, loc, arrayTy, globalName, builder.createInternalLinkage(),691 true, constant, {});692 }693 if (!global)694 // If the number of elements of the array is huge, the compilation may695 // use a lot of memory and take a very long time to complete.696 // Empirical evidence shows that an array with 150000 elements of697 // complex type takes roughly 30 seconds to compile and uses 4GB of RAM,698 // on a modern machine.699 // It would be nice to add a driver switch to control the array size700 // after which flang should not continue to compile.701 global = builder.createGlobalConstant(702 loc, arrayTy, globalName,703 [&](fir::FirOpBuilder &builder) {704 mlir::Value result =705 genInlinedArrayLit(converter, loc, arrayTy, constant);706 fir::HasValueOp::create(builder, loc, result);707 },708 builder.createInternalLinkage());709 }710 return fir::AddrOfOp::create(builder, loc, global.resultType(),711 global.getSymbol());712}713 714/// Convert an evaluate::Constant<T> array into an fir::ExtendedValue.715template <typename T>716static fir::ExtendedValue717genArrayLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc,718 const Fortran::evaluate::Constant<T> &con,719 bool outlineInReadOnlyMemory) {720 fir::FirOpBuilder &builder = converter.getFirOpBuilder();721 Fortran::evaluate::ConstantSubscript size =722 Fortran::evaluate::GetSize(con.shape());723 if (size > std::numeric_limits<std::uint32_t>::max())724 // llvm::SmallVector has limited size725 TODO(loc, "Creation of very large array constants");726 fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end());727 llvm::SmallVector<std::int64_t> typeParams;728 if constexpr (T::category == Fortran::common::TypeCategory::Character)729 typeParams.push_back(con.LEN());730 mlir::Type eleTy;731 if constexpr (T::category == Fortran::common::TypeCategory::Derived)732 eleTy = Fortran::lower::translateDerivedTypeToFIRType(733 converter, con.GetType().GetDerivedTypeSpec());734 else735 eleTy = Fortran::lower::getFIRType(builder.getContext(), T::category,736 T::kind, typeParams);737 auto arrayTy = fir::SequenceType::get(shape, eleTy);738 mlir::Value array = outlineInReadOnlyMemory739 ? genOutlineArrayLit(converter, loc, arrayTy, con)740 : genInlinedArrayLit(converter, loc, arrayTy, con);741 742 mlir::IndexType idxTy = builder.getIndexType();743 llvm::SmallVector<mlir::Value> extents;744 for (auto extent : shape)745 extents.push_back(builder.createIntegerConstant(loc, idxTy, extent));746 // Convert lower bounds if they are not all ones.747 llvm::SmallVector<mlir::Value> lbounds;748 if (llvm::any_of(con.lbounds(), [](auto lb) { return lb != 1; }))749 for (auto lb : con.lbounds())750 lbounds.push_back(builder.createIntegerConstant(loc, idxTy, lb));751 752 if constexpr (T::category == Fortran::common::TypeCategory::Character) {753 mlir::Value len = builder.createIntegerConstant(loc, idxTy, con.LEN());754 return fir::CharArrayBoxValue{array, len, extents, lbounds};755 } else {756 return fir::ArrayBoxValue{array, extents, lbounds};757 }758}759 760template <typename T>761fir::ExtendedValue Fortran::lower::ConstantBuilder<T>::gen(762 Fortran::lower::AbstractConverter &converter, mlir::Location loc,763 const Fortran::evaluate::Constant<T> &constant,764 bool outlineBigConstantsInReadOnlyMemory) {765 if (constant.Rank() > 0)766 return genArrayLit(converter, loc, constant,767 outlineBigConstantsInReadOnlyMemory);768 std::optional<Fortran::evaluate::Scalar<T>> opt = constant.GetScalarValue();769 assert(opt.has_value() && "constant has no value");770 if constexpr (T::category == Fortran::common::TypeCategory::Character) {771 fir::FirOpBuilder &builder = converter.getFirOpBuilder();772 auto value =773 genScalarLit<T::kind>(builder, loc, opt.value(), constant.LEN(),774 outlineBigConstantsInReadOnlyMemory);775 mlir::Value len = builder.createIntegerConstant(776 loc, builder.getCharacterLengthType(), constant.LEN());777 return fir::CharBoxValue{value, len};778 } else if constexpr (T::category == Fortran::common::TypeCategory::Derived) {779 mlir::Type eleTy = Fortran::lower::translateDerivedTypeToFIRType(780 converter, opt->GetType().GetDerivedTypeSpec());781 return genScalarLit(converter, loc, *opt, eleTy,782 outlineBigConstantsInReadOnlyMemory);783 } else {784 return genScalarLit<T::category, T::kind>(converter.getFirOpBuilder(), loc,785 opt.value());786 }787}788 789static fir::ExtendedValue790genConstantValue(Fortran::lower::AbstractConverter &converter,791 mlir::Location loc,792 const Fortran::evaluate::Expr<Fortran::evaluate::SomeDerived>793 &constantExpr) {794 if (const auto *constant = std::get_if<795 Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived>>(796 &constantExpr.u))797 return Fortran::lower::convertConstant(converter, loc, *constant,798 /*outline=*/false);799 if (const auto *structCtor =800 std::get_if<Fortran::evaluate::StructureConstructor>(&constantExpr.u))801 return Fortran::lower::genInlinedStructureCtorLit(converter, loc,802 *structCtor);803 fir::emitFatalError(loc, "not a constant derived type expression");804}805 806template <Fortran::common::TypeCategory TC, int KIND>807static fir::ExtendedValue genConstantValue(808 Fortran::lower::AbstractConverter &converter, mlir::Location loc,809 const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC, KIND>>810 &constantExpr) {811 using T = Fortran::evaluate::Type<TC, KIND>;812 if (const auto *constant =813 std::get_if<Fortran::evaluate::Constant<T>>(&constantExpr.u))814 return Fortran::lower::convertConstant(converter, loc, *constant,815 /*outline=*/false);816 fir::emitFatalError(loc, "not an evaluate::Constant<T>");817}818 819static fir::ExtendedValue820genConstantValue(Fortran::lower::AbstractConverter &converter,821 mlir::Location loc,822 const Fortran::lower::SomeExpr &constantExpr) {823 return Fortran::common::visit(824 [&](const auto &x) -> fir::ExtendedValue {825 using T = std::decay_t<decltype(x)>;826 if constexpr (Fortran::common::HasMember<827 T, Fortran::lower::CategoryExpression>) {828 if constexpr (T::Result::category ==829 Fortran::common::TypeCategory::Derived) {830 return genConstantValue(converter, loc, x);831 } else {832 return Fortran::common::visit(833 [&](const auto &preciseKind) {834 return genConstantValue(converter, loc, preciseKind);835 },836 x.u);837 }838 } else {839 fir::emitFatalError(loc, "unexpected typeless constant value");840 }841 },842 constantExpr.u);843}844 845fir::ExtendedValue Fortran::lower::genInlinedStructureCtorLit(846 Fortran::lower::AbstractConverter &converter, mlir::Location loc,847 const Fortran::evaluate::StructureConstructor &ctor) {848 mlir::Type type = Fortran::lower::translateDerivedTypeToFIRType(849 converter, ctor.derivedTypeSpec());850 return genInlinedStructureCtorLitImpl(converter, loc, ctor, type);851}852 853using namespace Fortran::evaluate;854FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::ConstantBuilder, )855