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