brintos / llvm-project-archived public Read only

1//===-- FIRBuilder.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#include "flang/Optimizer/Builder/FIRBuilder.h"10#include "flang/Optimizer/Builder/BoxValue.h"11#include "flang/Optimizer/Builder/Character.h"12#include "flang/Optimizer/Builder/Complex.h"13#include "flang/Optimizer/Builder/MutableBox.h"14#include "flang/Optimizer/Builder/Runtime/Allocatable.h"15#include "flang/Optimizer/Builder/Runtime/Assign.h"16#include "flang/Optimizer/Builder/Runtime/Derived.h"17#include "flang/Optimizer/Builder/Todo.h"18#include "flang/Optimizer/Dialect/CUF/CUFOps.h"19#include "flang/Optimizer/Dialect/FIRAttr.h"20#include "flang/Optimizer/Dialect/FIRDialect.h"21#include "flang/Optimizer/Dialect/FIROpsSupport.h"22#include "flang/Optimizer/Dialect/FIRType.h"23#include "flang/Optimizer/Support/DataLayout.h"24#include "flang/Optimizer/Support/FatalError.h"25#include "flang/Optimizer/Support/InternalNames.h"26#include "flang/Optimizer/Support/Utils.h"27#include "mlir/Dialect/LLVMIR/LLVMDialect.h"28#include "mlir/Dialect/OpenACC/OpenACC.h"29#include "mlir/Dialect/OpenMP/OpenMPDialect.h"30#include "llvm/ADT/ArrayRef.h"31#include "llvm/ADT/StringExtras.h"32#include "llvm/Support/CommandLine.h"33#include "llvm/Support/ErrorHandling.h"34#include "llvm/Support/MD5.h"35#include <optional>36 37static llvm::cl::opt<std::size_t>38    nameLengthHashSize("length-to-hash-string-literal",39                       llvm::cl::desc("string literals that exceed this length"40                                      " will use a hash value as their symbol "41                                      "name"),42                       llvm::cl::init(32));43 44mlir::func::FuncOp45fir::FirOpBuilder::createFunction(mlir::Location loc, mlir::ModuleOp module,46                                  llvm::StringRef name, mlir::FunctionType ty,47                                  mlir::SymbolTable *symbolTable) {48  return fir::createFuncOp(loc, module, name, ty, /*attrs*/ {}, symbolTable);49}50 51mlir::func::FuncOp52fir::FirOpBuilder::createRuntimeFunction(mlir::Location loc,53                                         llvm::StringRef name,54                                         mlir::FunctionType ty, bool isIO) {55  mlir::func::FuncOp func = createFunction(loc, name, ty);56  func->setAttr(fir::FIROpsDialect::getFirRuntimeAttrName(), getUnitAttr());57  if (isIO)58    func->setAttr("fir.io", getUnitAttr());59  return func;60}61 62mlir::func::FuncOp63fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp,64                                    const mlir::SymbolTable *symbolTable,65                                    llvm::StringRef name) {66  if (symbolTable)67    if (auto func = symbolTable->lookup<mlir::func::FuncOp>(name)) {68#ifdef EXPENSIVE_CHECKS69      assert(func == modOp.lookupSymbol<mlir::func::FuncOp>(name) &&70             "symbolTable and module out of sync");71#endif72      return func;73    }74  return modOp.lookupSymbol<mlir::func::FuncOp>(name);75}76 77mlir::func::FuncOp78fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp,79                                    const mlir::SymbolTable *symbolTable,80                                    mlir::SymbolRefAttr symbol) {81  if (symbolTable)82    if (auto func = symbolTable->lookup<mlir::func::FuncOp>(83            symbol.getLeafReference())) {84#ifdef EXPENSIVE_CHECKS85      assert(func == modOp.lookupSymbol<mlir::func::FuncOp>(symbol) &&86             "symbolTable and module out of sync");87#endif88      return func;89    }90  return modOp.lookupSymbol<mlir::func::FuncOp>(symbol);91}92 93fir::GlobalOp94fir::FirOpBuilder::getNamedGlobal(mlir::ModuleOp modOp,95                                  const mlir::SymbolTable *symbolTable,96                                  llvm::StringRef name) {97  if (symbolTable)98    if (auto global = symbolTable->lookup<fir::GlobalOp>(name)) {99#ifdef EXPENSIVE_CHECKS100      assert(global == modOp.lookupSymbol<fir::GlobalOp>(name) &&101             "symbolTable and module out of sync");102#endif103      return global;104    }105  return modOp.lookupSymbol<fir::GlobalOp>(name);106}107 108mlir::Type fir::FirOpBuilder::getRefType(mlir::Type eleTy, bool isVolatile) {109  assert(!mlir::isa<fir::ReferenceType>(eleTy) && "cannot be a reference type");110  return fir::ReferenceType::get(eleTy, isVolatile);111}112 113mlir::Type fir::FirOpBuilder::getVarLenSeqTy(mlir::Type eleTy, unsigned rank) {114  fir::SequenceType::Shape shape(rank, fir::SequenceType::getUnknownExtent());115  return fir::SequenceType::get(shape, eleTy);116}117 118mlir::Type fir::FirOpBuilder::getRealType(int kind) {119  switch (kindMap.getRealTypeID(kind)) {120  case llvm::Type::TypeID::HalfTyID:121    return mlir::Float16Type::get(getContext());122  case llvm::Type::TypeID::BFloatTyID:123    return mlir::BFloat16Type::get(getContext());124  case llvm::Type::TypeID::FloatTyID:125    return mlir::Float32Type::get(getContext());126  case llvm::Type::TypeID::DoubleTyID:127    return mlir::Float64Type::get(getContext());128  case llvm::Type::TypeID::X86_FP80TyID:129    return mlir::Float80Type::get(getContext());130  case llvm::Type::TypeID::FP128TyID:131    return mlir::Float128Type::get(getContext());132  default:133    fir::emitFatalError(mlir::UnknownLoc::get(getContext()),134                        "unsupported type !fir.real<kind>");135  }136}137 138mlir::Value fir::FirOpBuilder::createNullConstant(mlir::Location loc,139                                                  mlir::Type ptrType) {140  auto ty = ptrType ? ptrType : getRefType(getNoneType());141  return fir::ZeroOp::create(*this, loc, ty);142}143 144mlir::Value fir::FirOpBuilder::createIntegerConstant(mlir::Location loc,145                                                     mlir::Type ty,146                                                     std::int64_t cst) {147  assert((cst >= 0 || mlir::isa<mlir::IndexType>(ty) ||148          mlir::cast<mlir::IntegerType>(ty).getWidth() <= 64) &&149         "must use APint");150 151  mlir::Type cstType = ty;152  if (auto intType = mlir::dyn_cast<mlir::IntegerType>(ty)) {153    // Signed and unsigned constants must be encoded as signless154    // arith.constant followed by fir.convert cast.155    if (intType.isUnsigned())156      cstType = mlir::IntegerType::get(getContext(), intType.getWidth());157    else if (intType.isSigned())158      TODO(loc, "signed integer constant");159  }160 161  mlir::Value cstValue = mlir::arith::ConstantOp::create(162      *this, loc, cstType, getIntegerAttr(cstType, cst));163  return createConvert(loc, ty, cstValue);164}165 166mlir::Value fir::FirOpBuilder::createAllOnesInteger(mlir::Location loc,167                                                    mlir::Type ty) {168  if (mlir::isa<mlir::IndexType>(ty))169    return createIntegerConstant(loc, ty, -1);170  llvm::APInt allOnes =171      llvm::APInt::getAllOnes(mlir::cast<mlir::IntegerType>(ty).getWidth());172  return mlir::arith::ConstantOp::create(*this, loc, ty,173                                         getIntegerAttr(ty, allOnes));174}175 176mlir::Value177fir::FirOpBuilder::createRealConstant(mlir::Location loc, mlir::Type fltTy,178                                      llvm::APFloat::integerPart val) {179  auto apf = [&]() -> llvm::APFloat {180    if (fltTy.isF16())181      return llvm::APFloat(llvm::APFloat::IEEEhalf(), val);182    if (fltTy.isBF16())183      return llvm::APFloat(llvm::APFloat::BFloat(), val);184    if (fltTy.isF32())185      return llvm::APFloat(llvm::APFloat::IEEEsingle(), val);186    if (fltTy.isF64())187      return llvm::APFloat(llvm::APFloat::IEEEdouble(), val);188    if (fltTy.isF80())189      return llvm::APFloat(llvm::APFloat::x87DoubleExtended(), val);190    if (fltTy.isF128())191      return llvm::APFloat(llvm::APFloat::IEEEquad(), val);192    llvm_unreachable("unhandled MLIR floating-point type");193  };194  return createRealConstant(loc, fltTy, apf());195}196 197mlir::Value fir::FirOpBuilder::createRealConstant(mlir::Location loc,198                                                  mlir::Type fltTy,199                                                  const llvm::APFloat &value) {200  if (mlir::isa<mlir::FloatType>(fltTy)) {201    auto attr = getFloatAttr(fltTy, value);202    return mlir::arith::ConstantOp::create(*this, loc, fltTy, attr);203  }204  llvm_unreachable("should use builtin floating-point type");205}206 207llvm::SmallVector<mlir::Value>208fir::factory::elideExtentsAlreadyInType(mlir::Type type,209                                        mlir::ValueRange shape) {210  auto arrTy = mlir::dyn_cast<fir::SequenceType>(type);211  if (shape.empty() || !arrTy)212    return {};213  // elide the constant dimensions before construction214  assert(shape.size() == arrTy.getDimension());215  llvm::SmallVector<mlir::Value> dynamicShape;216  auto typeShape = arrTy.getShape();217  for (unsigned i = 0, end = arrTy.getDimension(); i < end; ++i)218    if (typeShape[i] == fir::SequenceType::getUnknownExtent())219      dynamicShape.push_back(shape[i]);220  return dynamicShape;221}222 223llvm::SmallVector<mlir::Value>224fir::factory::elideLengthsAlreadyInType(mlir::Type type,225                                        mlir::ValueRange lenParams) {226  if (lenParams.empty())227    return {};228  if (auto arrTy = mlir::dyn_cast<fir::SequenceType>(type))229    type = arrTy.getEleTy();230  if (fir::hasDynamicSize(type))231    return lenParams;232  return {};233}234 235/// Allocate a local variable.236/// A local variable ought to have a name in the source code.237mlir::Value fir::FirOpBuilder::allocateLocal(238    mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,239    llvm::StringRef name, bool pinned, llvm::ArrayRef<mlir::Value> shape,240    llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {241  // Convert the shape extents to `index`, as needed.242  llvm::SmallVector<mlir::Value> indices;243  llvm::SmallVector<mlir::Value> elidedShape =244      fir::factory::elideExtentsAlreadyInType(ty, shape);245  llvm::SmallVector<mlir::Value> elidedLenParams =246      fir::factory::elideLengthsAlreadyInType(ty, lenParams);247  auto idxTy = getIndexType();248  for (mlir::Value sh : elidedShape)249    indices.push_back(createConvert(loc, idxTy, sh));250  // Add a target attribute, if needed.251  llvm::SmallVector<mlir::NamedAttribute> attrs;252  if (asTarget)253    attrs.emplace_back(254        mlir::StringAttr::get(getContext(), fir::getTargetAttrName()),255        getUnitAttr());256  // Create the local variable.257  if (name.empty()) {258    if (uniqName.empty())259      return fir::AllocaOp::create(*this, loc, ty, pinned, elidedLenParams,260                                   indices, attrs);261    return fir::AllocaOp::create(*this, loc, ty, uniqName, pinned,262                                 elidedLenParams, indices, attrs);263  }264  return fir::AllocaOp::create(*this, loc, ty, uniqName, name, pinned,265                               elidedLenParams, indices, attrs);266}267 268mlir::Value fir::FirOpBuilder::allocateLocal(269    mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,270    llvm::StringRef name, llvm::ArrayRef<mlir::Value> shape,271    llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {272  return allocateLocal(loc, ty, uniqName, name, /*pinned=*/false, shape,273                       lenParams, asTarget);274}275 276/// Get the block for adding Allocas.277mlir::Block *fir::FirOpBuilder::getAllocaBlock() {278  if (auto accComputeRegionIface =279          getRegion().getParentOfType<mlir::acc::ComputeRegionOpInterface>()) {280    return accComputeRegionIface.getAllocaBlock();281  }282 283  if (auto ompOutlineableIface =284          getRegion()285              .getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>()) {286    return ompOutlineableIface.getAllocaBlock();287  }288 289  if (auto recipeIface =290          getRegion().getParentOfType<mlir::accomp::RecipeInterface>()) {291    return recipeIface.getAllocaBlock(getRegion());292  }293 294  if (auto cufKernelOp = getRegion().getParentOfType<cuf::KernelOp>())295    return &cufKernelOp.getRegion().front();296 297  if (auto doConcurentOp = getRegion().getParentOfType<fir::DoConcurrentOp>())298    return doConcurentOp.getBody();299 300  if (auto firLocalOp = getRegion().getParentOfType<fir::LocalitySpecifierOp>())301    return &getRegion().front();302 303  if (auto firLocalOp = getRegion().getParentOfType<fir::DeclareReductionOp>())304    return &getRegion().front();305 306  return getEntryBlock();307}308 309static mlir::ArrayAttr makeI64ArrayAttr(llvm::ArrayRef<int64_t> values,310                                        mlir::MLIRContext *context) {311  llvm::SmallVector<mlir::Attribute, 4> attrs;312  attrs.reserve(values.size());313  for (auto &v : values)314    attrs.push_back(mlir::IntegerAttr::get(mlir::IntegerType::get(context, 64),315                                           mlir::APInt(64, v)));316  return mlir::ArrayAttr::get(context, attrs);317}318 319mlir::ArrayAttr fir::FirOpBuilder::create2DI64ArrayAttr(320    llvm::SmallVectorImpl<llvm::SmallVector<int64_t>> &intData) {321  llvm::SmallVector<mlir::Attribute> arrayAttr;322  arrayAttr.reserve(intData.size());323  mlir::MLIRContext *context = getContext();324  for (auto &v : intData)325    arrayAttr.push_back(makeI64ArrayAttr(v, context));326  return mlir::ArrayAttr::get(context, arrayAttr);327}328 329mlir::Value fir::FirOpBuilder::createTemporaryAlloc(330    mlir::Location loc, mlir::Type type, llvm::StringRef name,331    mlir::ValueRange lenParams, mlir::ValueRange shape,332    llvm::ArrayRef<mlir::NamedAttribute> attrs,333    std::optional<Fortran::common::CUDADataAttr> cudaAttr) {334  assert(!mlir::isa<fir::ReferenceType>(type) && "cannot be a reference");335  // If the alloca is inside an OpenMP Op which will be outlined then pin336  // the alloca here.337  const bool pinned =338      getRegion().getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>();339  if (cudaAttr) {340    cuf::DataAttributeAttr attr = cuf::getDataAttribute(getContext(), cudaAttr);341    return cuf::AllocOp::create(*this, loc, type,342                                /*unique_name=*/llvm::StringRef{}, name, attr,343                                lenParams, shape, attrs);344  } else {345    return fir::AllocaOp::create(*this, loc, type,346                                 /*unique_name=*/llvm::StringRef{}, name,347                                 pinned, lenParams, shape, attrs);348  }349}350 351/// Create a temporary variable on the stack. Anonymous temporaries have no352/// `name` value. Temporaries do not require a uniqued name.353mlir::Value fir::FirOpBuilder::createTemporary(354    mlir::Location loc, mlir::Type type, llvm::StringRef name,355    mlir::ValueRange shape, mlir::ValueRange lenParams,356    llvm::ArrayRef<mlir::NamedAttribute> attrs,357    std::optional<Fortran::common::CUDADataAttr> cudaAttr) {358  llvm::SmallVector<mlir::Value> dynamicShape =359      fir::factory::elideExtentsAlreadyInType(type, shape);360  llvm::SmallVector<mlir::Value> dynamicLength =361      fir::factory::elideLengthsAlreadyInType(type, lenParams);362  InsertPoint insPt;363  const bool hoistAlloc = dynamicShape.empty() && dynamicLength.empty();364  if (hoistAlloc) {365    insPt = saveInsertionPoint();366    setInsertionPointToStart(getAllocaBlock());367  }368 369  mlir::Value ae = createTemporaryAlloc(loc, type, name, dynamicLength,370                                        dynamicShape, attrs, cudaAttr);371 372  if (hoistAlloc)373    restoreInsertionPoint(insPt);374  return ae;375}376 377mlir::Value fir::FirOpBuilder::createHeapTemporary(378    mlir::Location loc, mlir::Type type, llvm::StringRef name,379    mlir::ValueRange shape, mlir::ValueRange lenParams,380    llvm::ArrayRef<mlir::NamedAttribute> attrs) {381  llvm::SmallVector<mlir::Value> dynamicShape =382      fir::factory::elideExtentsAlreadyInType(type, shape);383  llvm::SmallVector<mlir::Value> dynamicLength =384      fir::factory::elideLengthsAlreadyInType(type, lenParams);385 386  assert(!mlir::isa<fir::ReferenceType>(type) && "cannot be a reference");387  return fir::AllocMemOp::create(*this, loc, type,388                                 /*unique_name=*/llvm::StringRef{}, name,389                                 dynamicLength, dynamicShape, attrs);390}391 392std::pair<mlir::Value, bool> fir::FirOpBuilder::createAndDeclareTemp(393    mlir::Location loc, mlir::Type baseType, mlir::Value shape,394    llvm::ArrayRef<mlir::Value> extents, llvm::ArrayRef<mlir::Value> typeParams,395    const std::function<decltype(FirOpBuilder::genTempDeclareOp)> &genDeclare,396    mlir::Value polymorphicMold, bool useStack, llvm::StringRef tmpName) {397  if (polymorphicMold) {398    // Create *allocated* polymorphic temporary using the dynamic type399    // of the mold and the provided shape/extents.400    auto boxType = fir::ClassType::get(fir::HeapType::get(baseType));401    mlir::Value boxAddress = fir::factory::getAndEstablishBoxStorage(402        *this, loc, boxType, shape, typeParams, polymorphicMold);403    fir::runtime::genAllocatableAllocate(*this, loc, boxAddress);404    mlir::Value box = fir::LoadOp::create(*this, loc, boxAddress);405    mlir::Value base =406        genDeclare(*this, loc, box, tmpName, /*shape=*/mlir::Value{},407                   typeParams, fir::FortranVariableFlagsAttr{});408    return {base, /*isHeapAllocation=*/true};409  }410  mlir::Value allocmem;411  if (useStack)412    allocmem = createTemporary(loc, baseType, tmpName, extents, typeParams);413  else414    allocmem = createHeapTemporary(loc, baseType, tmpName, extents, typeParams);415  mlir::Value base = genDeclare(*this, loc, allocmem, tmpName, shape,416                                typeParams, fir::FortranVariableFlagsAttr{});417  return {base, !useStack};418}419 420mlir::Value fir::FirOpBuilder::genTempDeclareOp(421    fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value memref,422    llvm::StringRef name, mlir::Value shape,423    llvm::ArrayRef<mlir::Value> typeParams,424    fir::FortranVariableFlagsAttr fortranAttrs) {425  auto nameAttr = mlir::StringAttr::get(builder.getContext(), name);426  return fir::DeclareOp::create(427      builder, loc, memref.getType(), memref, shape, typeParams,428      /*dummy_scope=*/nullptr,429      /*storage=*/nullptr,430      /*storage_offset=*/0, nameAttr, fortranAttrs, cuf::DataAttributeAttr{},431      /*dummy_arg_no=*/mlir::IntegerAttr{});432}433 434mlir::Value fir::FirOpBuilder::genStackSave(mlir::Location loc) {435  mlir::Type voidPtr = mlir::LLVM::LLVMPointerType::get(436      getContext(), fir::factory::getAllocaAddressSpace(&getDataLayout()));437  return mlir::LLVM::StackSaveOp::create(*this, loc, voidPtr);438}439 440void fir::FirOpBuilder::genStackRestore(mlir::Location loc,441                                        mlir::Value stackPointer) {442  mlir::LLVM::StackRestoreOp::create(*this, loc, stackPointer);443}444 445/// Create a global variable in the (read-only) data section. A global variable446/// must have a unique name to identify and reference it.447fir::GlobalOp fir::FirOpBuilder::createGlobal(448    mlir::Location loc, mlir::Type type, llvm::StringRef name,449    mlir::StringAttr linkage, mlir::Attribute value, bool isConst,450    bool isTarget, cuf::DataAttributeAttr dataAttr) {451  if (auto global = getNamedGlobal(name))452    return global;453  auto module = getModule();454  auto insertPt = saveInsertionPoint();455  setInsertionPoint(module.getBody(), module.getBody()->end());456  llvm::SmallVector<mlir::NamedAttribute> attrs;457  if (dataAttr) {458    auto globalOpName = mlir::OperationName(fir::GlobalOp::getOperationName(),459                                            module.getContext());460    attrs.push_back(mlir::NamedAttribute(461        fir::GlobalOp::getDataAttrAttrName(globalOpName), dataAttr));462  }463  auto glob = fir::GlobalOp::create(*this, loc, name, isConst, isTarget, type,464                                    value, linkage, attrs);465  restoreInsertionPoint(insertPt);466  if (symbolTable)467    symbolTable->insert(glob);468  return glob;469}470 471fir::GlobalOp fir::FirOpBuilder::createGlobal(472    mlir::Location loc, mlir::Type type, llvm::StringRef name, bool isConst,473    bool isTarget, std::function<void(FirOpBuilder &)> bodyBuilder,474    mlir::StringAttr linkage, cuf::DataAttributeAttr dataAttr) {475  if (auto global = getNamedGlobal(name))476    return global;477  auto module = getModule();478  auto insertPt = saveInsertionPoint();479  setInsertionPoint(module.getBody(), module.getBody()->end());480  auto glob = fir::GlobalOp::create(*this, loc, name, isConst, isTarget, type,481                                    mlir::Attribute{}, linkage);482  auto &region = glob.getRegion();483  region.push_back(new mlir::Block);484  auto &block = glob.getRegion().back();485  setInsertionPointToStart(&block);486  bodyBuilder(*this);487  restoreInsertionPoint(insertPt);488  if (symbolTable)489    symbolTable->insert(glob);490  return glob;491}492 493std::pair<fir::TypeInfoOp, mlir::OpBuilder::InsertPoint>494fir::FirOpBuilder::createTypeInfoOp(mlir::Location loc,495                                    fir::RecordType recordType,496                                    fir::RecordType parentType) {497  mlir::ModuleOp module = getModule();498  if (fir::TypeInfoOp typeInfo =499          fir::lookupTypeInfoOp(recordType.getName(), module, symbolTable))500    return {typeInfo, InsertPoint{}};501  InsertPoint insertPoint = saveInsertionPoint();502  setInsertionPoint(module.getBody(), module.getBody()->end());503  auto typeInfo = fir::TypeInfoOp::create(*this, loc, recordType, parentType);504  if (symbolTable)505    symbolTable->insert(typeInfo);506  return {typeInfo, insertPoint};507}508 509mlir::Value fir::FirOpBuilder::convertWithSemantics(510    mlir::Location loc, mlir::Type toTy, mlir::Value val,511    bool allowCharacterConversion, bool allowRebox) {512  assert(toTy && "store location must be typed");513  auto fromTy = val.getType();514  if (fromTy == toTy)515    return val;516  fir::factory::Complex helper{*this, loc};517  if ((fir::isa_real(fromTy) || fir::isa_integer(fromTy)) &&518      fir::isa_complex(toTy)) {519    // imaginary part is zero520    auto eleTy = helper.getComplexPartType(toTy);521    auto cast = createConvert(loc, eleTy, val);522    auto imag = createRealZeroConstant(loc, eleTy);523    return helper.createComplex(toTy, cast, imag);524  }525  if (fir::isa_complex(fromTy) &&526      (fir::isa_integer(toTy) || fir::isa_real(toTy))) {527    // drop the imaginary part528    auto rp = helper.extractComplexPart(val, /*isImagPart=*/false);529    return createConvert(loc, toTy, rp);530  }531  if (allowCharacterConversion) {532    if (mlir::isa<fir::BoxCharType>(fromTy)) {533      // Extract the address of the character string and pass it534      fir::factory::CharacterExprHelper charHelper{*this, loc};535      std::pair<mlir::Value, mlir::Value> unboxchar =536          charHelper.createUnboxChar(val);537      return createConvert(loc, toTy, unboxchar.first);538    }539    if (auto boxType = mlir::dyn_cast<fir::BoxCharType>(toTy)) {540      // Extract the address of the actual argument and create a boxed541      // character value with an undefined length542      // TODO: We should really calculate the total size of the actual543      // argument in characters and use it as the length of the string544      auto refType = getRefType(boxType.getEleTy());545      mlir::Value charBase = createConvert(loc, refType, val);546      // Do not use fir.undef since llvm optimizer is too harsh when it547      // sees such values (may just delete code).548      mlir::Value unknownLen = createIntegerConstant(loc, getIndexType(), 0);549      fir::factory::CharacterExprHelper charHelper{*this, loc};550      return charHelper.createEmboxChar(charBase, unknownLen);551    }552  }553  if (fir::isa_ref_type(toTy) && fir::isa_box_type(fromTy)) {554    // Call is expecting a raw data pointer, not a box. Get the data pointer out555    // of the box and pass that.556    assert((fir::unwrapRefType(toTy) ==557                fir::unwrapRefType(fir::unwrapPassByRefType(fromTy)) &&558            "element types expected to match"));559    return fir::BoxAddrOp::create(*this, loc, toTy, val);560  }561  if (fir::isa_ref_type(fromTy) && mlir::isa<fir::BoxProcType>(toTy)) {562    // Call is expecting a boxed procedure, not a reference to other data type.563    // Convert the reference to a procedure and embox it.564    mlir::Type procTy = mlir::cast<fir::BoxProcType>(toTy).getEleTy();565    mlir::Value proc = createConvert(loc, procTy, val);566    return fir::EmboxProcOp::create(*this, loc, toTy, proc);567  }568 569  // Legacy: remove when removing non HLFIR lowering path.570  if (allowRebox)571    if (((fir::isPolymorphicType(fromTy) &&572          (fir::isAllocatableType(fromTy) || fir::isPointerType(fromTy)) &&573          fir::isPolymorphicType(toTy)) ||574         (fir::isPolymorphicType(fromTy) && mlir::isa<fir::BoxType>(toTy))) &&575        !(fir::isUnlimitedPolymorphicType(fromTy) && fir::isAssumedType(toTy)))576      return fir::ReboxOp::create(*this, loc, toTy, val, mlir::Value{},577                                  /*slice=*/mlir::Value{});578 579  return createConvert(loc, toTy, val);580}581 582mlir::Value fir::FirOpBuilder::createVolatileCast(mlir::Location loc,583                                                  bool isVolatile,584                                                  mlir::Value val) {585  mlir::Type volatileAdjustedType =586      fir::updateTypeWithVolatility(val.getType(), isVolatile);587  if (volatileAdjustedType == val.getType())588    return val;589  return fir::VolatileCastOp::create(*this, loc, volatileAdjustedType, val);590}591 592mlir::Value fir::FirOpBuilder::createConvertWithVolatileCast(mlir::Location loc,593                                                             mlir::Type toTy,594                                                             mlir::Value val) {595  val = createVolatileCast(loc, fir::isa_volatile_type(toTy), val);596  return createConvert(loc, toTy, val);597}598 599mlir::Value fir::factory::createConvert(mlir::OpBuilder &builder,600                                        mlir::Location loc, mlir::Type toTy,601                                        mlir::Value val) {602  if (val.getType() != toTy) {603    assert((!fir::isa_derived(toTy) ||604            mlir::cast<fir::RecordType>(val.getType()).getTypeList() ==605                mlir::cast<fir::RecordType>(toTy).getTypeList()) &&606           "incompatible record types");607    return fir::ConvertOp::create(builder, loc, toTy, val);608  }609  return val;610}611 612mlir::Value fir::FirOpBuilder::createConvert(mlir::Location loc,613                                             mlir::Type toTy, mlir::Value val) {614  return fir::factory::createConvert(*this, loc, toTy, val);615}616 617void fir::FirOpBuilder::createStoreWithConvert(mlir::Location loc,618                                               mlir::Value val,619                                               mlir::Value addr) {620  mlir::Type unwrapedRefType = fir::unwrapRefType(addr.getType());621  val = createVolatileCast(loc, fir::isa_volatile_type(unwrapedRefType), val);622  mlir::Value cast = createConvert(loc, unwrapedRefType, val);623  fir::StoreOp::create(*this, loc, cast, addr);624}625 626mlir::Value fir::FirOpBuilder::loadIfRef(mlir::Location loc, mlir::Value val) {627  if (fir::isa_ref_type(val.getType()))628    return fir::LoadOp::create(*this, loc, val);629  return val;630}631 632fir::StringLitOp fir::FirOpBuilder::createStringLitOp(mlir::Location loc,633                                                      llvm::StringRef data) {634  auto type = fir::CharacterType::get(getContext(), 1, data.size());635  auto strAttr = mlir::StringAttr::get(getContext(), data);636  auto valTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::value());637  mlir::NamedAttribute dataAttr(valTag, strAttr);638  auto sizeTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::size());639  mlir::NamedAttribute sizeAttr(sizeTag, getI64IntegerAttr(data.size()));640  llvm::SmallVector<mlir::NamedAttribute> attrs{dataAttr, sizeAttr};641  return fir::StringLitOp::create(*this, loc, llvm::ArrayRef<mlir::Type>{type},642                                  mlir::ValueRange{}, attrs);643}644 645mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,646                                        llvm::ArrayRef<mlir::Value> exts) {647  return fir::ShapeOp::create(*this, loc, exts);648}649 650mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,651                                        llvm::ArrayRef<mlir::Value> shift,652                                        llvm::ArrayRef<mlir::Value> exts) {653  auto shapeType = fir::ShapeShiftType::get(getContext(), exts.size());654  llvm::SmallVector<mlir::Value> shapeArgs;655  auto idxTy = getIndexType();656  for (auto [lbnd, ext] : llvm::zip(shift, exts)) {657    auto lb = createConvert(loc, idxTy, lbnd);658    shapeArgs.push_back(lb);659    shapeArgs.push_back(ext);660  }661  return fir::ShapeShiftOp::create(*this, loc, shapeType, shapeArgs);662}663 664mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,665                                        const fir::AbstractArrayBox &arr) {666  if (arr.lboundsAllOne())667    return genShape(loc, arr.getExtents());668  return genShape(loc, arr.getLBounds(), arr.getExtents());669}670 671mlir::Value fir::FirOpBuilder::genShift(mlir::Location loc,672                                        llvm::ArrayRef<mlir::Value> shift) {673  auto shiftType = fir::ShiftType::get(getContext(), shift.size());674  return fir::ShiftOp::create(*this, loc, shiftType, shift);675}676 677mlir::Value fir::FirOpBuilder::createShape(mlir::Location loc,678                                           const fir::ExtendedValue &exv) {679  return exv.match(680      [&](const fir::ArrayBoxValue &box) { return genShape(loc, box); },681      [&](const fir::CharArrayBoxValue &box) { return genShape(loc, box); },682      [&](const fir::BoxValue &box) -> mlir::Value {683        if (!box.getLBounds().empty()) {684          auto shiftType =685              fir::ShiftType::get(getContext(), box.getLBounds().size());686          return fir::ShiftOp::create(*this, loc, shiftType, box.getLBounds());687        }688        return {};689      },690      [&](const fir::MutableBoxValue &) -> mlir::Value {691        // MutableBoxValue must be read into another category to work with them692        // outside of allocation/assignment contexts.693        fir::emitFatalError(loc, "createShape on MutableBoxValue");694      },695      [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });696}697 698mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc,699                                           const fir::ExtendedValue &exv,700                                           mlir::ValueRange triples,701                                           mlir::ValueRange path) {702  if (triples.empty()) {703    // If there is no slicing by triple notation, then take the whole array.704    auto fullShape = [&](const llvm::ArrayRef<mlir::Value> lbounds,705                         llvm::ArrayRef<mlir::Value> extents) -> mlir::Value {706      llvm::SmallVector<mlir::Value> trips;707      auto idxTy = getIndexType();708      auto one = createIntegerConstant(loc, idxTy, 1);709      if (lbounds.empty()) {710        for (auto v : extents) {711          trips.push_back(one);712          trips.push_back(v);713          trips.push_back(one);714        }715        return fir::SliceOp::create(*this, loc, trips, path);716      }717      for (auto [lbnd, extent] : llvm::zip(lbounds, extents)) {718        auto lb = createConvert(loc, idxTy, lbnd);719        auto ext = createConvert(loc, idxTy, extent);720        auto shift = mlir::arith::SubIOp::create(*this, loc, lb, one);721        auto ub = mlir::arith::AddIOp::create(*this, loc, ext, shift);722        trips.push_back(lb);723        trips.push_back(ub);724        trips.push_back(one);725      }726      return fir::SliceOp::create(*this, loc, trips, path);727    };728    return exv.match(729        [&](const fir::ArrayBoxValue &box) {730          return fullShape(box.getLBounds(), box.getExtents());731        },732        [&](const fir::CharArrayBoxValue &box) {733          return fullShape(box.getLBounds(), box.getExtents());734        },735        [&](const fir::BoxValue &box) {736          auto extents = fir::factory::readExtents(*this, loc, box);737          return fullShape(box.getLBounds(), extents);738        },739        [&](const fir::MutableBoxValue &) -> mlir::Value {740          // MutableBoxValue must be read into another category to work with741          // them outside of allocation/assignment contexts.742          fir::emitFatalError(loc, "createSlice on MutableBoxValue");743        },744        [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });745  }746  return fir::SliceOp::create(*this, loc, triples, path);747}748 749mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,750                                         const fir::ExtendedValue &exv,751                                         bool isPolymorphic,752                                         bool isAssumedType) {753  mlir::Value itemAddr = fir::getBase(exv);754  if (mlir::isa<fir::BaseBoxType>(itemAddr.getType()))755    return itemAddr;756  auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());757  if (!elementType) {758    mlir::emitError(loc, "internal: expected a memory reference type ")759        << itemAddr.getType();760    llvm_unreachable("not a memory reference type");761  }762  const bool isVolatile = fir::isa_volatile_type(itemAddr.getType());763  mlir::Type boxTy;764  mlir::Value tdesc;765  // Avoid to wrap a box/class with box/class.766  if (mlir::isa<fir::BaseBoxType>(elementType)) {767    boxTy = elementType;768  } else {769    boxTy = fir::BoxType::get(elementType, isVolatile);770    if (isPolymorphic) {771      elementType = fir::updateTypeForUnlimitedPolymorphic(elementType);772      if (isAssumedType)773        boxTy = fir::BoxType::get(elementType, isVolatile);774      else775        boxTy = fir::ClassType::get(elementType, isVolatile);776    }777  }778 779  return exv.match(780      [&](const fir::ArrayBoxValue &box) -> mlir::Value {781        mlir::Value empty;782        mlir::ValueRange emptyRange;783        mlir::Value s = createShape(loc, exv);784        return fir::EmboxOp::create(*this, loc, boxTy, itemAddr, s,785                                    /*slice=*/empty,786                                    /*typeparams=*/emptyRange,787                                    isPolymorphic ? box.getSourceBox() : tdesc);788      },789      [&](const fir::CharArrayBoxValue &box) -> mlir::Value {790        mlir::Value s = createShape(loc, exv);791        if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))792          return fir::EmboxOp::create(*this, loc, boxTy, itemAddr, s);793 794        mlir::Value emptySlice;795        llvm::SmallVector<mlir::Value> lenParams{box.getLen()};796        return fir::EmboxOp::create(*this, loc, boxTy, itemAddr, s, emptySlice,797                                    lenParams);798      },799      [&](const fir::CharBoxValue &box) -> mlir::Value {800        if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))801          return fir::EmboxOp::create(*this, loc, boxTy, itemAddr);802        mlir::Value emptyShape, emptySlice;803        llvm::SmallVector<mlir::Value> lenParams{box.getLen()};804        return fir::EmboxOp::create(*this, loc, boxTy, itemAddr, emptyShape,805                                    emptySlice, lenParams);806      },807      [&](const fir::MutableBoxValue &x) -> mlir::Value {808        return fir::LoadOp::create(809            *this, loc, fir::factory::getMutableIRBox(*this, loc, x));810      },811      [&](const fir::PolymorphicValue &p) -> mlir::Value {812        mlir::Value empty;813        mlir::ValueRange emptyRange;814        return fir::EmboxOp::create(*this, loc, boxTy, itemAddr, empty, empty,815                                    emptyRange,816                                    isPolymorphic ? p.getSourceBox() : tdesc);817      },818      [&](const auto &) -> mlir::Value {819        mlir::Value empty;820        mlir::ValueRange emptyRange;821        return fir::EmboxOp::create(*this, loc, boxTy, itemAddr, empty, empty,822                                    emptyRange, tdesc);823      });824}825 826mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc, mlir::Type boxType,827                                         mlir::Value addr, mlir::Value shape,828                                         mlir::Value slice,829                                         llvm::ArrayRef<mlir::Value> lengths,830                                         mlir::Value tdesc) {831  mlir::Type valueOrSequenceType = fir::unwrapPassByRefType(boxType);832  return fir::EmboxOp::create(833      *this, loc, boxType, addr, shape, slice,834      fir::factory::elideLengthsAlreadyInType(valueOrSequenceType, lengths),835      tdesc);836}837 838void fir::FirOpBuilder::dumpFunc() { getFunction().dump(); }839 840static mlir::Value841genNullPointerComparison(fir::FirOpBuilder &builder, mlir::Location loc,842                         mlir::Value addr,843                         mlir::arith::CmpIPredicate condition) {844  auto intPtrTy = builder.getIntPtrType();845  auto ptrToInt = builder.createConvert(loc, intPtrTy, addr);846  auto c0 = builder.createIntegerConstant(loc, intPtrTy, 0);847  return mlir::arith::CmpIOp::create(builder, loc, condition, ptrToInt, c0);848}849 850mlir::Value fir::FirOpBuilder::genIsNotNullAddr(mlir::Location loc,851                                                mlir::Value addr) {852  return genNullPointerComparison(*this, loc, addr,853                                  mlir::arith::CmpIPredicate::ne);854}855 856mlir::Value fir::FirOpBuilder::genIsNullAddr(mlir::Location loc,857                                             mlir::Value addr) {858  return genNullPointerComparison(*this, loc, addr,859                                  mlir::arith::CmpIPredicate::eq);860}861 862mlir::Value fir::FirOpBuilder::genExtentFromTriplet(mlir::Location loc,863                                                    mlir::Value lb,864                                                    mlir::Value ub,865                                                    mlir::Value step,866                                                    mlir::Type type) {867  auto zero = createIntegerConstant(loc, type, 0);868  lb = createConvert(loc, type, lb);869  ub = createConvert(loc, type, ub);870  step = createConvert(loc, type, step);871  auto diff = mlir::arith::SubIOp::create(*this, loc, ub, lb);872  auto add = mlir::arith::AddIOp::create(*this, loc, diff, step);873  auto div = mlir::arith::DivSIOp::create(*this, loc, add, step);874  auto cmp = mlir::arith::CmpIOp::create(875      *this, loc, mlir::arith::CmpIPredicate::sgt, div, zero);876  return mlir::arith::SelectOp::create(*this, loc, cmp, div, zero);877}878 879mlir::Value fir::FirOpBuilder::genAbsentOp(mlir::Location loc,880                                           mlir::Type argTy) {881  if (!fir::isCharacterProcedureTuple(argTy))882    return fir::AbsentOp::create(*this, loc, argTy);883 884  auto boxProc = fir::AbsentOp::create(885      *this, loc, mlir::cast<mlir::TupleType>(argTy).getType(0));886  mlir::Value charLen =887      fir::UndefOp::create(*this, loc, getCharacterLengthType());888  return fir::factory::createCharacterProcedureTuple(*this, loc, argTy, boxProc,889                                                     charLen);890}891 892void fir::FirOpBuilder::setCommonAttributes(mlir::Operation *op) const {893  auto fmi = mlir::dyn_cast<mlir::arith::ArithFastMathInterface>(*op);894  if (fmi) {895    // TODO: use fmi.setFastMathFlagsAttr() after D137114 is merged.896    //       For now set the attribute by the name.897    llvm::StringRef arithFMFAttrName = fmi.getFastMathAttrName();898    if (fastMathFlags != mlir::arith::FastMathFlags::none)899      op->setAttr(arithFMFAttrName, mlir::arith::FastMathFlagsAttr::get(900                                        op->getContext(), fastMathFlags));901  }902  auto iofi =903      mlir::dyn_cast<mlir::arith::ArithIntegerOverflowFlagsInterface>(*op);904  if (iofi) {905    llvm::StringRef arithIOFAttrName = iofi.getIntegerOverflowAttrName();906    if (integerOverflowFlags != mlir::arith::IntegerOverflowFlags::none)907      op->setAttr(arithIOFAttrName,908                  mlir::arith::IntegerOverflowFlagsAttr::get(909                      op->getContext(), integerOverflowFlags));910  }911}912 913void fir::FirOpBuilder::setFastMathFlags(914    Fortran::common::MathOptionsBase options) {915  mlir::arith::FastMathFlags arithFMF{};916  if (options.getFPContractEnabled()) {917    arithFMF = arithFMF | mlir::arith::FastMathFlags::contract;918  }919  if (options.getNoHonorInfs()) {920    arithFMF = arithFMF | mlir::arith::FastMathFlags::ninf;921  }922  if (options.getNoHonorNaNs()) {923    arithFMF = arithFMF | mlir::arith::FastMathFlags::nnan;924  }925  if (options.getApproxFunc()) {926    arithFMF = arithFMF | mlir::arith::FastMathFlags::afn;927  }928  if (options.getNoSignedZeros()) {929    arithFMF = arithFMF | mlir::arith::FastMathFlags::nsz;930  }931  if (options.getAssociativeMath()) {932    arithFMF = arithFMF | mlir::arith::FastMathFlags::reassoc;933  }934  if (options.getReciprocalMath()) {935    arithFMF = arithFMF | mlir::arith::FastMathFlags::arcp;936  }937  setFastMathFlags(arithFMF);938}939 940// Construction of an mlir::DataLayout is expensive so only do it on demand and941// memoise it in the builder instance942mlir::DataLayout &fir::FirOpBuilder::getDataLayout() {943  if (dataLayout)944    return *dataLayout;945  dataLayout = std::make_unique<mlir::DataLayout>(getModule());946  return *dataLayout;947}948 949//===--------------------------------------------------------------------===//950// ExtendedValue inquiry helper implementation951//===--------------------------------------------------------------------===//952 953mlir::Value fir::factory::readCharLen(fir::FirOpBuilder &builder,954                                      mlir::Location loc,955                                      const fir::ExtendedValue &box) {956  return box.match(957      [&](const fir::CharBoxValue &x) -> mlir::Value { return x.getLen(); },958      [&](const fir::CharArrayBoxValue &x) -> mlir::Value {959        return x.getLen();960      },961      [&](const fir::BoxValue &x) -> mlir::Value {962        assert(x.isCharacter());963        if (!x.getExplicitParameters().empty())964          return x.getExplicitParameters()[0];965        return fir::factory::CharacterExprHelper{builder, loc}966            .readLengthFromBox(x.getAddr());967      },968      [&](const fir::MutableBoxValue &x) -> mlir::Value {969        return readCharLen(builder, loc,970                           fir::factory::genMutableBoxRead(builder, loc, x));971      },972      [&](const auto &) -> mlir::Value {973        fir::emitFatalError(974            loc, "Character length inquiry on a non-character entity");975      });976}977 978mlir::Value fir::factory::readExtent(fir::FirOpBuilder &builder,979                                     mlir::Location loc,980                                     const fir::ExtendedValue &box,981                                     unsigned dim) {982  assert(box.rank() > dim);983  return box.match(984      [&](const fir::ArrayBoxValue &x) -> mlir::Value {985        return x.getExtents()[dim];986      },987      [&](const fir::CharArrayBoxValue &x) -> mlir::Value {988        return x.getExtents()[dim];989      },990      [&](const fir::BoxValue &x) -> mlir::Value {991        if (!x.getExplicitExtents().empty())992          return x.getExplicitExtents()[dim];993        auto idxTy = builder.getIndexType();994        auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);995        return fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy,996                                      x.getAddr(), dimVal)997            .getResult(1);998      },999      [&](const fir::MutableBoxValue &x) -> mlir::Value {1000        return readExtent(builder, loc,1001                          fir::factory::genMutableBoxRead(builder, loc, x),1002                          dim);1003      },1004      [&](const auto &) -> mlir::Value {1005        fir::emitFatalError(loc, "extent inquiry on scalar");1006      });1007}1008 1009mlir::Value fir::factory::readLowerBound(fir::FirOpBuilder &builder,1010                                         mlir::Location loc,1011                                         const fir::ExtendedValue &box,1012                                         unsigned dim,1013                                         mlir::Value defaultValue) {1014  assert(box.rank() > dim);1015  auto lb = box.match(1016      [&](const fir::ArrayBoxValue &x) -> mlir::Value {1017        return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];1018      },1019      [&](const fir::CharArrayBoxValue &x) -> mlir::Value {1020        return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];1021      },1022      [&](const fir::BoxValue &x) -> mlir::Value {1023        return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];1024      },1025      [&](const fir::MutableBoxValue &x) -> mlir::Value {1026        return readLowerBound(builder, loc,1027                              fir::factory::genMutableBoxRead(builder, loc, x),1028                              dim, defaultValue);1029      },1030      [&](const auto &) -> mlir::Value {1031        fir::emitFatalError(loc, "lower bound inquiry on scalar");1032      });1033  if (lb)1034    return lb;1035  return defaultValue;1036}1037 1038llvm::SmallVector<mlir::Value>1039fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc,1040                          const fir::BoxValue &box) {1041  llvm::SmallVector<mlir::Value> result;1042  auto explicitExtents = box.getExplicitExtents();1043  if (!explicitExtents.empty()) {1044    result.append(explicitExtents.begin(), explicitExtents.end());1045    return result;1046  }1047  auto rank = box.rank();1048  auto idxTy = builder.getIndexType();1049  for (decltype(rank) dim = 0; dim < rank; ++dim) {1050    auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);1051    auto dimInfo = fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy,1052                                          box.getAddr(), dimVal);1053    result.emplace_back(dimInfo.getResult(1));1054  }1055  return result;1056}1057 1058llvm::SmallVector<mlir::Value>1059fir::factory::getExtents(mlir::Location loc, fir::FirOpBuilder &builder,1060                         const fir::ExtendedValue &box) {1061  return box.match(1062      [&](const fir::ArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {1063        return {x.getExtents().begin(), x.getExtents().end()};1064      },1065      [&](const fir::CharArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {1066        return {x.getExtents().begin(), x.getExtents().end()};1067      },1068      [&](const fir::BoxValue &x) -> llvm::SmallVector<mlir::Value> {1069        return fir::factory::readExtents(builder, loc, x);1070      },1071      [&](const fir::MutableBoxValue &x) -> llvm::SmallVector<mlir::Value> {1072        auto load = fir::factory::genMutableBoxRead(builder, loc, x);1073        return fir::factory::getExtents(loc, builder, load);1074      },1075      [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });1076}1077 1078fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,1079                                              mlir::Location loc,1080                                              const fir::BoxValue &box) {1081  assert(!box.hasAssumedRank() &&1082         "cannot read unlimited polymorphic or assumed rank fir.box");1083  auto addr =1084      fir::BoxAddrOp::create(builder, loc, box.getMemTy(), box.getAddr());1085  if (box.isCharacter()) {1086    auto len = fir::factory::readCharLen(builder, loc, box);1087    if (box.rank() == 0)1088      return fir::CharBoxValue(addr, len);1089    return fir::CharArrayBoxValue(addr, len,1090                                  fir::factory::readExtents(builder, loc, box),1091                                  box.getLBounds());1092  }1093  if (box.isDerivedWithLenParameters())1094    TODO(loc, "read fir.box with length parameters");1095  mlir::Value sourceBox;1096  if (box.isPolymorphic())1097    sourceBox = box.getAddr();1098  if (box.isPolymorphic() && box.rank() == 0)1099    return fir::PolymorphicValue(addr, sourceBox);1100  if (box.rank() == 0)1101    return addr;1102  return fir::ArrayBoxValue(addr, fir::factory::readExtents(builder, loc, box),1103                            box.getLBounds(), sourceBox);1104}1105 1106llvm::SmallVector<mlir::Value>1107fir::factory::getNonDefaultLowerBounds(fir::FirOpBuilder &builder,1108                                       mlir::Location loc,1109                                       const fir::ExtendedValue &exv) {1110  return exv.match(1111      [&](const fir::ArrayBoxValue &array) -> llvm::SmallVector<mlir::Value> {1112        return {array.getLBounds().begin(), array.getLBounds().end()};1113      },1114      [&](const fir::CharArrayBoxValue &array)1115          -> llvm::SmallVector<mlir::Value> {1116        return {array.getLBounds().begin(), array.getLBounds().end()};1117      },1118      [&](const fir::BoxValue &box) -> llvm::SmallVector<mlir::Value> {1119        return {box.getLBounds().begin(), box.getLBounds().end()};1120      },1121      [&](const fir::MutableBoxValue &box) -> llvm::SmallVector<mlir::Value> {1122        auto load = fir::factory::genMutableBoxRead(builder, loc, box);1123        return fir::factory::getNonDefaultLowerBounds(builder, loc, load);1124      },1125      [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });1126}1127 1128llvm::SmallVector<mlir::Value>1129fir::factory::getNonDeferredLenParams(const fir::ExtendedValue &exv) {1130  return exv.match(1131      [&](const fir::CharArrayBoxValue &character)1132          -> llvm::SmallVector<mlir::Value> { return {character.getLen()}; },1133      [&](const fir::CharBoxValue &character)1134          -> llvm::SmallVector<mlir::Value> { return {character.getLen()}; },1135      [&](const fir::MutableBoxValue &box) -> llvm::SmallVector<mlir::Value> {1136        return {box.nonDeferredLenParams().begin(),1137                box.nonDeferredLenParams().end()};1138      },1139      [&](const fir::BoxValue &box) -> llvm::SmallVector<mlir::Value> {1140        return {box.getExplicitParameters().begin(),1141                box.getExplicitParameters().end()};1142      },1143      [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });1144}1145 1146// If valTy is a box type, then we need to extract the type parameters from1147// the box value.1148static llvm::SmallVector<mlir::Value> getFromBox(mlir::Location loc,1149                                                 fir::FirOpBuilder &builder,1150                                                 mlir::Type valTy,1151                                                 mlir::Value boxVal) {1152  if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(valTy)) {1153    auto eleTy = fir::unwrapAllRefAndSeqType(boxTy.getEleTy());1154    if (auto recTy = mlir::dyn_cast<fir::RecordType>(eleTy)) {1155      if (recTy.getNumLenParams() > 0) {1156        // Walk each type parameter in the record and get the value.1157        TODO(loc, "generate code to get LEN type parameters");1158      }1159    } else if (auto charTy = mlir::dyn_cast<fir::CharacterType>(eleTy)) {1160      if (charTy.hasDynamicLen()) {1161        auto idxTy = builder.getIndexType();1162        auto eleSz = fir::BoxEleSizeOp::create(builder, loc, idxTy, boxVal);1163        auto kindBytes =1164            builder.getKindMap().getCharacterBitsize(charTy.getFKind()) / 8;1165        mlir::Value charSz =1166            builder.createIntegerConstant(loc, idxTy, kindBytes);1167        mlir::Value len =1168            mlir::arith::DivSIOp::create(builder, loc, eleSz, charSz);1169        return {len};1170      }1171    }1172  }1173  return {};1174}1175 1176// fir::getTypeParams() will get the type parameters from the extended value.1177// When the extended value is a BoxValue or MutableBoxValue, it may be necessary1178// to generate code, so this factory function handles those cases.1179// TODO: fix the inverted type tests, etc.1180llvm::SmallVector<mlir::Value>1181fir::factory::getTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,1182                            const fir::ExtendedValue &exv) {1183  auto handleBoxed = [&](const auto &box) -> llvm::SmallVector<mlir::Value> {1184    if (box.isCharacter())1185      return {fir::factory::readCharLen(builder, loc, exv)};1186    if (box.isDerivedWithLenParameters()) {1187      // This should generate code to read the type parameters from the box.1188      // This requires some consideration however as MutableBoxValues need to be1189      // in a sane state to be provide the correct values.1190      TODO(loc, "derived type with type parameters");1191    }1192    return {};1193  };1194  // Intentionally reuse the original code path to get type parameters for the1195  // cases that were supported rather than introduce a new path.1196  return exv.match(1197      [&](const fir::BoxValue &box) { return handleBoxed(box); },1198      [&](const fir::MutableBoxValue &box) { return handleBoxed(box); },1199      [&](const auto &) { return fir::getTypeParams(exv); });1200}1201 1202llvm::SmallVector<mlir::Value>1203fir::factory::getTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,1204                            fir::ArrayLoadOp load) {1205  mlir::Type memTy = load.getMemref().getType();1206  if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(memTy))1207    return getFromBox(loc, builder, boxTy, load.getMemref());1208  return load.getTypeparams();1209}1210 1211std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix,1212                                        llvm::StringRef name) {1213  // For "long" identifiers use a hash value1214  if (name.size() > nameLengthHashSize) {1215    llvm::MD5 hash;1216    hash.update(name);1217    llvm::MD5::MD5Result result;1218    hash.final(result);1219    llvm::SmallString<32> str;1220    llvm::MD5::stringifyResult(result, str);1221    std::string hashName = prefix.str();1222    hashName.append("X").append(str.c_str());1223    return fir::NameUniquer::doGenerated(hashName);1224  }1225  // "Short" identifiers use a reversible hex string1226  std::string nm = prefix.str();1227  return fir::NameUniquer::doGenerated(1228      nm.append("X").append(llvm::toHex(name)));1229}1230 1231mlir::Value fir::factory::locationToFilename(fir::FirOpBuilder &builder,1232                                             mlir::Location loc) {1233  if (auto flc = mlir::dyn_cast<mlir::FileLineColLoc>(loc)) {1234    // must be encoded as asciiz, C string1235    auto fn = flc.getFilename().str() + '\0';1236    return fir::getBase(createStringLiteral(builder, loc, fn));1237  }1238  return builder.createNullConstant(loc);1239}1240 1241mlir::Value fir::factory::locationToLineNo(fir::FirOpBuilder &builder,1242                                           mlir::Location loc,1243                                           mlir::Type type) {1244  if (auto flc = mlir::dyn_cast<mlir::FileLineColLoc>(loc))1245    return builder.createIntegerConstant(loc, type, flc.getLine());1246  return builder.createIntegerConstant(loc, type, 0);1247}1248 1249fir::ExtendedValue fir::factory::createStringLiteral(fir::FirOpBuilder &builder,1250                                                     mlir::Location loc,1251                                                     llvm::StringRef str) {1252  std::string globalName = fir::factory::uniqueCGIdent("cl", str);1253  auto type = fir::CharacterType::get(builder.getContext(), 1, str.size());1254  auto global = builder.getNamedGlobal(globalName);1255  if (!global)1256    global = builder.createGlobalConstant(1257        loc, type, globalName,1258        [&](fir::FirOpBuilder &builder) {1259          auto stringLitOp = builder.createStringLitOp(loc, str);1260          fir::HasValueOp::create(builder, loc, stringLitOp);1261        },1262        builder.createLinkOnceLinkage());1263  auto addr = fir::AddrOfOp::create(builder, loc, global.resultType(),1264                                    global.getSymbol());1265  auto len = builder.createIntegerConstant(1266      loc, builder.getCharacterLengthType(), str.size());1267  return fir::CharBoxValue{addr, len};1268}1269 1270llvm::SmallVector<mlir::Value>1271fir::factory::createExtents(fir::FirOpBuilder &builder, mlir::Location loc,1272                            fir::SequenceType seqTy) {1273  llvm::SmallVector<mlir::Value> extents;1274  auto idxTy = builder.getIndexType();1275  for (auto ext : seqTy.getShape())1276    extents.emplace_back(1277        ext == fir::SequenceType::getUnknownExtent()1278            ? fir::UndefOp::create(builder, loc, idxTy).getResult()1279            : builder.createIntegerConstant(loc, idxTy, ext));1280  return extents;1281}1282 1283// FIXME: This needs some work. To correctly determine the extended value of a1284// component, one needs the base object, its type, and its type parameters. (An1285// alternative would be to provide an already computed address of the final1286// component rather than the base object's address, the point being the result1287// will require the address of the final component to create the extended1288// value.) One further needs the full path of components being applied. One1289// needs to apply type-based expressions to type parameters along this said1290// path. (See applyPathToType for a type-only derivation.) Finally, one needs to1291// compose the extended value of the terminal component, including all of its1292// parameters: array lower bounds expressions, extents, type parameters, etc.1293// Any of these properties may be deferred until runtime in Fortran. This1294// operation may therefore generate a sizeable block of IR, including calls to1295// type-based helper functions, so caching the result of this operation in the1296// client would be advised as well.1297fir::ExtendedValue fir::factory::componentToExtendedValue(1298    fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value component) {1299  auto fieldTy = component.getType();1300  if (auto ty = fir::dyn_cast_ptrEleTy(fieldTy))1301    fieldTy = ty;1302  if (mlir::isa<fir::BaseBoxType>(fieldTy)) {1303    llvm::SmallVector<mlir::Value> nonDeferredTypeParams;1304    auto eleTy = fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(fieldTy));1305    if (auto charTy = mlir::dyn_cast<fir::CharacterType>(eleTy)) {1306      auto lenTy = builder.getCharacterLengthType();1307      if (charTy.hasConstantLen())1308        nonDeferredTypeParams.emplace_back(1309            builder.createIntegerConstant(loc, lenTy, charTy.getLen()));1310      // TODO: Starting, F2003, the dynamic character length might be dependent1311      // on a PDT length parameter. There is no way to make a difference with1312      // deferred length here yet.1313    }1314    if (auto recTy = mlir::dyn_cast<fir::RecordType>(eleTy))1315      if (recTy.getNumLenParams() > 0)1316        TODO(loc, "allocatable and pointer components non deferred length "1317                  "parameters");1318 1319    return fir::MutableBoxValue(component, nonDeferredTypeParams,1320                                /*mutableProperties=*/{});1321  }1322  llvm::SmallVector<mlir::Value> extents;1323  if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(fieldTy)) {1324    fieldTy = seqTy.getEleTy();1325    auto idxTy = builder.getIndexType();1326    for (auto extent : seqTy.getShape()) {1327      if (extent == fir::SequenceType::getUnknownExtent())1328        TODO(loc, "array component shape depending on length parameters");1329      extents.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));1330    }1331  }1332  if (auto charTy = mlir::dyn_cast<fir::CharacterType>(fieldTy)) {1333    auto cstLen = charTy.getLen();1334    if (cstLen == fir::CharacterType::unknownLen())1335      TODO(loc, "get character component length from length type parameters");1336    auto len = builder.createIntegerConstant(1337        loc, builder.getCharacterLengthType(), cstLen);1338    if (!extents.empty())1339      return fir::CharArrayBoxValue{component, len, extents};1340    return fir::CharBoxValue{component, len};1341  }1342  if (auto recordTy = mlir::dyn_cast<fir::RecordType>(fieldTy))1343    if (recordTy.getNumLenParams() != 0)1344      TODO(loc,1345           "lower component ref that is a derived type with length parameter");1346  if (!extents.empty())1347    return fir::ArrayBoxValue{component, extents};1348  return component;1349}1350 1351fir::ExtendedValue fir::factory::arrayElementToExtendedValue(1352    fir::FirOpBuilder &builder, mlir::Location loc,1353    const fir::ExtendedValue &array, mlir::Value element) {1354  return array.match(1355      [&](const fir::CharBoxValue &cb) -> fir::ExtendedValue {1356        return cb.clone(element);1357      },1358      [&](const fir::CharArrayBoxValue &bv) -> fir::ExtendedValue {1359        return bv.cloneElement(element);1360      },1361      [&](const fir::BoxValue &box) -> fir::ExtendedValue {1362        if (box.isCharacter()) {1363          auto len = fir::factory::readCharLen(builder, loc, box);1364          return fir::CharBoxValue{element, len};1365        }1366        if (box.isDerivedWithLenParameters())1367          TODO(loc, "get length parameters from derived type BoxValue");1368        if (box.isPolymorphic()) {1369          return fir::PolymorphicValue(element, fir::getBase(box));1370        }1371        return element;1372      },1373      [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {1374        if (box.getSourceBox())1375          return fir::PolymorphicValue(element, box.getSourceBox());1376        return element;1377      },1378      [&](const auto &) -> fir::ExtendedValue { return element; });1379}1380 1381fir::ExtendedValue fir::factory::arraySectionElementToExtendedValue(1382    fir::FirOpBuilder &builder, mlir::Location loc,1383    const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice) {1384  if (!slice)1385    return arrayElementToExtendedValue(builder, loc, array, element);1386  auto sliceOp = mlir::dyn_cast_or_null<fir::SliceOp>(slice.getDefiningOp());1387  assert(sliceOp && "slice must be a sliceOp");1388  if (sliceOp.getFields().empty())1389    return arrayElementToExtendedValue(builder, loc, array, element);1390  // For F95, using componentToExtendedValue will work, but when PDTs are1391  // lowered. It will be required to go down the slice to propagate the length1392  // parameters.1393  return fir::factory::componentToExtendedValue(builder, loc, element);1394}1395 1396void fir::factory::genScalarAssignment(1397    fir::FirOpBuilder &builder, mlir::Location loc,1398    const fir::ExtendedValue &lhs, const fir::ExtendedValue &rhs,1399    bool needFinalization, bool isTemporaryLHS, mlir::ArrayAttr accessGroups) {1400  assert(lhs.rank() == 0 && rhs.rank() == 0 && "must be scalars");1401  auto type = fir::unwrapSequenceType(1402      fir::unwrapPassByRefType(fir::getBase(lhs).getType()));1403  if (mlir::isa<fir::CharacterType>(type)) {1404    const fir::CharBoxValue *toChar = lhs.getCharBox();1405    const fir::CharBoxValue *fromChar = rhs.getCharBox();1406    assert(toChar && fromChar);1407    fir::factory::CharacterExprHelper helper{builder, loc};1408    helper.createAssign(fir::ExtendedValue{*toChar},1409                        fir::ExtendedValue{*fromChar});1410  } else if (mlir::isa<fir::RecordType>(type)) {1411    fir::factory::genRecordAssignment(builder, loc, lhs, rhs, needFinalization,1412                                      isTemporaryLHS);1413  } else {1414    assert(!fir::hasDynamicSize(type));1415    auto rhsVal = fir::getBase(rhs);1416    if (fir::isa_ref_type(rhsVal.getType()))1417      rhsVal = fir::LoadOp::create(builder, loc, rhsVal);1418    mlir::Value lhsAddr = fir::getBase(lhs);1419    rhsVal = builder.createConvert(loc, fir::unwrapRefType(lhsAddr.getType()),1420                                   rhsVal);1421    fir::StoreOp store = fir::StoreOp::create(builder, loc, rhsVal, lhsAddr);1422    if (accessGroups)1423      store.setAccessGroupsAttr(accessGroups);1424  }1425}1426 1427static void genComponentByComponentAssignment(fir::FirOpBuilder &builder,1428                                              mlir::Location loc,1429                                              const fir::ExtendedValue &lhs,1430                                              const fir::ExtendedValue &rhs,1431                                              bool isTemporaryLHS) {1432  auto lbaseType = fir::unwrapPassByRefType(fir::getBase(lhs).getType());1433  auto lhsType = mlir::dyn_cast<fir::RecordType>(lbaseType);1434  assert(lhsType && "lhs must be a scalar record type");1435  auto rbaseType = fir::unwrapPassByRefType(fir::getBase(rhs).getType());1436  auto rhsType = mlir::dyn_cast<fir::RecordType>(rbaseType);1437  assert(rhsType && "rhs must be a scalar record type");1438  auto fieldIndexType = fir::FieldType::get(lhsType.getContext());1439  for (auto [lhsPair, rhsPair] :1440       llvm::zip(lhsType.getTypeList(), rhsType.getTypeList())) {1441    auto &[lFieldName, lFieldTy] = lhsPair;1442    auto &[rFieldName, rFieldTy] = rhsPair;1443    assert(!fir::hasDynamicSize(lFieldTy) && !fir::hasDynamicSize(rFieldTy));1444    mlir::Value rField =1445        fir::FieldIndexOp::create(builder, loc, fieldIndexType, rFieldName,1446                                  rhsType, fir::getTypeParams(rhs));1447    auto rFieldRefType = builder.getRefType(rFieldTy);1448    mlir::Value fromCoor = fir::CoordinateOp::create(1449        builder, loc, rFieldRefType, fir::getBase(rhs), rField);1450    mlir::Value field =1451        fir::FieldIndexOp::create(builder, loc, fieldIndexType, lFieldName,1452                                  lhsType, fir::getTypeParams(lhs));1453    auto fieldRefType = builder.getRefType(lFieldTy);1454    mlir::Value toCoor = fir::CoordinateOp::create(builder, loc, fieldRefType,1455                                                   fir::getBase(lhs), field);1456    std::optional<fir::DoLoopOp> outerLoop;1457    if (auto sequenceType = mlir::dyn_cast<fir::SequenceType>(lFieldTy)) {1458      // Create loops to assign array components elements by elements.1459      // Note that, since these are components, they either do not overlap,1460      // or are the same and exactly overlap. They also have compile time1461      // constant shapes.1462      mlir::Type idxTy = builder.getIndexType();1463      llvm::SmallVector<mlir::Value> indices;1464      mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);1465      mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);1466      for (auto extent : llvm::reverse(sequenceType.getShape())) {1467        // TODO: add zero size test !1468        mlir::Value ub = builder.createIntegerConstant(loc, idxTy, extent - 1);1469        auto loop = fir::DoLoopOp::create(builder, loc, zero, ub, one);1470        if (!outerLoop)1471          outerLoop = loop;1472        indices.push_back(loop.getInductionVar());1473        builder.setInsertionPointToStart(loop.getBody());1474      }1475      // Set indices in column-major order.1476      std::reverse(indices.begin(), indices.end());1477      auto elementRefType = builder.getRefType(sequenceType.getEleTy());1478      toCoor = fir::CoordinateOp::create(builder, loc, elementRefType, toCoor,1479                                         indices);1480      fromCoor = fir::CoordinateOp::create(builder, loc, elementRefType,1481                                           fromCoor, indices);1482    }1483    if (auto fieldEleTy = fir::unwrapSequenceType(lFieldTy);1484        mlir::isa<fir::BaseBoxType>(fieldEleTy)) {1485      assert(mlir::isa<fir::PointerType>(1486                 mlir::cast<fir::BaseBoxType>(fieldEleTy).getEleTy()) &&1487             "allocatable members require deep copy");1488      auto fromPointerValue = fir::LoadOp::create(builder, loc, fromCoor);1489      auto castTo = builder.createConvert(loc, fieldEleTy, fromPointerValue);1490      fir::StoreOp::create(builder, loc, castTo, toCoor);1491    } else {1492      auto from =1493          fir::factory::componentToExtendedValue(builder, loc, fromCoor);1494      auto to = fir::factory::componentToExtendedValue(builder, loc, toCoor);1495      // If LHS finalization is needed it is expected to be done1496      // for the parent record, so that component-by-component1497      // assignments may avoid finalization calls.1498      fir::factory::genScalarAssignment(builder, loc, to, from,1499                                        /*needFinalization=*/false,1500                                        isTemporaryLHS);1501    }1502    if (outerLoop)1503      builder.setInsertionPointAfter(*outerLoop);1504  }1505}1506 1507/// Can the assignment of this record type be implement with a simple memory1508/// copy (it requires no deep copy or user defined assignment of components )?1509static bool recordTypeCanBeMemCopied(fir::RecordType recordType) {1510  // c_devptr type is a special case. It has a nested c_ptr field but we know it1511  // can be copied directly.1512  if (fir::isa_builtin_c_devptr_type(recordType))1513    return true;1514  if (fir::hasDynamicSize(recordType))1515    return false;1516  for (auto [_, fieldType] : recordType.getTypeList()) {1517    // Derived type component may have user assignment (so far, we cannot tell1518    // in FIR, so assume it is always the case, TODO: get the actual info).1519    if (mlir::isa<fir::RecordType>(fir::unwrapSequenceType(fieldType)) &&1520        !fir::isa_builtin_c_devptr_type(fir::unwrapSequenceType(fieldType)))1521      return false;1522    // Allocatable components need deep copy.1523    if (auto boxType = mlir::dyn_cast<fir::BaseBoxType>(fieldType))1524      if (mlir::isa<fir::HeapType>(boxType.getEleTy()))1525        return false;1526  }1527  // Constant size components without user defined assignment and pointers can1528  // be memcopied.1529  return true;1530}1531 1532static bool mayHaveFinalizer(fir::RecordType recordType,1533                             fir::FirOpBuilder &builder) {1534  if (auto typeInfo = builder.getModule().lookupSymbol<fir::TypeInfoOp>(1535          recordType.getName()))1536    return !typeInfo.getNoFinal();1537  // No info, be pessimistic.1538  return true;1539}1540 1541void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,1542                                       mlir::Location loc,1543                                       const fir::ExtendedValue &lhs,1544                                       const fir::ExtendedValue &rhs,1545                                       bool needFinalization,1546                                       bool isTemporaryLHS) {1547  assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment");1548  auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());1549  assert(baseTy && "must be a memory type");1550  // Box operands may be polymorphic, it is not entirely clear from 10.2.1.31551  // if the assignment is performed on the dynamic of declared type. Use the1552  // runtime assuming it is performed on the dynamic type.1553  bool hasBoxOperands =1554      mlir::isa<fir::BaseBoxType>(fir::getBase(lhs).getType()) ||1555      mlir::isa<fir::BaseBoxType>(fir::getBase(rhs).getType());1556  auto recTy = mlir::dyn_cast<fir::RecordType>(baseTy);1557  assert(recTy && "must be a record type");1558  if ((needFinalization && mayHaveFinalizer(recTy, builder)) ||1559      hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) {1560    auto to = fir::getBase(builder.createBox(loc, lhs));1561    auto from = fir::getBase(builder.createBox(loc, rhs));1562    // The runtime entry point may modify the LHS descriptor if it is1563    // an allocatable. Allocatable assignment is handle elsewhere in lowering,1564    // so just create a fir.ref<fir.box<>> from the fir.box to comply with the1565    // runtime interface, but assume the fir.box is unchanged.1566    // TODO: does this holds true with polymorphic entities ?1567    auto toMutableBox = builder.createTemporary(loc, to.getType());1568    fir::StoreOp::create(builder, loc, to, toMutableBox);1569    if (isTemporaryLHS)1570      fir::runtime::genAssignTemporary(builder, loc, toMutableBox, from);1571    else1572      fir::runtime::genAssign(builder, loc, toMutableBox, from);1573    return;1574  }1575 1576  // Otherwise, the derived type has compile time constant size and for which1577  // the component by component assignment can be replaced by a memory copy.1578  // Since we do not know the size of the derived type in lowering, do a1579  // component by component assignment. Note that a single fir.load/fir.store1580  // could be used on "small" record types, but as the type size grows, this1581  // leads to issues in LLVM (long compile times, long IR files, and even1582  // asserts at some point). Since there is no good size boundary, just always1583  // use component by component assignment here.1584  genComponentByComponentAssignment(builder, loc, lhs, rhs, isTemporaryLHS);1585}1586 1587mlir::TupleType1588fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {1589  mlir::IntegerType i64Ty = builder.getIntegerType(64);1590  auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1);1591  auto buffTy = fir::HeapType::get(arrTy);1592  auto extTy = fir::SequenceType::get(i64Ty, 1);1593  auto shTy = fir::HeapType::get(extTy);1594  return mlir::TupleType::get(builder.getContext(), {i64Ty, buffTy, shTy});1595}1596 1597mlir::Value fir::factory::genLenOfCharacter(1598    fir::FirOpBuilder &builder, mlir::Location loc, fir::ArrayLoadOp arrLoad,1599    llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {1600  llvm::SmallVector<mlir::Value> typeParams(arrLoad.getTypeparams());1601  return genLenOfCharacter(builder, loc,1602                           mlir::cast<fir::SequenceType>(arrLoad.getType()),1603                           arrLoad.getMemref(), typeParams, path, substring);1604}1605 1606mlir::Value fir::factory::genLenOfCharacter(1607    fir::FirOpBuilder &builder, mlir::Location loc, fir::SequenceType seqTy,1608    mlir::Value memref, llvm::ArrayRef<mlir::Value> typeParams,1609    llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {1610  auto idxTy = builder.getIndexType();1611  auto zero = builder.createIntegerConstant(loc, idxTy, 0);1612  auto saturatedDiff = [&](mlir::Value lower, mlir::Value upper) {1613    auto diff = mlir::arith::SubIOp::create(builder, loc, upper, lower);1614    auto one = builder.createIntegerConstant(loc, idxTy, 1);1615    auto size = mlir::arith::AddIOp::create(builder, loc, diff, one);1616    auto cmp = mlir::arith::CmpIOp::create(1617        builder, loc, mlir::arith::CmpIPredicate::sgt, size, zero);1618    return mlir::arith::SelectOp::create(builder, loc, cmp, size, zero);1619  };1620  if (substring.size() == 2) {1621    auto upper = builder.createConvert(loc, idxTy, substring.back());1622    auto lower = builder.createConvert(loc, idxTy, substring.front());1623    return saturatedDiff(lower, upper);1624  }1625  auto lower = zero;1626  if (substring.size() == 1)1627    lower = builder.createConvert(loc, idxTy, substring.front());1628  auto eleTy = fir::applyPathToType(seqTy, path);1629  if (!fir::hasDynamicSize(eleTy)) {1630    if (auto charTy = mlir::dyn_cast<fir::CharacterType>(eleTy)) {1631      // Use LEN from the type.1632      return builder.createIntegerConstant(loc, idxTy, charTy.getLen());1633    }1634    // Do we need to support !fir.array<!fir.char<k,n>>?1635    fir::emitFatalError(loc,1636                        "application of path did not result in a !fir.char");1637  }1638  if (fir::isa_box_type(memref.getType())) {1639    if (mlir::isa<fir::BoxCharType>(memref.getType()))1640      return fir::BoxCharLenOp::create(builder, loc, idxTy, memref);1641    if (mlir::isa<fir::BoxType>(memref.getType()))1642      return CharacterExprHelper(builder, loc).readLengthFromBox(memref);1643    fir::emitFatalError(loc, "memref has wrong type");1644  }1645  if (typeParams.empty()) {1646    fir::emitFatalError(loc, "array_load must have typeparams");1647  }1648  if (fir::isa_char(seqTy.getEleTy())) {1649    assert(typeParams.size() == 1 && "too many typeparams");1650    return typeParams.front();1651  }1652  TODO(loc, "LEN of character must be computed at runtime");1653}1654 1655mlir::Value fir::factory::createZeroValue(fir::FirOpBuilder &builder,1656                                          mlir::Location loc, mlir::Type type) {1657  mlir::Type i1 = builder.getIntegerType(1);1658  if (mlir::isa<fir::LogicalType>(type) || type == i1)1659    return builder.createConvert(loc, type, builder.createBool(loc, false));1660  if (fir::isa_integer(type))1661    return builder.createIntegerConstant(loc, type, 0);1662  if (fir::isa_real(type))1663    return builder.createRealZeroConstant(loc, type);1664  if (fir::isa_complex(type)) {1665    fir::factory::Complex complexHelper(builder, loc);1666    mlir::Type partType = complexHelper.getComplexPartType(type);1667    mlir::Value zeroPart = builder.createRealZeroConstant(loc, partType);1668    return complexHelper.createComplex(type, zeroPart, zeroPart);1669  }1670  fir::emitFatalError(loc, "internal: trying to generate zero value of non "1671                           "numeric or logical type");1672}1673 1674std::optional<std::int64_t>1675fir::factory::getExtentFromTriplet(mlir::Value lb, mlir::Value ub,1676                                   mlir::Value stride) {1677  std::function<std::optional<std::int64_t>(mlir::Value)> getConstantValue =1678      [&](mlir::Value value) -> std::optional<std::int64_t> {1679    if (auto valInt = fir::getIntIfConstant(value))1680      return *valInt;1681    auto *definingOp = value.getDefiningOp();1682    if (mlir::isa_and_nonnull<fir::ConvertOp>(definingOp)) {1683      auto valOp = mlir::dyn_cast<fir::ConvertOp>(definingOp);1684      return getConstantValue(valOp.getValue());1685    }1686    return {};1687  };1688  if (auto lbInt = getConstantValue(lb)) {1689    if (auto ubInt = getConstantValue(ub)) {1690      if (auto strideInt = getConstantValue(stride)) {1691        if (*strideInt != 0) {1692          std::int64_t extent = 1 + (*ubInt - *lbInt) / *strideInt;1693          if (extent > 0)1694            return extent;1695        }1696      }1697    }1698  }1699  return {};1700}1701 1702mlir::Value fir::factory::genMaxWithZero(fir::FirOpBuilder &builder,1703                                         mlir::Location loc, mlir::Value value,1704                                         mlir::Value zero) {1705  if (mlir::Operation *definingOp = value.getDefiningOp())1706    if (auto cst = mlir::dyn_cast<mlir::arith::ConstantOp>(definingOp))1707      if (auto intAttr = mlir::dyn_cast<mlir::IntegerAttr>(cst.getValue()))1708        return intAttr.getInt() > 0 ? value : zero;1709  mlir::Value valueIsGreater = mlir::arith::CmpIOp::create(1710      builder, loc, mlir::arith::CmpIPredicate::sgt, value, zero);1711  return mlir::arith::SelectOp::create(builder, loc, valueIsGreater, value,1712                                       zero);1713}1714 1715mlir::Value fir::factory::genMaxWithZero(fir::FirOpBuilder &builder,1716                                         mlir::Location loc,1717                                         mlir::Value value) {1718  mlir::Value zero = builder.createIntegerConstant(loc, value.getType(), 0);1719  return genMaxWithZero(builder, loc, value, zero);1720}1721 1722mlir::Value fir::factory::computeExtent(fir::FirOpBuilder &builder,1723                                        mlir::Location loc, mlir::Value lb,1724                                        mlir::Value ub, mlir::Value zero,1725                                        mlir::Value one) {1726  mlir::Type type = lb.getType();1727  // Let the folder deal with the common `ub - <const> + 1` case.1728  auto diff = mlir::arith::SubIOp::create(builder, loc, type, ub, lb);1729  auto rawExtent = mlir::arith::AddIOp::create(builder, loc, type, diff, one);1730  return fir::factory::genMaxWithZero(builder, loc, rawExtent, zero);1731}1732mlir::Value fir::factory::computeExtent(fir::FirOpBuilder &builder,1733                                        mlir::Location loc, mlir::Value lb,1734                                        mlir::Value ub) {1735  mlir::Type type = lb.getType();1736  mlir::Value one = builder.createIntegerConstant(loc, type, 1);1737  mlir::Value zero = builder.createIntegerConstant(loc, type, 0);1738  return computeExtent(builder, loc, lb, ub, zero, one);1739}1740 1741static std::pair<mlir::Value, mlir::Type>1742genCPtrOrCFunptrFieldIndex(fir::FirOpBuilder &builder, mlir::Location loc,1743                           mlir::Type cptrTy) {1744  auto recTy = mlir::cast<fir::RecordType>(cptrTy);1745  assert(recTy.getTypeList().size() == 1);1746  auto addrFieldName = recTy.getTypeList()[0].first;1747  mlir::Type addrFieldTy = recTy.getTypeList()[0].second;1748  auto fieldIndexType = fir::FieldType::get(cptrTy.getContext());1749  mlir::Value addrFieldIndex = fir::FieldIndexOp::create(1750      builder, loc, fieldIndexType, addrFieldName, recTy,1751      /*typeParams=*/mlir::ValueRange{});1752  return {addrFieldIndex, addrFieldTy};1753}1754 1755mlir::Value fir::factory::genCPtrOrCFunptrAddr(fir::FirOpBuilder &builder,1756                                               mlir::Location loc,1757                                               mlir::Value cPtr,1758                                               mlir::Type ty) {1759  auto [addrFieldIndex, addrFieldTy] =1760      genCPtrOrCFunptrFieldIndex(builder, loc, ty);1761  return fir::CoordinateOp::create(1762      builder, loc, builder.getRefType(addrFieldTy), cPtr, addrFieldIndex);1763}1764 1765mlir::Value fir::factory::genCDevPtrAddr(fir::FirOpBuilder &builder,1766                                         mlir::Location loc,1767                                         mlir::Value cDevPtr, mlir::Type ty) {1768  auto recTy = mlir::cast<fir::RecordType>(ty);1769  assert(recTy.getTypeList().size() == 1);1770  auto cptrFieldName = recTy.getTypeList()[0].first;1771  mlir::Type cptrFieldTy = recTy.getTypeList()[0].second;1772  auto fieldIndexType = fir::FieldType::get(ty.getContext());1773  mlir::Value cptrFieldIndex = fir::FieldIndexOp::create(1774      builder, loc, fieldIndexType, cptrFieldName, recTy,1775      /*typeParams=*/mlir::ValueRange{});1776  auto cptrCoord = fir::CoordinateOp::create(1777      builder, loc, builder.getRefType(cptrFieldTy), cDevPtr, cptrFieldIndex);1778  auto [addrFieldIndex, addrFieldTy] =1779      genCPtrOrCFunptrFieldIndex(builder, loc, cptrFieldTy);1780  return fir::CoordinateOp::create(1781      builder, loc, builder.getRefType(addrFieldTy), cptrCoord, addrFieldIndex);1782}1783 1784mlir::Value fir::factory::genCPtrOrCFunptrValue(fir::FirOpBuilder &builder,1785                                                mlir::Location loc,1786                                                mlir::Value cPtr) {1787  mlir::Type cPtrTy = fir::unwrapRefType(cPtr.getType());1788  if (fir::isa_builtin_cdevptr_type(cPtrTy)) {1789    // Unwrap c_ptr from c_devptr.1790    auto [addrFieldIndex, addrFieldTy] =1791        genCPtrOrCFunptrFieldIndex(builder, loc, cPtrTy);1792    mlir::Value cPtrCoor;1793    if (fir::isa_ref_type(cPtr.getType())) {1794      cPtrCoor = fir::CoordinateOp::create(1795          builder, loc, builder.getRefType(addrFieldTy), cPtr, addrFieldIndex);1796    } else {1797      auto arrayAttr = builder.getArrayAttr(1798          {builder.getIntegerAttr(builder.getIndexType(), 0)});1799      cPtrCoor = fir::ExtractValueOp::create(builder, loc, addrFieldTy, cPtr,1800                                             arrayAttr);1801    }1802    return genCPtrOrCFunptrValue(builder, loc, cPtrCoor);1803  }1804 1805  if (fir::isa_ref_type(cPtr.getType())) {1806    mlir::Value cPtrAddr =1807        fir::factory::genCPtrOrCFunptrAddr(builder, loc, cPtr, cPtrTy);1808    return fir::LoadOp::create(builder, loc, cPtrAddr);1809  }1810  auto [addrFieldIndex, addrFieldTy] =1811      genCPtrOrCFunptrFieldIndex(builder, loc, cPtrTy);1812  auto arrayAttr =1813      builder.getArrayAttr({builder.getIntegerAttr(builder.getIndexType(), 0)});1814  return fir::ExtractValueOp::create(builder, loc, addrFieldTy, cPtr,1815                                     arrayAttr);1816}1817 1818fir::BoxValue fir::factory::createBoxValue(fir::FirOpBuilder &builder,1819                                           mlir::Location loc,1820                                           const fir::ExtendedValue &exv) {1821  if (auto *boxValue = exv.getBoxOf<fir::BoxValue>())1822    return *boxValue;1823  mlir::Value box = builder.createBox(loc, exv);1824  llvm::SmallVector<mlir::Value> lbounds;1825  llvm::SmallVector<mlir::Value> explicitTypeParams;1826  exv.match(1827      [&](const fir::ArrayBoxValue &box) {1828        lbounds.append(box.getLBounds().begin(), box.getLBounds().end());1829      },1830      [&](const fir::CharArrayBoxValue &box) {1831        lbounds.append(box.getLBounds().begin(), box.getLBounds().end());1832        explicitTypeParams.emplace_back(box.getLen());1833      },1834      [&](const fir::CharBoxValue &box) {1835        explicitTypeParams.emplace_back(box.getLen());1836      },1837      [&](const fir::MutableBoxValue &x) {1838        if (x.rank() > 0) {1839          // The resulting box lbounds must be coming from the mutable box.1840          fir::ExtendedValue boxVal =1841              fir::factory::genMutableBoxRead(builder, loc, x);1842          // Make sure we do not recurse infinitely.1843          if (boxVal.getBoxOf<fir::MutableBoxValue>())1844            fir::emitFatalError(loc, "mutable box read cannot be mutable box");1845          fir::BoxValue box =1846              fir::factory::createBoxValue(builder, loc, boxVal);1847          lbounds.append(box.getLBounds().begin(), box.getLBounds().end());1848        }1849        explicitTypeParams.append(x.nonDeferredLenParams().begin(),1850                                  x.nonDeferredLenParams().end());1851      },1852      [](const auto &) {});1853  return fir::BoxValue(box, lbounds, explicitTypeParams);1854}1855 1856mlir::Value fir::factory::createNullBoxProc(fir::FirOpBuilder &builder,1857                                            mlir::Location loc,1858                                            mlir::Type boxType) {1859  auto boxTy{mlir::dyn_cast<fir::BoxProcType>(boxType)};1860  if (!boxTy)1861    fir::emitFatalError(loc, "Procedure pointer must be of BoxProcType");1862  auto boxEleTy{fir::unwrapRefType(boxTy.getEleTy())};1863  mlir::Value initVal{fir::ZeroOp::create(builder, loc, boxEleTy)};1864  return fir::EmboxProcOp::create(builder, loc, boxTy, initVal);1865}1866 1867void fir::factory::setInternalLinkage(mlir::func::FuncOp func) {1868  auto internalLinkage = mlir::LLVM::linkage::Linkage::Internal;1869  auto linkage =1870      mlir::LLVM::LinkageAttr::get(func->getContext(), internalLinkage);1871  func->setAttr("llvm.linkage", linkage);1872}1873 1874uint64_t1875fir::factory::getAllocaAddressSpace(const mlir::DataLayout *dataLayout) {1876  if (dataLayout)1877    if (mlir::Attribute addrSpace = dataLayout->getAllocaMemorySpace())1878      return mlir::cast<mlir::IntegerAttr>(addrSpace).getUInt();1879  return 0;1880}1881 1882llvm::SmallVector<mlir::Value>1883fir::factory::deduceOptimalExtents(mlir::ValueRange extents1,1884                                   mlir::ValueRange extents2) {1885  llvm::SmallVector<mlir::Value> extents;1886  extents.reserve(extents1.size());1887  for (auto [extent1, extent2] : llvm::zip(extents1, extents2)) {1888    if (!fir::getIntIfConstant(extent1) && fir::getIntIfConstant(extent2))1889      extents.push_back(extent2);1890    else1891      extents.push_back(extent1);1892  }1893  return extents;1894}1895 1896uint64_t fir::factory::getGlobalAddressSpace(mlir::DataLayout *dataLayout) {1897  if (dataLayout)1898    if (mlir::Attribute addrSpace = dataLayout->getGlobalMemorySpace())1899      return mlir::cast<mlir::IntegerAttr>(addrSpace).getUInt();1900  return 0;1901}1902 1903uint64_t fir::factory::getProgramAddressSpace(mlir::DataLayout *dataLayout) {1904  if (dataLayout)1905    if (mlir::Attribute addrSpace = dataLayout->getProgramMemorySpace())1906      return mlir::cast<mlir::IntegerAttr>(addrSpace).getUInt();1907  return 0;1908}1909 1910llvm::SmallVector<mlir::Value> fir::factory::updateRuntimeExtentsForEmptyArrays(1911    fir::FirOpBuilder &builder, mlir::Location loc, mlir::ValueRange extents) {1912  if (extents.size() <= 1)1913    return extents;1914 1915  mlir::Type i1Type = builder.getI1Type();1916  mlir::Value isEmpty = createZeroValue(builder, loc, i1Type);1917 1918  llvm::SmallVector<mlir::Value, Fortran::common::maxRank> zeroes;1919  for (mlir::Value extent : extents) {1920    mlir::Type type = extent.getType();1921    mlir::Value zero = createZeroValue(builder, loc, type);1922    zeroes.push_back(zero);1923    mlir::Value isZero = mlir::arith::CmpIOp::create(1924        builder, loc, mlir::arith::CmpIPredicate::eq, extent, zero);1925    isEmpty = mlir::arith::OrIOp::create(builder, loc, isEmpty, isZero);1926  }1927 1928  llvm::SmallVector<mlir::Value> newExtents;1929  for (auto [zero, extent] : llvm::zip_equal(zeroes, extents)) {1930    newExtents.push_back(1931        mlir::arith::SelectOp::create(builder, loc, isEmpty, zero, extent));1932  }1933  return newExtents;1934}1935 1936void fir::factory::genDimInfoFromBox(1937    fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value box,1938    llvm::SmallVectorImpl<mlir::Value> *lbounds,1939    llvm::SmallVectorImpl<mlir::Value> *extents,1940    llvm::SmallVectorImpl<mlir::Value> *strides) {1941  auto boxType = mlir::dyn_cast<fir::BaseBoxType>(box.getType());1942  assert(boxType && "must be a box");1943  if (!lbounds && !extents && !strides)1944    return;1945 1946  unsigned rank = fir::getBoxRank(boxType);1947  assert(!boxType.isAssumedRank() && "must be an array of known rank");1948  mlir::Type idxTy = builder.getIndexType();1949  for (unsigned i = 0; i < rank; ++i) {1950    mlir::Value dim = builder.createIntegerConstant(loc, idxTy, i);1951    auto dimInfo =1952        fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy, box, dim);1953    if (lbounds)1954      lbounds->push_back(dimInfo.getLowerBound());1955    if (extents)1956      extents->push_back(dimInfo.getExtent());1957    if (strides)1958      strides->push_back(dimInfo.getByteStride());1959  }1960}1961 1962mlir::Value fir::factory::genLifetimeStart(mlir::OpBuilder &builder,1963                                           mlir::Location loc,1964                                           fir::AllocaOp alloc,1965                                           const mlir::DataLayout *dl) {1966  mlir::Type ptrTy = mlir::LLVM::LLVMPointerType::get(1967      alloc.getContext(), getAllocaAddressSpace(dl));1968  mlir::Value cast =1969      fir::ConvertOp::create(builder, loc, ptrTy, alloc.getResult());1970  mlir::LLVM::LifetimeStartOp::create(builder, loc, cast);1971  return cast;1972}1973 1974void fir::factory::genLifetimeEnd(mlir::OpBuilder &builder, mlir::Location loc,1975                                  mlir::Value cast) {1976  mlir::LLVM::LifetimeEndOp::create(builder, loc, cast);1977}1978 1979mlir::Value fir::factory::getDescriptorWithNewBaseAddress(1980    fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value box,1981    mlir::Value newAddr) {1982  auto boxType = llvm::dyn_cast<fir::BaseBoxType>(box.getType());1983  assert(boxType &&1984         "expected a box type input in getDescriptorWithNewBaseAddress");1985  if (boxType.isAssumedRank())1986    TODO(loc, "changing descriptor base address for an assumed rank entity");1987  llvm::SmallVector<mlir::Value> lbounds;1988  fir::factory::genDimInfoFromBox(builder, loc, box, &lbounds,1989                                  /*extents=*/nullptr, /*strides=*/nullptr);1990  fir::BoxValue inputBoxValue(box, lbounds, /*explicitParams=*/{});1991  fir::ExtendedValue openedInput =1992      fir::factory::readBoxValue(builder, loc, inputBoxValue);1993  mlir::Value shape = fir::isArray(openedInput)1994                          ? builder.createShape(loc, openedInput)1995                          : mlir::Value{};1996  mlir::Value typeMold = fir::isPolymorphicType(boxType) ? box : mlir::Value{};1997  return builder.createBox(loc, boxType, newAddr, shape, /*slice=*/{},1998                           fir::getTypeParams(openedInput), typeMold);1999}2000