xref: /llvm-project/flang/lib/Lower/ConvertVariable.cpp (revision ce32625966a922fe96aababe0ed975ada004901f)

//===-- ConvertVariable.cpp -- bridge to lower to MLIR --------------------===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
//
// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
//
//===----------------------------------------------------------------------===//

#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/AbstractConverter.h"
#include "flang/Lower/Allocatable.h"
#include "flang/Lower/BoxAnalyzer.h"
#include "flang/Lower/CallInterface.h"
#include "flang/Lower/ConvertConstant.h"
#include "flang/Lower/ConvertExpr.h"
#include "flang/Lower/ConvertExprToHLFIR.h"
#include "flang/Lower/ConvertProcedureDesignator.h"
#include "flang/Lower/Mangler.h"
#include "flang/Lower/PFTBuilder.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/Support/Utils.h"
#include "flang/Lower/SymbolMap.h"
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/HLFIRTools.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Builder/Runtime/Derived.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/CUF/CUFOps.h"
#include "flang/Optimizer/Dialect/FIRAttr.h"
#include "flang/Optimizer/Dialect/FIRDialect.h"
#include "flang/Optimizer/Dialect/FIROps.h"
#include "flang/Optimizer/Dialect/Support/FIRContext.h"
#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include "flang/Optimizer/Support/FatalError.h"
#include "flang/Optimizer/Support/InternalNames.h"
#include "flang/Optimizer/Support/Utils.h"
#include "flang/Runtime/allocator-registry-consts.h"
#include "flang/Semantics/runtime-type-info.h"
#include "flang/Semantics/tools.h"
#include "llvm/Support/CommandLine.h"
#include "llvm/Support/Debug.h"
#include <optional>

static llvm::cl::opt<bool>
    allowAssumedRank("allow-assumed-rank",
                     llvm::cl::desc("Enable assumed rank lowering"),
                     llvm::cl::init(true));

#define DEBUG_TYPE "flang-lower-variable"

/// Helper to lower a scalar expression using a specific symbol mapping.
static mlir::Value genScalarValue(Fortran::lower::AbstractConverter &converter,
                                  mlir::Location loc,
                                  const Fortran::lower::SomeExpr &expr,
                                  Fortran::lower::SymMap &symMap,
                                  Fortran::lower::StatementContext &context) {
  // This does not use the AbstractConverter member function to override the
  // symbol mapping to be used expression lowering.
  if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
    hlfir::EntityWithAttributes loweredExpr =
        Fortran::lower::convertExprToHLFIR(loc, converter, expr, symMap,
                                           context);
    return hlfir::loadTrivialScalar(loc, converter.getFirOpBuilder(),
                                    loweredExpr);
  }
  return fir::getBase(Fortran::lower::createSomeExtendedExpression(
      loc, converter, expr, symMap, context));
}

/// Does this variable have a default initialization?
bool Fortran::lower::hasDefaultInitialization(
    const Fortran::semantics::Symbol &sym) {
  if (sym.has<Fortran::semantics::ObjectEntityDetails>() && sym.size())
    if (!Fortran::semantics::IsAllocatableOrPointer(sym))
      if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
        if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
                declTypeSpec->AsDerived()) {
          // Pointer assignments in the runtime may hit undefined behaviors if
          // the RHS contains garbage. Pointer objects are always established by
          // lowering to NULL() (in Fortran::lower::createMutableBox). However,
          // pointer components need special care here so that local and global
          // derived type containing pointers are always initialized.
          // Intent(out), however, do not need to be initialized since the
          // related descriptor storage comes from a local or global that has
          // been initialized (it may not be NULL() anymore, but the rank, type,
          // and non deferred length parameters are still correct in a
          // conformant program, and that is what matters).
          const bool ignorePointer = Fortran::semantics::IsIntentOut(sym);
          return derivedTypeSpec->HasDefaultInitialization(
              /*ignoreAllocatable=*/false, ignorePointer);
        }
  return false;
}

// Does this variable have a finalization?
static bool hasFinalization(const Fortran::semantics::Symbol &sym) {
  if (sym.has<Fortran::semantics::ObjectEntityDetails>())
    if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
      if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
              declTypeSpec->AsDerived())
        return Fortran::semantics::IsFinalizable(*derivedTypeSpec);
  return false;
}

// Does this variable have an allocatable direct component?
static bool
hasAllocatableDirectComponent(const Fortran::semantics::Symbol &sym) {
  if (sym.has<Fortran::semantics::ObjectEntityDetails>())
    if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
      if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
              declTypeSpec->AsDerived())
        return Fortran::semantics::HasAllocatableDirectComponent(
            *derivedTypeSpec);
  return false;
}
//===----------------------------------------------------------------===//
// Global variables instantiation (not for alias and common)
//===----------------------------------------------------------------===//

/// Helper to generate expression value inside global initializer.
static fir::ExtendedValue
genInitializerExprValue(Fortran::lower::AbstractConverter &converter,
                        mlir::Location loc,
                        const Fortran::lower::SomeExpr &expr,
                        Fortran::lower::StatementContext &stmtCtx) {
  // Data initializer are constant value and should not depend on other symbols
  // given the front-end fold parameter references. In any case, the "current"
  // map of the converter should not be used since it holds mapping to
  // mlir::Value from another mlir region. If these value are used by accident
  // in the initializer, this will lead to segfaults in mlir code.
  Fortran::lower::SymMap emptyMap;
  return Fortran::lower::createSomeInitializerExpression(loc, converter, expr,
                                                         emptyMap, stmtCtx);
}

/// Can this symbol constant be placed in read-only memory?
static bool isConstant(const Fortran::semantics::Symbol &sym) {
  return sym.attrs().test(Fortran::semantics::Attr::PARAMETER) ||
         sym.test(Fortran::semantics::Symbol::Flag::ReadOnly);
}

static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
                                  const Fortran::lower::pft::Variable &var,
                                  llvm::StringRef globalName,
                                  mlir::StringAttr linkage,
                                  cuf::DataAttributeAttr dataAttr = {});

static mlir::Location genLocation(Fortran::lower::AbstractConverter &converter,
                                  const Fortran::semantics::Symbol &sym) {
  // Compiler generated name cannot be used as source location, their name
  // is not pointing to the source files.
  if (!sym.test(Fortran::semantics::Symbol::Flag::CompilerCreated))
    return converter.genLocation(sym.name());
  return converter.getCurrentLocation();
}

/// Create the global op declaration without any initializer
static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
                                   const Fortran::lower::pft::Variable &var,
                                   llvm::StringRef globalName,
                                   mlir::StringAttr linkage) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  if (fir::GlobalOp global = builder.getNamedGlobal(globalName))
    return global;
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  cuf::DataAttributeAttr dataAttr =
      Fortran::lower::translateSymbolCUFDataAttribute(
          converter.getFirOpBuilder().getContext(), sym);
  // Always define linkonce data since it may be optimized out from the module
  // that actually owns the variable if it does not refers to it.
  if (linkage == builder.createLinkOnceODRLinkage() ||
      linkage == builder.createLinkOnceLinkage())
    return defineGlobal(converter, var, globalName, linkage, dataAttr);
  mlir::Location loc = genLocation(converter, sym);
  // Resolve potential host and module association before checking that this
  // symbol is an object of a function pointer.
  const Fortran::semantics::Symbol &ultimate = sym.GetUltimate();
  if (!ultimate.has<Fortran::semantics::ObjectEntityDetails>() &&
      !Fortran::semantics::IsProcedurePointer(ultimate))
    mlir::emitError(loc, "processing global declaration: symbol '")
        << toStringRef(sym.name()) << "' has unexpected details\n";
  return builder.createGlobal(loc, converter.genType(var), globalName, linkage,
                              mlir::Attribute{}, isConstant(ultimate),
                              var.isTarget(), dataAttr);
}

/// Temporary helper to catch todos in initial data target lowering.
static bool
hasDerivedTypeWithLengthParameters(const Fortran::semantics::Symbol &sym) {
  if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType())
    if (const Fortran::semantics::DerivedTypeSpec *derived =
            declTy->AsDerived())
      return Fortran::semantics::CountLenParameters(*derived) > 0;
  return false;
}

fir::ExtendedValue Fortran::lower::genExtAddrInInitializer(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    const Fortran::lower::SomeExpr &addr) {
  Fortran::lower::SymMap globalOpSymMap;
  Fortran::lower::AggregateStoreMap storeMap;
  Fortran::lower::StatementContext stmtCtx;
  if (const Fortran::semantics::Symbol *sym =
          Fortran::evaluate::GetFirstSymbol(addr)) {
    // Length parameters processing will need care in global initializer
    // context.
    if (hasDerivedTypeWithLengthParameters(*sym))
      TODO(loc, "initial-data-target with derived type length parameters");

    auto var = Fortran::lower::pft::Variable(*sym, /*global=*/true);
    Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
                                        storeMap);
  }

  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
    return Fortran::lower::convertExprToAddress(loc, converter, addr,
                                                globalOpSymMap, stmtCtx);
  return Fortran::lower::createInitializerAddress(loc, converter, addr,
                                                  globalOpSymMap, stmtCtx);
}

/// create initial-data-target fir.box in a global initializer region.
mlir::Value Fortran::lower::genInitialDataTarget(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Type boxType, const Fortran::lower::SomeExpr &initialTarget,
    bool couldBeInEquivalence) {
  Fortran::lower::SymMap globalOpSymMap;
  Fortran::lower::AggregateStoreMap storeMap;
  Fortran::lower::StatementContext stmtCtx;
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
          initialTarget))
    return fir::factory::createUnallocatedBox(
        builder, loc, boxType,
        /*nonDeferredParams=*/std::nullopt);
  // Pointer initial data target, and NULL(mold).
  for (const auto &sym : Fortran::evaluate::CollectSymbols(initialTarget)) {
    // Derived type component symbols should not be instantiated as objects
    // on their own.
    if (sym->owner().IsDerivedType())
      continue;
    // Length parameters processing will need care in global initializer
    // context.
    if (hasDerivedTypeWithLengthParameters(sym))
      TODO(loc, "initial-data-target with derived type length parameters");
    auto var = Fortran::lower::pft::Variable(sym, /*global=*/true);
    if (couldBeInEquivalence) {
      auto dependentVariableList =
          Fortran::lower::pft::getDependentVariableList(sym);
      for (Fortran::lower::pft::Variable var : dependentVariableList) {
        if (!var.isAggregateStore())
          break;
        instantiateVariable(converter, var, globalOpSymMap, storeMap);
      }
      var = dependentVariableList.back();
      assert(var.getSymbol().name() == sym->name() &&
             "missing symbol in dependence list");
    }
    Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
                                        storeMap);
  }

  // Handle NULL(mold) as a special case. Return an unallocated box of MOLD
  // type. The return box is correctly created as a fir.box<fir.ptr<T>> where
  // T is extracted from the MOLD argument.
  if (const Fortran::evaluate::ProcedureRef *procRef =
          Fortran::evaluate::UnwrapProcedureRef(initialTarget)) {
    const Fortran::evaluate::SpecificIntrinsic *intrinsic =
        procRef->proc().GetSpecificIntrinsic();
    if (intrinsic && intrinsic->name == "null") {
      assert(procRef->arguments().size() == 1 &&
             "Expecting mold argument for NULL intrinsic");
      const auto *argExpr = procRef->arguments()[0].value().UnwrapExpr();
      assert(argExpr);
      const Fortran::semantics::Symbol *sym =
          Fortran::evaluate::GetFirstSymbol(*argExpr);
      assert(sym && "MOLD must be a pointer or allocatable symbol");
      mlir::Type boxType = converter.genType(*sym);
      mlir::Value box =
          fir::factory::createUnallocatedBox(builder, loc, boxType, {});
      return box;
    }
  }

  mlir::Value targetBox;
  mlir::Value targetShift;
  if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
    auto target = Fortran::lower::convertExprToBox(
        loc, converter, initialTarget, globalOpSymMap, stmtCtx);
    targetBox = fir::getBase(target);
    targetShift = builder.createShape(loc, target);
  } else {
    if (initialTarget.Rank() > 0) {
      auto target = Fortran::lower::createSomeArrayBox(converter, initialTarget,
                                                       globalOpSymMap, stmtCtx);
      targetBox = fir::getBase(target);
      targetShift = builder.createShape(loc, target);
    } else {
      fir::ExtendedValue addr = Fortran::lower::createInitializerAddress(
          loc, converter, initialTarget, globalOpSymMap, stmtCtx);
      targetBox = builder.createBox(loc, addr);
      // Nothing to do for targetShift, the target is a scalar.
    }
  }
  // The targetBox is a fir.box<T>, not a fir.box<fir.ptr<T>> as it should for
  // pointers (this matters to get the POINTER attribute correctly inside the
  // initial value of the descriptor).
  // Create a fir.rebox to set the attribute correctly, and use targetShift
  // to preserve the target lower bounds if any.
  return builder.create<fir::ReboxOp>(loc, boxType, targetBox, targetShift,
                                      /*slice=*/mlir::Value{});
}

/// Generate default initial value for a derived type object \p sym with mlir
/// type \p symTy.
static mlir::Value genDefaultInitializerValue(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    const Fortran::semantics::Symbol &sym, mlir::Type symTy,
    Fortran::lower::StatementContext &stmtCtx);

/// Generate the initial value of a derived component \p component and insert
/// it into the derived type initial value \p insertInto of type \p recTy.
/// Return the new derived type initial value after the insertion.
static mlir::Value genComponentDefaultInit(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    const Fortran::semantics::Symbol &component, fir::RecordType recTy,
    mlir::Value insertInto, Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  std::string name = converter.getRecordTypeFieldName(component);
  mlir::Type componentTy = recTy.getType(name);
  assert(componentTy && "component not found in type");
  mlir::Value componentValue;
  if (const auto *object{
          component.detailsIf<Fortran::semantics::ObjectEntityDetails>()}) {
    if (const auto &init = object->init()) {
      // Component has explicit initialization.
      if (Fortran::semantics::IsPointer(component))
        // Initial data target.
        componentValue =
            genInitialDataTarget(converter, loc, componentTy, *init);
      else
        // Initial value.
        componentValue = fir::getBase(
            genInitializerExprValue(converter, loc, *init, stmtCtx));
    } else if (Fortran::semantics::IsAllocatableOrPointer(component)) {
      // Pointer or allocatable without initialization.
      // Create deallocated/disassociated value.
      // From a standard point of view, pointer without initialization do not
      // need to be disassociated, but for sanity and simplicity, do it in
      // global constructor since this has no runtime cost.
      componentValue = fir::factory::createUnallocatedBox(
          builder, loc, componentTy, std::nullopt);
    } else if (Fortran::lower::hasDefaultInitialization(component)) {
      // Component type has default initialization.
      componentValue = genDefaultInitializerValue(converter, loc, component,
                                                  componentTy, stmtCtx);
    } else {
      // Component has no initial value. Set its bits to zero by extension
      // to match what is expected because other compilers are doing it.
      componentValue = builder.create<fir::ZeroOp>(loc, componentTy);
    }
  } else if (const auto *proc{
                 component
                     .detailsIf<Fortran::semantics::ProcEntityDetails>()}) {
    if (proc->init().has_value()) {
      auto sym{*proc->init()};
      if (sym) // Has a procedure target.
        componentValue =
            Fortran::lower::convertProcedureDesignatorInitialTarget(converter,
                                                                    loc, *sym);
      else // Has NULL() target.
        componentValue =
            fir::factory::createNullBoxProc(builder, loc, componentTy);
    } else
      componentValue = builder.create<fir::ZeroOp>(loc, componentTy);
  }
  assert(componentValue && "must have been computed");
  componentValue = builder.createConvert(loc, componentTy, componentValue);
  auto fieldTy = fir::FieldType::get(recTy.getContext());
  // FIXME: type parameters must come from the derived-type-spec
  auto field = builder.create<fir::FieldIndexOp>(
      loc, fieldTy, name, recTy,
      /*typeParams=*/mlir::ValueRange{} /*TODO*/);
  return builder.create<fir::InsertValueOp>(
      loc, recTy, insertInto, componentValue,
      builder.getArrayAttr(field.getAttributes()));
}

static mlir::Value genDefaultInitializerValue(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    const Fortran::semantics::Symbol &sym, mlir::Type symTy,
    Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Type scalarType = symTy;
  fir::SequenceType sequenceType;
  if (auto ty = mlir::dyn_cast<fir::SequenceType>(symTy)) {
    sequenceType = ty;
    scalarType = ty.getEleTy();
  }
  // Build a scalar default value of the symbol type, looping through the
  // components to build each component initial value.
  auto recTy = mlir::cast<fir::RecordType>(scalarType);
  mlir::Value initialValue = builder.create<fir::UndefOp>(loc, scalarType);
  const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType();
  assert(declTy && "var with default initialization must have a type");

  if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
    // In HLFIR, the parent type is the first component, while in FIR there is
    // not parent component in the fir.type and the component of the parent are
    // "inlined" at the beginning of the fir.type.
    const Fortran::semantics::Symbol &typeSymbol =
        declTy->derivedTypeSpec().typeSymbol();
    const Fortran::semantics::Scope *derivedScope =
        declTy->derivedTypeSpec().GetScope();
    assert(derivedScope && "failed to retrieve derived type scope");
    for (const auto &componentName :
         typeSymbol.get<Fortran::semantics::DerivedTypeDetails>()
             .componentNames()) {
      auto scopeIter = derivedScope->find(componentName);
      assert(scopeIter != derivedScope->cend() &&
             "failed to find derived type component symbol");
      const Fortran::semantics::Symbol &component = scopeIter->second.get();
      initialValue = genComponentDefaultInit(converter, loc, component, recTy,
                                             initialValue, stmtCtx);
    }
  } else {
    Fortran::semantics::OrderedComponentIterator components(
        declTy->derivedTypeSpec());
    for (const auto &component : components) {
      // Skip parent components, the sub-components of parent types are part of
      // components and will be looped through right after.
      if (component.test(Fortran::semantics::Symbol::Flag::ParentComp))
        continue;
      initialValue = genComponentDefaultInit(converter, loc, component, recTy,
                                             initialValue, stmtCtx);
    }
  }

  if (sequenceType) {
    // For arrays, duplicate the scalar value to all elements with an
    // fir.insert_range covering the whole array.
    auto arrayInitialValue = builder.create<fir::UndefOp>(loc, sequenceType);
    llvm::SmallVector<int64_t> rangeBounds;
    for (int64_t extent : sequenceType.getShape()) {
      if (extent == fir::SequenceType::getUnknownExtent())
        TODO(loc,
             "default initial value of array component with length parameters");
      rangeBounds.push_back(0);
      rangeBounds.push_back(extent - 1);
    }
    return builder.create<fir::InsertOnRangeOp>(
        loc, sequenceType, arrayInitialValue, initialValue,
        builder.getIndexVectorAttr(rangeBounds));
  }
  return initialValue;
}

/// Does this global already have an initializer ?
static bool globalIsInitialized(fir::GlobalOp global) {
  return !global.getRegion().empty() || global.getInitVal();
}

/// Call \p genInit to generate code inside \p global initializer region.
void Fortran::lower::createGlobalInitialization(
    fir::FirOpBuilder &builder, fir::GlobalOp global,
    std::function<void(fir::FirOpBuilder &)> genInit) {
  mlir::Region &region = global.getRegion();
  region.push_back(new mlir::Block);
  mlir::Block &block = region.back();
  auto insertPt = builder.saveInsertionPoint();
  builder.setInsertionPointToStart(&block);
  genInit(builder);
  builder.restoreInsertionPoint(insertPt);
}

static unsigned getAllocatorIdx(cuf::DataAttributeAttr dataAttr) {
  if (dataAttr) {
    if (dataAttr.getValue() == cuf::DataAttribute::Pinned)
      return kPinnedAllocatorPos;
    if (dataAttr.getValue() == cuf::DataAttribute::Device)
      return kDeviceAllocatorPos;
    if (dataAttr.getValue() == cuf::DataAttribute::Managed)
      return kManagedAllocatorPos;
    if (dataAttr.getValue() == cuf::DataAttribute::Unified)
      return kUnifiedAllocatorPos;
  }
  return kDefaultAllocator;
}

/// Create the global op and its init if it has one
static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
                                  const Fortran::lower::pft::Variable &var,
                                  llvm::StringRef globalName,
                                  mlir::StringAttr linkage,
                                  cuf::DataAttributeAttr dataAttr) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  mlir::Location loc = genLocation(converter, sym);
  bool isConst = isConstant(sym);
  fir::GlobalOp global = builder.getNamedGlobal(globalName);
  mlir::Type symTy = converter.genType(var);

  if (global && globalIsInitialized(global))
    return global;

  if (!converter.getLoweringOptions().getLowerToHighLevelFIR() &&
      Fortran::semantics::IsProcedurePointer(sym))
    TODO(loc, "procedure pointer globals");

  // If this is an array, check to see if we can use a dense attribute
  // with a tensor mlir type. This optimization currently only supports
  // Fortran arrays of integer, real, complex, or logical. The tensor
  // type does not support nested structures.
  if (mlir::isa<fir::SequenceType>(symTy) &&
      !Fortran::semantics::IsAllocatableOrPointer(sym)) {
    mlir::Type eleTy = mlir::cast<fir::SequenceType>(symTy).getElementType();
    if (mlir::isa<mlir::IntegerType, mlir::FloatType, mlir::ComplexType,
                  fir::LogicalType>(eleTy)) {
      const auto *details =
          sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
      if (details->init()) {
        global = Fortran::lower::tryCreatingDenseGlobal(
            builder, loc, symTy, globalName, linkage, isConst,
            details->init().value(), dataAttr);
        if (global) {
          global.setVisibility(mlir::SymbolTable::Visibility::Public);
          return global;
        }
      }
    }
  }
  if (!global)
    global =
        builder.createGlobal(loc, symTy, globalName, linkage, mlir::Attribute{},
                             isConst, var.isTarget(), dataAttr);
  if (Fortran::semantics::IsAllocatableOrPointer(sym) &&
      !Fortran::semantics::IsProcedure(sym)) {
    const auto *details =
        sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
    if (details && details->init()) {
      auto expr = *details->init();
      Fortran::lower::createGlobalInitialization(
          builder, global, [&](fir::FirOpBuilder &b) {
            mlir::Value box = Fortran::lower::genInitialDataTarget(
                converter, loc, symTy, expr);
            b.create<fir::HasValueOp>(loc, box);
          });
    } else {
      // Create unallocated/disassociated descriptor if no explicit init
      Fortran::lower::createGlobalInitialization(
          builder, global, [&](fir::FirOpBuilder &b) {
            mlir::Value box = fir::factory::createUnallocatedBox(
                b, loc, symTy,
                /*nonDeferredParams=*/std::nullopt,
                /*typeSourceBox=*/{}, getAllocatorIdx(dataAttr));
            b.create<fir::HasValueOp>(loc, box);
          });
    }
  } else if (const auto *details =
                 sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
    if (details->init()) {
      Fortran::lower::createGlobalInitialization(
          builder, global, [&](fir::FirOpBuilder &builder) {
            Fortran::lower::StatementContext stmtCtx(
                /*cleanupProhibited=*/true);
            fir::ExtendedValue initVal = genInitializerExprValue(
                converter, loc, details->init().value(), stmtCtx);
            mlir::Value castTo =
                builder.createConvert(loc, symTy, fir::getBase(initVal));
            builder.create<fir::HasValueOp>(loc, castTo);
          });
    } else if (Fortran::lower::hasDefaultInitialization(sym)) {
      Fortran::lower::createGlobalInitialization(
          builder, global, [&](fir::FirOpBuilder &builder) {
            Fortran::lower::StatementContext stmtCtx(
                /*cleanupProhibited=*/true);
            mlir::Value initVal =
                genDefaultInitializerValue(converter, loc, sym, symTy, stmtCtx);
            mlir::Value castTo = builder.createConvert(loc, symTy, initVal);
            builder.create<fir::HasValueOp>(loc, castTo);
          });
    }
  } else if (Fortran::semantics::IsProcedurePointer(sym)) {
    const auto *details{sym.detailsIf<Fortran::semantics::ProcEntityDetails>()};
    if (details && details->init()) {
      auto sym{*details->init()};
      if (sym) // Has a procedure target.
        Fortran::lower::createGlobalInitialization(
            builder, global, [&](fir::FirOpBuilder &b) {
              Fortran::lower::StatementContext stmtCtx(
                  /*cleanupProhibited=*/true);
              auto box{Fortran::lower::convertProcedureDesignatorInitialTarget(
                  converter, loc, *sym)};
              auto castTo{builder.createConvert(loc, symTy, box)};
              b.create<fir::HasValueOp>(loc, castTo);
            });
      else { // Has NULL() target.
        Fortran::lower::createGlobalInitialization(
            builder, global, [&](fir::FirOpBuilder &b) {
              auto box{fir::factory::createNullBoxProc(b, loc, symTy)};
              b.create<fir::HasValueOp>(loc, box);
            });
      }
    } else {
      // No initialization.
      Fortran::lower::createGlobalInitialization(
          builder, global, [&](fir::FirOpBuilder &b) {
            auto box{fir::factory::createNullBoxProc(b, loc, symTy)};
            b.create<fir::HasValueOp>(loc, box);
          });
    }
  } else if (sym.has<Fortran::semantics::CommonBlockDetails>()) {
    mlir::emitError(loc, "COMMON symbol processed elsewhere");
  } else {
    TODO(loc, "global"); // Something else
  }
  // Creates zero initializer for globals without initializers, this is a common
  // and expected behavior (although not required by the standard)
  if (!globalIsInitialized(global)) {
    // Fortran does not provide means to specify that a BIND(C) module
    // uninitialized variables will be defined in C.
    // Add the common linkage to those to allow some level of support
    // for this use case. Note that this use case will not work if the Fortran
    // module code is placed in a shared library since, at least for the ELF
    // format, common symbols are assigned a section in shared libraries.
    // The best is still to declare C defined variables in a Fortran module file
    // with no other definitions, and to never link the resulting module object
    // file.
    if (sym.attrs().test(Fortran::semantics::Attr::BIND_C))
      global.setLinkName(builder.createCommonLinkage());
    Fortran::lower::createGlobalInitialization(
        builder, global, [&](fir::FirOpBuilder &builder) {
          mlir::Value initValue;
          if (converter.getLoweringOptions().getInitGlobalZero())
            initValue = builder.create<fir::ZeroOp>(loc, symTy);
          else
            initValue = builder.create<fir::UndefOp>(loc, symTy);
          builder.create<fir::HasValueOp>(loc, initValue);
        });
  }
  // Set public visibility to prevent global definition to be optimized out
  // even if they have no initializer and are unused in this compilation unit.
  global.setVisibility(mlir::SymbolTable::Visibility::Public);
  return global;
}

/// Return linkage attribute for \p var.
static mlir::StringAttr
getLinkageAttribute(fir::FirOpBuilder &builder,
                    const Fortran::lower::pft::Variable &var) {
  // Runtime type info for a same derived type is identical in each compilation
  // unit. It desired to avoid having to link against module that only define a
  // type. Therefore the runtime type info is generated everywhere it is needed
  // with `linkonce_odr` LLVM linkage.
  if (var.isRuntimeTypeInfoData())
    return builder.createLinkOnceODRLinkage();
  if (var.isModuleOrSubmoduleVariable())
    return {}; // external linkage
  // Otherwise, the variable is owned by a procedure and must not be visible in
  // other compilation units.
  return builder.createInternalLinkage();
}

/// Instantiate a global variable. If it hasn't already been processed, add
/// the global to the ModuleOp as a new uniqued symbol and initialize it with
/// the correct value. It will be referenced on demand using `fir.addr_of`.
static void instantiateGlobal(Fortran::lower::AbstractConverter &converter,
                              const Fortran::lower::pft::Variable &var,
                              Fortran::lower::SymMap &symMap) {
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  assert(!var.isAlias() && "must be handled in instantiateAlias");
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  std::string globalName = converter.mangleName(sym);
  mlir::Location loc = genLocation(converter, sym);
  mlir::StringAttr linkage = getLinkageAttribute(builder, var);
  fir::GlobalOp global;
  if (var.isModuleOrSubmoduleVariable()) {
    // A non-intrinsic module global is defined when lowering the module.
    // Emit only a declaration if the global does not exist.
    global = declareGlobal(converter, var, globalName, linkage);
  } else {
    cuf::DataAttributeAttr dataAttr =
        Fortran::lower::translateSymbolCUFDataAttribute(builder.getContext(),
                                                        sym);
    global = defineGlobal(converter, var, globalName, linkage, dataAttr);
  }
  auto addrOf = builder.create<fir::AddrOfOp>(loc, global.resultType(),
                                              global.getSymbol());
  Fortran::lower::StatementContext stmtCtx;
  mapSymbolAttributes(converter, var, symMap, stmtCtx, addrOf);
}

//===----------------------------------------------------------------===//
// Local variables instantiation (not for alias)
//===----------------------------------------------------------------===//

/// Create a stack slot for a local variable. Precondition: the insertion
/// point of the builder must be in the entry block, which is currently being
/// constructed.
static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
                                  mlir::Location loc,
                                  const Fortran::lower::pft::Variable &var,
                                  mlir::Value preAlloc,
                                  llvm::ArrayRef<mlir::Value> shape = {},
                                  llvm::ArrayRef<mlir::Value> lenParams = {}) {
  if (preAlloc)
    return preAlloc;
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  std::string nm = converter.mangleName(var.getSymbol());
  mlir::Type ty = converter.genType(var);
  const Fortran::semantics::Symbol &ultimateSymbol =
      var.getSymbol().GetUltimate();
  llvm::StringRef symNm = toStringRef(ultimateSymbol.name());
  bool isTarg = var.isTarget();

  // Do not allocate storage for cray pointee. The address inside the cray
  // pointer will be used instead when using the pointee. Allocating space
  // would be a waste of space, and incorrect if the pointee is a non dummy
  // assumed-size (possible with cray pointee).
  if (ultimateSymbol.test(Fortran::semantics::Symbol::Flag::CrayPointee))
    return builder.create<fir::ZeroOp>(loc, fir::ReferenceType::get(ty));

  if (Fortran::semantics::NeedCUDAAlloc(ultimateSymbol)) {
    cuf::DataAttributeAttr dataAttr =
        Fortran::lower::translateSymbolCUFDataAttribute(builder.getContext(),
                                                        ultimateSymbol);
    llvm::SmallVector<mlir::Value> indices;
    llvm::SmallVector<mlir::Value> elidedShape =
        fir::factory::elideExtentsAlreadyInType(ty, shape);
    llvm::SmallVector<mlir::Value> elidedLenParams =
        fir::factory::elideLengthsAlreadyInType(ty, lenParams);
    auto idxTy = builder.getIndexType();
    for (mlir::Value sh : elidedShape)
      indices.push_back(builder.createConvert(loc, idxTy, sh));
    mlir::Value alloc = builder.create<cuf::AllocOp>(
        loc, ty, nm, symNm, dataAttr, lenParams, indices);
    return alloc;
  }

  // Let the builder do all the heavy lifting.
  if (!Fortran::semantics::IsProcedurePointer(ultimateSymbol))
    return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);

  // Local procedure pointer.
  auto res{builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg)};
  auto box{fir::factory::createNullBoxProc(builder, loc, ty)};
  builder.create<fir::StoreOp>(loc, box, res);
  return res;
}

/// Must \p var be default initialized at runtime when entering its scope.
static bool
mustBeDefaultInitializedAtRuntime(const Fortran::lower::pft::Variable &var) {
  if (!var.hasSymbol())
    return false;
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  if (var.isGlobal())
    // Global variables are statically initialized.
    return false;
  if (Fortran::semantics::IsDummy(sym) && !Fortran::semantics::IsIntentOut(sym))
    return false;
  // Polymorphic intent(out) dummy might need default initialization
  // at runtime.
  if (Fortran::semantics::IsPolymorphic(sym) &&
      Fortran::semantics::IsDummy(sym) &&
      Fortran::semantics::IsIntentOut(sym) &&
      !Fortran::semantics::IsAllocatable(sym) &&
      !Fortran::semantics::IsPointer(sym))
    return true;
  // Local variables (including function results), and intent(out) dummies must
  // be default initialized at runtime if their type has default initialization.
  return Fortran::lower::hasDefaultInitialization(sym);
}

/// Call default initialization runtime routine to initialize \p var.
void Fortran::lower::defaultInitializeAtRuntime(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::semantics::Symbol &sym, Fortran::lower::SymMap &symMap) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Location loc = converter.getCurrentLocation();
  fir::ExtendedValue exv = converter.getSymbolExtendedValue(sym, &symMap);
  if (Fortran::semantics::IsOptional(sym)) {
    // 15.5.2.12 point 3, absent optional dummies are not initialized.
    // Creating descriptor/passing null descriptor to the runtime would
    // create runtime crashes.
    auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
                                                      fir::getBase(exv));
    builder.genIfThen(loc, isPresent)
        .genThen([&]() {
          auto box = builder.createBox(loc, exv);
          fir::runtime::genDerivedTypeInitialize(builder, loc, box);
        })
        .end();
  } else {
    mlir::Value box = builder.createBox(loc, exv);
    fir::runtime::genDerivedTypeInitialize(builder, loc, box);
  }
}

/// Call clone initialization runtime routine to initialize \p sym's value.
void Fortran::lower::initializeCloneAtRuntime(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::semantics::Symbol &sym, Fortran::lower::SymMap &symMap) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Location loc = converter.getCurrentLocation();
  fir::ExtendedValue exv = converter.getSymbolExtendedValue(sym, &symMap);
  mlir::Value newBox = builder.createBox(loc, exv);
  lower::SymbolBox hsb = converter.lookupOneLevelUpSymbol(sym);
  fir::ExtendedValue hexv = converter.symBoxToExtendedValue(hsb);
  mlir::Value box = builder.createBox(loc, hexv);
  fir::runtime::genDerivedTypeInitializeClone(builder, loc, newBox, box);
}

enum class VariableCleanUp { Finalize, Deallocate };
/// Check whether a local variable needs to be finalized according to clause
/// 7.5.6.3 point 3 or if it is an allocatable that must be deallocated. Note
/// that deallocation will trigger finalization if the type has any.
static std::optional<VariableCleanUp>
needDeallocationOrFinalization(const Fortran::lower::pft::Variable &var) {
  if (!var.hasSymbol())
    return std::nullopt;
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  const Fortran::semantics::Scope &owner = sym.owner();
  if (owner.kind() == Fortran::semantics::Scope::Kind::MainProgram) {
    // The standard does not require finalizing main program variables.
    return std::nullopt;
  }
  if (!Fortran::semantics::IsPointer(sym) &&
      !Fortran::semantics::IsDummy(sym) &&
      !Fortran::semantics::IsFunctionResult(sym) &&
      !Fortran::semantics::IsSaved(sym)) {
    if (Fortran::semantics::IsAllocatable(sym))
      return VariableCleanUp::Deallocate;
    if (hasFinalization(sym))
      return VariableCleanUp::Finalize;
    // hasFinalization() check above handled all cases that require
    // finalization, but we also have to deallocate all allocatable
    // components of local variables (since they are also local variables
    // according to F18 5.4.3.2.2, p. 2, note 1).
    // Here, the variable itself is not allocatable. If it has an allocatable
    // component the Destroy runtime does the job. Use the Finalize clean-up,
    // though there will be no finalization in runtime.
    if (hasAllocatableDirectComponent(sym))
      return VariableCleanUp::Finalize;
  }
  return std::nullopt;
}

/// Check whether a variable needs the be finalized according to clause 7.5.6.3
/// point 7.
/// Must be nonpointer, nonallocatable, INTENT (OUT) dummy argument.
static bool
needDummyIntentoutFinalization(const Fortran::lower::pft::Variable &var) {
  if (!var.hasSymbol())
    return false;
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  if (!Fortran::semantics::IsDummy(sym) ||
      !Fortran::semantics::IsIntentOut(sym) ||
      Fortran::semantics::IsAllocatable(sym) ||
      Fortran::semantics::IsPointer(sym))
    return false;
  // Polymorphic and unlimited polymorphic intent(out) dummy argument might need
  // finalization at runtime.
  if (Fortran::semantics::IsPolymorphic(sym) ||
      Fortran::semantics::IsUnlimitedPolymorphic(sym))
    return true;
  // Intent(out) dummies must be finalized at runtime if their type has a
  // finalization.
  // Allocatable components of INTENT(OUT) dummies must be deallocated (9.7.3.2
  // p6). Calling finalization runtime for this works even if the components
  // have no final procedures.
  return hasFinalization(sym) || hasAllocatableDirectComponent(sym);
}

/// Call default initialization runtime routine to initialize \p var.
static void finalizeAtRuntime(Fortran::lower::AbstractConverter &converter,
                              const Fortran::lower::pft::Variable &var,
                              Fortran::lower::SymMap &symMap) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Location loc = converter.getCurrentLocation();
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  fir::ExtendedValue exv = converter.getSymbolExtendedValue(sym, &symMap);
  if (Fortran::semantics::IsOptional(sym)) {
    // Only finalize if present.
    auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
                                                      fir::getBase(exv));
    builder.genIfThen(loc, isPresent)
        .genThen([&]() {
          auto box = builder.createBox(loc, exv);
          fir::runtime::genDerivedTypeDestroy(builder, loc, box);
        })
        .end();
  } else {
    mlir::Value box = builder.createBox(loc, exv);
    fir::runtime::genDerivedTypeDestroy(builder, loc, box);
  }
}

// Fortran 2018 - 9.7.3.2 point 6
// When a procedure is invoked, any allocated allocatable object that is an
// actual argument corresponding to an INTENT(OUT) allocatable dummy argument
// is deallocated; any allocated allocatable object that is a subobject of an
// actual argument corresponding to an INTENT(OUT) dummy argument is
// deallocated.
// Note that allocatable components of non-ALLOCATABLE INTENT(OUT) dummy
// arguments are dealt with needDummyIntentoutFinalization (finalization runtime
// is called to reach the intended component deallocation effect).
static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
                                const Fortran::lower::pft::Variable &var,
                                Fortran::lower::SymMap &symMap) {
  if (!var.hasSymbol())
    return;

  const Fortran::semantics::Symbol &sym = var.getSymbol();
  if (Fortran::semantics::IsDummy(sym) &&
      Fortran::semantics::IsIntentOut(sym) &&
      Fortran::semantics::IsAllocatable(sym)) {
    fir::ExtendedValue extVal = converter.getSymbolExtendedValue(sym, &symMap);
    if (auto mutBox = extVal.getBoxOf<fir::MutableBoxValue>()) {
      // The dummy argument is not passed in the ENTRY so it should not be
      // deallocated.
      if (mlir::Operation *op = mutBox->getAddr().getDefiningOp()) {
        if (auto declOp = mlir::dyn_cast<hlfir::DeclareOp>(op))
          op = declOp.getMemref().getDefiningOp();
        if (op && mlir::isa<fir::AllocaOp>(op))
          return;
      }
      mlir::Location loc = converter.getCurrentLocation();
      fir::FirOpBuilder &builder = converter.getFirOpBuilder();

      if (Fortran::semantics::IsOptional(sym)) {
        auto isPresent = builder.create<fir::IsPresentOp>(
            loc, builder.getI1Type(), fir::getBase(extVal));
        builder.genIfThen(loc, isPresent)
            .genThen([&]() {
              Fortran::lower::genDeallocateIfAllocated(converter, *mutBox, loc);
            })
            .end();
      } else {
        Fortran::lower::genDeallocateIfAllocated(converter, *mutBox, loc);
      }
    }
  }
}

/// Instantiate a local variable. Precondition: Each variable will be visited
/// such that if its properties depend on other variables, the variables upon
/// which its properties depend will already have been visited.
static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
                             const Fortran::lower::pft::Variable &var,
                             Fortran::lower::SymMap &symMap) {
  assert(!var.isAlias());
  Fortran::lower::StatementContext stmtCtx;
  mapSymbolAttributes(converter, var, symMap, stmtCtx);
  deallocateIntentOut(converter, var, symMap);
  if (needDummyIntentoutFinalization(var))
    finalizeAtRuntime(converter, var, symMap);
  if (mustBeDefaultInitializedAtRuntime(var))
    Fortran::lower::defaultInitializeAtRuntime(converter, var.getSymbol(),
                                               symMap);
  if (Fortran::semantics::NeedCUDAAlloc(var.getSymbol())) {
    auto *builder = &converter.getFirOpBuilder();
    mlir::Location loc = converter.getCurrentLocation();
    fir::ExtendedValue exv =
        converter.getSymbolExtendedValue(var.getSymbol(), &symMap);
    auto *sym = &var.getSymbol();
    converter.getFctCtx().attachCleanup([builder, loc, exv, sym]() {
      cuf::DataAttributeAttr dataAttr =
          Fortran::lower::translateSymbolCUFDataAttribute(builder->getContext(),
                                                          *sym);
      builder->create<cuf::FreeOp>(loc, fir::getBase(exv), dataAttr);
    });
  }
  if (std::optional<VariableCleanUp> cleanup =
          needDeallocationOrFinalization(var)) {
    auto *builder = &converter.getFirOpBuilder();
    mlir::Location loc = converter.getCurrentLocation();
    fir::ExtendedValue exv =
        converter.getSymbolExtendedValue(var.getSymbol(), &symMap);
    switch (*cleanup) {
    case VariableCleanUp::Finalize:
      converter.getFctCtx().attachCleanup([builder, loc, exv]() {
        mlir::Value box = builder->createBox(loc, exv);
        fir::runtime::genDerivedTypeDestroy(*builder, loc, box);
      });
      break;
    case VariableCleanUp::Deallocate:
      auto *converterPtr = &converter;
      auto *sym = &var.getSymbol();
      converter.getFctCtx().attachCleanup([converterPtr, loc, exv, sym]() {
        const fir::MutableBoxValue *mutableBox =
            exv.getBoxOf<fir::MutableBoxValue>();
        assert(mutableBox &&
               "trying to deallocate entity not lowered as allocatable");
        Fortran::lower::genDeallocateIfAllocated(*converterPtr, *mutableBox,
                                                 loc, sym);

      });
    }
  }
}

//===----------------------------------------------------------------===//
// Aliased (EQUIVALENCE) variables instantiation
//===----------------------------------------------------------------===//

/// Insert \p aggregateStore instance into an AggregateStoreMap.
static void insertAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
                                 const Fortran::lower::pft::Variable &var,
                                 mlir::Value aggregateStore) {
  std::size_t off = var.getAggregateStore().getOffset();
  Fortran::lower::AggregateStoreKey key = {var.getOwningScope(), off};
  storeMap[key] = aggregateStore;
}

/// Retrieve the aggregate store instance of \p alias from an
/// AggregateStoreMap.
static mlir::Value
getAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
                  const Fortran::lower::pft::Variable &alias) {
  Fortran::lower::AggregateStoreKey key = {alias.getOwningScope(),
                                           alias.getAliasOffset()};
  auto iter = storeMap.find(key);
  assert(iter != storeMap.end());
  return iter->second;
}

/// Build the name for the storage of a global equivalence.
static std::string mangleGlobalAggregateStore(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::lower::pft::Variable::AggregateStore &st) {
  return converter.mangleName(st.getNamingSymbol());
}

/// Build the type for the storage of an equivalence.
static mlir::Type
getAggregateType(Fortran::lower::AbstractConverter &converter,
                 const Fortran::lower::pft::Variable::AggregateStore &st) {
  if (const Fortran::semantics::Symbol *initSym = st.getInitialValueSymbol())
    return converter.genType(*initSym);
  mlir::IntegerType byteTy = converter.getFirOpBuilder().getIntegerType(8);
  return fir::SequenceType::get(std::get<1>(st.interval), byteTy);
}

/// Define a GlobalOp for the storage of a global equivalence described
/// by \p aggregate. The global is named \p aggName and is created with
/// the provided \p linkage.
/// If any of the equivalence members are initialized, an initializer is
/// created for the equivalence.
/// This is to be used when lowering the scope that owns the equivalence
/// (as opposed to simply using it through host or use association).
/// This is not to be used for equivalence of common block members (they
/// already have the common block GlobalOp for them, see defineCommonBlock).
static fir::GlobalOp defineGlobalAggregateStore(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::lower::pft::Variable::AggregateStore &aggregate,
    llvm::StringRef aggName, mlir::StringAttr linkage) {
  assert(aggregate.isGlobal() && "not a global interval");
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  fir::GlobalOp global = builder.getNamedGlobal(aggName);
  if (global && globalIsInitialized(global))
    return global;
  mlir::Location loc = converter.getCurrentLocation();
  mlir::Type aggTy = getAggregateType(converter, aggregate);
  if (!global)
    global = builder.createGlobal(loc, aggTy, aggName, linkage);

  if (const Fortran::semantics::Symbol *initSym =
          aggregate.getInitialValueSymbol())
    if (const auto *objectDetails =
            initSym->detailsIf<Fortran::semantics::ObjectEntityDetails>())
      if (objectDetails->init()) {
        Fortran::lower::createGlobalInitialization(
            builder, global, [&](fir::FirOpBuilder &builder) {
              Fortran::lower::StatementContext stmtCtx;
              mlir::Value initVal = fir::getBase(genInitializerExprValue(
                  converter, loc, objectDetails->init().value(), stmtCtx));
              builder.create<fir::HasValueOp>(loc, initVal);
            });
        return global;
      }
  // Equivalence has no Fortran initial value. Create an undefined FIR initial
  // value to ensure this is consider an object definition in the IR regardless
  // of the linkage.
  Fortran::lower::createGlobalInitialization(
      builder, global, [&](fir::FirOpBuilder &builder) {
        Fortran::lower::StatementContext stmtCtx;
        mlir::Value initVal = builder.create<fir::ZeroOp>(loc, aggTy);
        builder.create<fir::HasValueOp>(loc, initVal);
      });
  return global;
}

/// Declare a GlobalOp for the storage of a global equivalence described
/// by \p aggregate. The global is named \p aggName and is created with
/// the provided \p linkage.
/// No initializer is built for the created GlobalOp.
/// This is to be used when lowering the scope that uses members of an
/// equivalence it through host or use association.
/// This is not to be used for equivalence of common block members (they
/// already have the common block GlobalOp for them, see defineCommonBlock).
static fir::GlobalOp declareGlobalAggregateStore(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    const Fortran::lower::pft::Variable::AggregateStore &aggregate,
    llvm::StringRef aggName, mlir::StringAttr linkage) {
  assert(aggregate.isGlobal() && "not a global interval");
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  if (fir::GlobalOp global = builder.getNamedGlobal(aggName))
    return global;
  mlir::Type aggTy = getAggregateType(converter, aggregate);
  return builder.createGlobal(loc, aggTy, aggName, linkage);
}

/// This is an aggregate store for a set of EQUIVALENCED variables. Create the
/// storage on the stack or global memory and add it to the map.
static void
instantiateAggregateStore(Fortran::lower::AbstractConverter &converter,
                          const Fortran::lower::pft::Variable &var,
                          Fortran::lower::AggregateStoreMap &storeMap) {
  assert(var.isAggregateStore() && "not an interval");
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::IntegerType i8Ty = builder.getIntegerType(8);
  mlir::Location loc = converter.getCurrentLocation();
  std::string aggName =
      mangleGlobalAggregateStore(converter, var.getAggregateStore());
  if (var.isGlobal()) {
    fir::GlobalOp global;
    auto &aggregate = var.getAggregateStore();
    mlir::StringAttr linkage = getLinkageAttribute(builder, var);
    if (var.isModuleOrSubmoduleVariable()) {
      // A module global was or will be defined when lowering the module. Emit
      // only a declaration if the global does not exist at that point.
      global = declareGlobalAggregateStore(converter, loc, aggregate, aggName,
                                           linkage);
    } else {
      global =
          defineGlobalAggregateStore(converter, aggregate, aggName, linkage);
    }
    auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
                                              global.getSymbol());
    auto size = std::get<1>(var.getInterval());
    fir::SequenceType::Shape shape(1, size);
    auto seqTy = fir::SequenceType::get(shape, i8Ty);
    mlir::Type refTy = builder.getRefType(seqTy);
    mlir::Value aggregateStore = builder.createConvert(loc, refTy, addr);
    insertAggregateStore(storeMap, var, aggregateStore);
    return;
  }
  // This is a local aggregate, allocate an anonymous block of memory.
  auto size = std::get<1>(var.getInterval());
  fir::SequenceType::Shape shape(1, size);
  auto seqTy = fir::SequenceType::get(shape, i8Ty);
  mlir::Value local =
      builder.allocateLocal(loc, seqTy, aggName, "", std::nullopt, std::nullopt,
                            /*target=*/false);
  insertAggregateStore(storeMap, var, local);
}

/// Cast an alias address (variable part of an equivalence) to fir.ptr so that
/// the optimizer is conservative and avoids doing copy elision in assignment
/// involving equivalenced variables.
/// TODO: Represent the equivalence aliasing constraint in another way to avoid
/// pessimizing array assignments involving equivalenced variables.
static mlir::Value castAliasToPointer(fir::FirOpBuilder &builder,
                                      mlir::Location loc, mlir::Type aliasType,
                                      mlir::Value aliasAddr) {
  return builder.createConvert(loc, fir::PointerType::get(aliasType),
                               aliasAddr);
}

/// Instantiate a member of an equivalence. Compute its address in its
/// aggregate storage and lower its attributes.
static void instantiateAlias(Fortran::lower::AbstractConverter &converter,
                             const Fortran::lower::pft::Variable &var,
                             Fortran::lower::SymMap &symMap,
                             Fortran::lower::AggregateStoreMap &storeMap) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  assert(var.isAlias());
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  const mlir::Location loc = genLocation(converter, sym);
  mlir::IndexType idxTy = builder.getIndexType();
  mlir::IntegerType i8Ty = builder.getIntegerType(8);
  mlir::Type i8Ptr = builder.getRefType(i8Ty);
  mlir::Type symType = converter.genType(sym);
  std::size_t off = sym.GetUltimate().offset() - var.getAliasOffset();
  mlir::Value storeAddr = getAggregateStore(storeMap, var);
  mlir::Value offset = builder.createIntegerConstant(loc, idxTy, off);
  mlir::Value bytePtr = builder.create<fir::CoordinateOp>(
      loc, i8Ptr, storeAddr, mlir::ValueRange{offset});
  mlir::Value typedPtr = castAliasToPointer(builder, loc, symType, bytePtr);
  Fortran::lower::StatementContext stmtCtx;
  mapSymbolAttributes(converter, var, symMap, stmtCtx, typedPtr);
  // Default initialization is possible for equivalence members: see
  // F2018 19.5.3.4. Note that if several equivalenced entities have
  // default initialization, they must have the same type, and the standard
  // allows the storage to be default initialized several times (this has
  // no consequences other than wasting some execution time). For now,
  // do not try optimizing this to single default initializations of
  // the equivalenced storages. Keep lowering simple.
  if (mustBeDefaultInitializedAtRuntime(var))
    Fortran::lower::defaultInitializeAtRuntime(converter, var.getSymbol(),
                                               symMap);
}

//===--------------------------------------------------------------===//
// COMMON blocks instantiation
//===--------------------------------------------------------------===//

/// Does any member of the common block has an initializer ?
static bool
commonBlockHasInit(const Fortran::semantics::MutableSymbolVector &cmnBlkMems) {
  for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
    if (const auto *memDet =
            mem->detailsIf<Fortran::semantics::ObjectEntityDetails>())
      if (memDet->init())
        return true;
  }
  return false;
}

/// Build a tuple type for a common block based on the common block
/// members and the common block size.
/// This type is only needed to build common block initializers where
/// the initial value is the collection of the member initial values.
static mlir::TupleType getTypeOfCommonWithInit(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::semantics::MutableSymbolVector &cmnBlkMems,
    std::size_t commonSize) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  llvm::SmallVector<mlir::Type> members;
  std::size_t counter = 0;
  for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
    if (const auto *memDet =
            mem->detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
      if (mem->offset() > counter) {
        fir::SequenceType::Shape len = {
            static_cast<fir::SequenceType::Extent>(mem->offset() - counter)};
        mlir::IntegerType byteTy = builder.getIntegerType(8);
        auto memTy = fir::SequenceType::get(len, byteTy);
        members.push_back(memTy);
        counter = mem->offset();
      }
      if (memDet->init()) {
        mlir::Type memTy = converter.genType(*mem);
        members.push_back(memTy);
        counter = mem->offset() + mem->size();
      }
    }
  }
  if (counter < commonSize) {
    fir::SequenceType::Shape len = {
        static_cast<fir::SequenceType::Extent>(commonSize - counter)};
    mlir::IntegerType byteTy = builder.getIntegerType(8);
    auto memTy = fir::SequenceType::get(len, byteTy);
    members.push_back(memTy);
  }
  return mlir::TupleType::get(builder.getContext(), members);
}

/// Common block members may have aliases. They are not in the common block
/// member list from the symbol. We need to know about these aliases if they
/// have initializer to generate the common initializer.
/// This function takes care of adding aliases with initializer to the member
/// list.
static Fortran::semantics::MutableSymbolVector
getCommonMembersWithInitAliases(const Fortran::semantics::Symbol &common) {
  const auto &commonDetails =
      common.get<Fortran::semantics::CommonBlockDetails>();
  auto members = commonDetails.objects();

  // The number and size of equivalence and common is expected to be small, so
  // no effort is given to optimize this loop of complexity equivalenced
  // common members * common members
  for (const Fortran::semantics::EquivalenceSet &set :
       common.owner().equivalenceSets())
    for (const Fortran::semantics::EquivalenceObject &obj : set) {
      if (!obj.symbol.test(Fortran::semantics::Symbol::Flag::CompilerCreated)) {
        if (const auto &details =
                obj.symbol
                    .detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
          const Fortran::semantics::Symbol *com =
              FindCommonBlockContaining(obj.symbol);
          if (!details->init() || com != &common)
            continue;
          // This is an alias with an init that belongs to the list
          if (!llvm::is_contained(members, obj.symbol))
            members.emplace_back(obj.symbol);
        }
      }
    }
  return members;
}

/// Return the fir::GlobalOp that was created of COMMON block \p common.
/// It is an error if the fir::GlobalOp was not created before this is
/// called (it cannot be created on the flight because it is not known here
/// what mlir type the GlobalOp should have to satisfy all the
/// appearances in the program).
static fir::GlobalOp
getCommonBlockGlobal(Fortran::lower::AbstractConverter &converter,
                     const Fortran::semantics::Symbol &common) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  std::string commonName = converter.mangleName(common);
  fir::GlobalOp global = builder.getNamedGlobal(commonName);
  // Common blocks are lowered before any subprograms to deal with common
  // whose size may not be the same in every subprograms.
  if (!global)
    fir::emitFatalError(converter.genLocation(common.name()),
                        "COMMON block was not lowered before its usage");
  return global;
}

/// Create the fir::GlobalOp for COMMON block \p common. If \p common has an
/// initial value, it is not created yet. Instead, the common block list
/// members is returned to later create the initial value in
/// finalizeCommonBlockDefinition.
static std::optional<std::tuple<
    fir::GlobalOp, Fortran::semantics::MutableSymbolVector, mlir::Location>>
declareCommonBlock(Fortran::lower::AbstractConverter &converter,
                   const Fortran::semantics::Symbol &common,
                   std::size_t commonSize) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  std::string commonName = converter.mangleName(common);
  fir::GlobalOp global = builder.getNamedGlobal(commonName);
  if (global)
    return std::nullopt;
  Fortran::semantics::MutableSymbolVector cmnBlkMems =
      getCommonMembersWithInitAliases(common);
  mlir::Location loc = converter.genLocation(common.name());
  mlir::StringAttr linkage = builder.createCommonLinkage();
  const auto *details =
      common.detailsIf<Fortran::semantics::CommonBlockDetails>();
  assert(details && "Expect CommonBlockDetails on the common symbol");
  if (!commonBlockHasInit(cmnBlkMems)) {
    // A COMMON block sans initializers is initialized to zero.
    // mlir::Vector types must have a strictly positive size, so at least
    // temporarily, force a zero size COMMON block to have one byte.
    const auto sz =
        static_cast<fir::SequenceType::Extent>(commonSize > 0 ? commonSize : 1);
    fir::SequenceType::Shape shape = {sz};
    mlir::IntegerType i8Ty = builder.getIntegerType(8);
    auto commonTy = fir::SequenceType::get(shape, i8Ty);
    auto vecTy = mlir::VectorType::get(sz, i8Ty);
    mlir::Attribute zero = builder.getIntegerAttr(i8Ty, 0);
    auto init = mlir::DenseElementsAttr::get(vecTy, llvm::ArrayRef(zero));
    global = builder.createGlobal(loc, commonTy, commonName, linkage, init);
    global.setAlignment(details->alignment());
    // No need to add any initial value later.
    return std::nullopt;
  }
  // COMMON block with initializer (note that initialized blank common are
  // accepted as an extension by semantics). Sort members by offset before
  // generating the type and initializer.
  std::sort(cmnBlkMems.begin(), cmnBlkMems.end(),
            [](auto &s1, auto &s2) { return s1->offset() < s2->offset(); });
  mlir::TupleType commonTy =
      getTypeOfCommonWithInit(converter, cmnBlkMems, commonSize);
  // Create the global object, the initial value will be added later.
  global = builder.createGlobal(loc, commonTy, commonName);
  global.setAlignment(details->alignment());
  return std::make_tuple(global, std::move(cmnBlkMems), loc);
}

/// Add initial value to a COMMON block fir::GlobalOp \p global given the list
/// \p cmnBlkMems of the common block member symbols that contains symbols with
/// an initial value.
static void finalizeCommonBlockDefinition(
    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
    fir::GlobalOp global,
    const Fortran::semantics::MutableSymbolVector &cmnBlkMems) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::TupleType commonTy = mlir::cast<mlir::TupleType>(global.getType());
  auto initFunc = [&](fir::FirOpBuilder &builder) {
    mlir::IndexType idxTy = builder.getIndexType();
    mlir::Value cb = builder.create<fir::ZeroOp>(loc, commonTy);
    unsigned tupIdx = 0;
    std::size_t offset = 0;
    LLVM_DEBUG(llvm::dbgs() << "block {\n");
    for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
      if (const auto *memDet =
              mem->detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
        if (mem->offset() > offset) {
          ++tupIdx;
          offset = mem->offset();
        }
        if (memDet->init()) {
          LLVM_DEBUG(llvm::dbgs()
                     << "offset: " << mem->offset() << " is " << *mem << '\n');
          Fortran::lower::StatementContext stmtCtx;
          auto initExpr = memDet->init().value();
          fir::ExtendedValue initVal =
              Fortran::semantics::IsPointer(*mem)
                  ? Fortran::lower::genInitialDataTarget(
                        converter, loc, converter.genType(*mem), initExpr)
                  : genInitializerExprValue(converter, loc, initExpr, stmtCtx);
          mlir::IntegerAttr offVal = builder.getIntegerAttr(idxTy, tupIdx);
          mlir::Value castVal = builder.createConvert(
              loc, commonTy.getType(tupIdx), fir::getBase(initVal));
          cb = builder.create<fir::InsertValueOp>(loc, commonTy, cb, castVal,
                                                  builder.getArrayAttr(offVal));
          ++tupIdx;
          offset = mem->offset() + mem->size();
        }
      }
    }
    LLVM_DEBUG(llvm::dbgs() << "}\n");
    builder.create<fir::HasValueOp>(loc, cb);
  };
  Fortran::lower::createGlobalInitialization(builder, global, initFunc);
}

void Fortran::lower::defineCommonBlocks(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::semantics::CommonBlockList &commonBlocks) {
  // Common blocks may depend on another common block address (if they contain
  // pointers with initial targets). To cover this case, create all common block
  // fir::Global before creating the initial values (if any).
  std::vector<std::tuple<fir::GlobalOp, Fortran::semantics::MutableSymbolVector,
                         mlir::Location>>
      delayedInitializations;
  for (const auto &[common, size] : commonBlocks)
    if (auto delayedInit = declareCommonBlock(converter, common, size))
      delayedInitializations.emplace_back(std::move(*delayedInit));
  for (auto &[global, cmnBlkMems, loc] : delayedInitializations)
    finalizeCommonBlockDefinition(loc, converter, global, cmnBlkMems);
}

mlir::Value Fortran::lower::genCommonBlockMember(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    const Fortran::semantics::Symbol &sym, mlir::Value commonValue) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();

  std::size_t byteOffset = sym.GetUltimate().offset();
  mlir::IntegerType i8Ty = builder.getIntegerType(8);
  mlir::Type i8Ptr = builder.getRefType(i8Ty);
  mlir::Type seqTy = builder.getRefType(builder.getVarLenSeqTy(i8Ty));
  mlir::Value base = builder.createConvert(loc, seqTy, commonValue);

  mlir::Value offs =
      builder.createIntegerConstant(loc, builder.getIndexType(), byteOffset);
  mlir::Value varAddr = builder.create<fir::CoordinateOp>(
      loc, i8Ptr, base, mlir::ValueRange{offs});
  mlir::Type symType = converter.genType(sym);

  return Fortran::semantics::FindEquivalenceSet(sym) != nullptr
             ? castAliasToPointer(builder, loc, symType, varAddr)
             : builder.createConvert(loc, builder.getRefType(symType), varAddr);
}

/// The COMMON block is a global structure. `var` will be at some offset
/// within the COMMON block. Adds the address of `var` (COMMON + offset) to
/// the symbol map.
static void instantiateCommon(Fortran::lower::AbstractConverter &converter,
                              const Fortran::semantics::Symbol &common,
                              const Fortran::lower::pft::Variable &var,
                              Fortran::lower::SymMap &symMap) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  const Fortran::semantics::Symbol &varSym = var.getSymbol();
  mlir::Location loc = converter.genLocation(varSym.name());

  mlir::Value commonAddr;
  if (Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(common))
    commonAddr = symBox.getAddr();
  if (!commonAddr) {
    // introduce a local AddrOf and add it to the map
    fir::GlobalOp global = getCommonBlockGlobal(converter, common);
    commonAddr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
                                               global.getSymbol());

    symMap.addSymbol(common, commonAddr);
  }

  mlir::Value local = genCommonBlockMember(converter, loc, varSym, commonAddr);
  Fortran::lower::StatementContext stmtCtx;
  mapSymbolAttributes(converter, var, symMap, stmtCtx, local);
}

//===--------------------------------------------------------------===//
// Lower Variables specification expressions and attributes
//===--------------------------------------------------------------===//

/// Helper to decide if a dummy argument must be tracked in an BoxValue.
static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym,
                            mlir::Value dummyArg,
                            Fortran::lower::AbstractConverter &converter) {
  // Only dummy arguments coming as fir.box can be tracked in an BoxValue.
  if (!dummyArg || !mlir::isa<fir::BaseBoxType>(dummyArg.getType()))
    return false;
  // Non contiguous arrays must be tracked in an BoxValue.
  if (sym.Rank() > 0 && !Fortran::evaluate::IsSimplyContiguous(
                            sym, converter.getFoldingContext()))
    return true;
  // Assumed rank and optional fir.box cannot yet be read while lowering the
  // specifications.
  if (Fortran::evaluate::IsAssumedRank(sym) ||
      Fortran::semantics::IsOptional(sym))
    return true;
  // Polymorphic entity should be tracked through a fir.box that has the
  // dynamic type info.
  if (const Fortran::semantics::DeclTypeSpec *type = sym.GetType())
    if (type->IsPolymorphic())
      return true;
  return false;
}

/// Compute extent from lower and upper bound.
static mlir::Value computeExtent(fir::FirOpBuilder &builder, mlir::Location loc,
                                 mlir::Value lb, mlir::Value ub) {
  mlir::IndexType idxTy = builder.getIndexType();
  // Let the folder deal with the common `ub - <const> + 1` case.
  auto diff = builder.create<mlir::arith::SubIOp>(loc, idxTy, ub, lb);
  mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
  auto rawExtent = builder.create<mlir::arith::AddIOp>(loc, idxTy, diff, one);
  return fir::factory::genMaxWithZero(builder, loc, rawExtent);
}

/// Lower explicit lower bounds into \p result. Does nothing if this is not an
/// array, or if the lower bounds are deferred, or all implicit or one.
static void lowerExplicitLowerBounds(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    const Fortran::lower::BoxAnalyzer &box,
    llvm::SmallVectorImpl<mlir::Value> &result, Fortran::lower::SymMap &symMap,
    Fortran::lower::StatementContext &stmtCtx) {
  if (!box.isArray() || box.lboundIsAllOnes())
    return;
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::IndexType idxTy = builder.getIndexType();
  if (box.isStaticArray()) {
    for (int64_t lb : box.staticLBound())
      result.emplace_back(builder.createIntegerConstant(loc, idxTy, lb));
    return;
  }
  for (const Fortran::semantics::ShapeSpec *spec : box.dynamicBound()) {
    if (auto low = spec->lbound().GetExplicit()) {
      auto expr = Fortran::lower::SomeExpr{*low};
      mlir::Value lb = builder.createConvert(
          loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
      result.emplace_back(lb);
    }
  }
  assert(result.empty() || result.size() == box.dynamicBound().size());
}

/// Return -1 for the last dimension extent/upper bound of assumed-size arrays.
/// This value is required to fulfill the requirements for assumed-rank
/// associated with assumed-size (see for instance UBOUND in 16.9.196, and
/// CFI_desc_t requirements in 18.5.3 point 5.).
static mlir::Value getAssumedSizeExtent(mlir::Location loc,
                                        fir::FirOpBuilder &builder) {
  return builder.createMinusOneInteger(loc, builder.getIndexType());
}

/// Lower explicit extents into \p result if this is an explicit-shape or
/// assumed-size array. Does nothing if this is not an explicit-shape or
/// assumed-size array.
static void
lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
                     mlir::Location loc, const Fortran::lower::BoxAnalyzer &box,
                     llvm::SmallVectorImpl<mlir::Value> &lowerBounds,
                     llvm::SmallVectorImpl<mlir::Value> &result,
                     Fortran::lower::SymMap &symMap,
                     Fortran::lower::StatementContext &stmtCtx) {
  if (!box.isArray())
    return;
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::IndexType idxTy = builder.getIndexType();
  if (box.isStaticArray()) {
    for (int64_t extent : box.staticShape())
      result.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));
    return;
  }
  for (const auto &spec : llvm::enumerate(box.dynamicBound())) {
    if (auto up = spec.value()->ubound().GetExplicit()) {
      auto expr = Fortran::lower::SomeExpr{*up};
      mlir::Value ub = builder.createConvert(
          loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
      if (lowerBounds.empty())
        result.emplace_back(fir::factory::genMaxWithZero(builder, loc, ub));
      else
        result.emplace_back(
            computeExtent(builder, loc, lowerBounds[spec.index()], ub));
    } else if (spec.value()->ubound().isStar()) {
      result.emplace_back(getAssumedSizeExtent(loc, builder));
    }
  }
  assert(result.empty() || result.size() == box.dynamicBound().size());
}

/// Lower explicit character length if any. Return empty mlir::Value if no
/// explicit length.
static mlir::Value
lowerExplicitCharLen(Fortran::lower::AbstractConverter &converter,
                     mlir::Location loc, const Fortran::lower::BoxAnalyzer &box,
                     Fortran::lower::SymMap &symMap,
                     Fortran::lower::StatementContext &stmtCtx) {
  if (!box.isChar())
    return mlir::Value{};
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Type lenTy = builder.getCharacterLengthType();
  if (std::optional<int64_t> len = box.getCharLenConst())
    return builder.createIntegerConstant(loc, lenTy, *len);
  if (std::optional<Fortran::lower::SomeExpr> lenExpr = box.getCharLenExpr())
    // If the length expression is negative, the length is zero. See F2018
    // 7.4.4.2 point 5.
    return fir::factory::genMaxWithZero(
        builder, loc,
        genScalarValue(converter, loc, *lenExpr, symMap, stmtCtx));
  return mlir::Value{};
}

/// Assumed size arrays last extent is -1 in the front end.
static mlir::Value genExtentValue(fir::FirOpBuilder &builder,
                                  mlir::Location loc, mlir::Type idxTy,
                                  long frontEndExtent) {
  if (frontEndExtent >= 0)
    return builder.createIntegerConstant(loc, idxTy, frontEndExtent);
  return getAssumedSizeExtent(loc, builder);
}

/// If a symbol is an array, it may have been declared with unknown extent
/// parameters (e.g., `*`), but if it has an initial value then the actual size
/// may be available from the initial array value's type.
inline static llvm::SmallVector<std::int64_t>
recoverShapeVector(llvm::ArrayRef<std::int64_t> shapeVec, mlir::Value initVal) {
  llvm::SmallVector<std::int64_t> result;
  if (initVal) {
    if (auto seqTy = fir::unwrapUntilSeqType(initVal.getType())) {
      for (auto [fst, snd] : llvm::zip(shapeVec, seqTy.getShape()))
        result.push_back(fst == fir::SequenceType::getUnknownExtent() ? snd
                                                                      : fst);
      return result;
    }
  }
  result.assign(shapeVec.begin(), shapeVec.end());
  return result;
}

fir::FortranVariableFlagsAttr Fortran::lower::translateSymbolAttributes(
    mlir::MLIRContext *mlirContext, const Fortran::semantics::Symbol &sym,
    fir::FortranVariableFlagsEnum extraFlags) {
  fir::FortranVariableFlagsEnum flags = extraFlags;
  if (sym.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
    // CrayPointee are represented as pointers.
    flags = flags | fir::FortranVariableFlagsEnum::pointer;
    return fir::FortranVariableFlagsAttr::get(mlirContext, flags);
  }
  const auto &attrs = sym.attrs();
  if (attrs.test(Fortran::semantics::Attr::ALLOCATABLE))
    flags = flags | fir::FortranVariableFlagsEnum::allocatable;
  if (attrs.test(Fortran::semantics::Attr::ASYNCHRONOUS))
    flags = flags | fir::FortranVariableFlagsEnum::asynchronous;
  if (attrs.test(Fortran::semantics::Attr::BIND_C))
    flags = flags | fir::FortranVariableFlagsEnum::bind_c;
  if (attrs.test(Fortran::semantics::Attr::CONTIGUOUS))
    flags = flags | fir::FortranVariableFlagsEnum::contiguous;
  if (attrs.test(Fortran::semantics::Attr::INTENT_IN))
    flags = flags | fir::FortranVariableFlagsEnum::intent_in;
  if (attrs.test(Fortran::semantics::Attr::INTENT_INOUT))
    flags = flags | fir::FortranVariableFlagsEnum::intent_inout;
  if (attrs.test(Fortran::semantics::Attr::INTENT_OUT))
    flags = flags | fir::FortranVariableFlagsEnum::intent_out;
  if (attrs.test(Fortran::semantics::Attr::OPTIONAL))
    flags = flags | fir::FortranVariableFlagsEnum::optional;
  if (attrs.test(Fortran::semantics::Attr::PARAMETER))
    flags = flags | fir::FortranVariableFlagsEnum::parameter;
  if (attrs.test(Fortran::semantics::Attr::POINTER))
    flags = flags | fir::FortranVariableFlagsEnum::pointer;
  if (attrs.test(Fortran::semantics::Attr::TARGET))
    flags = flags | fir::FortranVariableFlagsEnum::target;
  if (attrs.test(Fortran::semantics::Attr::VALUE))
    flags = flags | fir::FortranVariableFlagsEnum::value;
  if (attrs.test(Fortran::semantics::Attr::VOLATILE))
    flags = flags | fir::FortranVariableFlagsEnum::fortran_volatile;
  if (flags == fir::FortranVariableFlagsEnum::None)
    return {};
  return fir::FortranVariableFlagsAttr::get(mlirContext, flags);
}

cuf::DataAttributeAttr Fortran::lower::translateSymbolCUFDataAttribute(
    mlir::MLIRContext *mlirContext, const Fortran::semantics::Symbol &sym) {
  std::optional<Fortran::common::CUDADataAttr> cudaAttr =
      Fortran::semantics::GetCUDADataAttr(&sym.GetUltimate());
  return cuf::getDataAttribute(mlirContext, cudaAttr);
}

static bool
isCapturedInInternalProcedure(Fortran::lower::AbstractConverter &converter,
                              const Fortran::semantics::Symbol &sym) {
  const Fortran::lower::pft::FunctionLikeUnit *funit =
      converter.getCurrentFunctionUnit();
  if (!funit || funit->getHostAssoc().empty())
    return false;
  if (funit->getHostAssoc().isAssociated(sym))
    return true;
  // Consider that any capture of a variable that is in an equivalence with the
  // symbol imply that the storage of the symbol may also be accessed inside
  // symbol implies that the storage of the symbol may also be accessed inside

  // the internal procedure and flag it as captured.
  if (const auto *equivSet = Fortran::semantics::FindEquivalenceSet(sym))
    for (const Fortran::semantics::EquivalenceObject &eqObj : *equivSet)
      if (funit->getHostAssoc().isAssociated(eqObj.symbol))
        return true;
  return false;
}

/// Map a symbol to its FIR address and evaluated specification expressions.
/// Not for symbols lowered to fir.box.
/// Will optionally create fir.declare.
static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
                             Fortran::lower::SymMap &symMap,
                             const Fortran::semantics::Symbol &sym,
                             mlir::Value base, mlir::Value len = {},
                             llvm::ArrayRef<mlir::Value> shape = std::nullopt,
                             llvm::ArrayRef<mlir::Value> lbounds = std::nullopt,
                             bool force = false) {
  // In HLFIR, procedure dummy symbols are not added with an hlfir.declare
  // because they are "values", and hlfir.declare is intended for variables. It
  // would add too much complexity to hlfir.declare to support this case, and
  // this would bring very little (the only point being debug info, that are not
  // yet emitted) since alias analysis is meaningless for those.
  // Commonblock names are not variables, but in some lowerings (like OpenMP) it
  // is useful to maintain the address of the commonblock in an MLIR value and
  // query it. hlfir.declare need not be created for these.
  if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
      (!Fortran::semantics::IsProcedure(sym) ||
       Fortran::semantics::IsPointer(sym)) &&
      !sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
    fir::FirOpBuilder &builder = converter.getFirOpBuilder();
    const mlir::Location loc = genLocation(converter, sym);
    mlir::Value shapeOrShift;
    if (!shape.empty() && !lbounds.empty())
      shapeOrShift = builder.genShape(loc, lbounds, shape);
    else if (!shape.empty())
      shapeOrShift = builder.genShape(loc, shape);
    else if (!lbounds.empty())
      shapeOrShift = builder.genShift(loc, lbounds);
    llvm::SmallVector<mlir::Value> lenParams;
    if (len)
      lenParams.emplace_back(len);
    auto name = converter.mangleName(sym);
    fir::FortranVariableFlagsEnum extraFlags = {};
    if (isCapturedInInternalProcedure(converter, sym))
      extraFlags = extraFlags | fir::FortranVariableFlagsEnum::internal_assoc;
    fir::FortranVariableFlagsAttr attributes =
        Fortran::lower::translateSymbolAttributes(builder.getContext(), sym,
                                                  extraFlags);
    cuf::DataAttributeAttr dataAttr =
        Fortran::lower::translateSymbolCUFDataAttribute(builder.getContext(),
                                                        sym);

    if (sym.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
      mlir::Type ptrBoxType =
          Fortran::lower::getCrayPointeeBoxType(base.getType());
      mlir::Value boxAlloc = builder.createTemporary(
          loc, ptrBoxType,
          /*name=*/{}, /*shape=*/{}, /*lenParams=*/{}, /*attrs=*/{},
          Fortran::semantics::GetCUDADataAttr(&sym.GetUltimate()));

      // Declare a local pointer variable.
      auto newBase = builder.create<hlfir::DeclareOp>(
          loc, boxAlloc, name, /*shape=*/nullptr, lenParams,
          /*dummy_scope=*/nullptr, attributes);
      mlir::Value nullAddr = builder.createNullConstant(
          loc, llvm::cast<fir::BaseBoxType>(ptrBoxType).getEleTy());

      // If the element type is known-length character, then
      // EmboxOp does not need the length parameters.
      if (auto charType = mlir::dyn_cast<fir::CharacterType>(
              hlfir::getFortranElementType(base.getType())))
        if (!charType.hasDynamicLen())
          lenParams.clear();

      // Inherit the shape (and maybe length parameters) from the pointee
      // declaration.
      mlir::Value initVal =
          builder.create<fir::EmboxOp>(loc, ptrBoxType, nullAddr, shapeOrShift,
                                       /*slice=*/nullptr, lenParams);
      builder.create<fir::StoreOp>(loc, initVal, newBase.getBase());

      // Any reference to the pointee is going to be using the pointer
      // box from now on. The base_addr of the descriptor must be updated
      // to hold the value of the Cray pointer at the point of the pointee
      // access.
      // Note that the same Cray pointer may be associated with
      // multiple pointees and each of them has its own descriptor.
      symMap.addVariableDefinition(sym, newBase, force);
      return;
    }
    mlir::Value dummyScope;
    if (converter.isRegisteredDummySymbol(sym))
      dummyScope = converter.dummyArgsScopeValue();
    auto newBase = builder.create<hlfir::DeclareOp>(
        loc, base, name, shapeOrShift, lenParams, dummyScope, attributes,
        dataAttr);
    symMap.addVariableDefinition(sym, newBase, force);
    return;
  }

  if (len) {
    if (!shape.empty()) {
      if (!lbounds.empty())
        symMap.addCharSymbolWithBounds(sym, base, len, shape, lbounds, force);
      else
        symMap.addCharSymbolWithShape(sym, base, len, shape, force);
    } else {
      symMap.addCharSymbol(sym, base, len, force);
    }
  } else {
    if (!shape.empty()) {
      if (!lbounds.empty())
        symMap.addSymbolWithBounds(sym, base, shape, lbounds, force);
      else
        symMap.addSymbolWithShape(sym, base, shape, force);
    } else {
      symMap.addSymbol(sym, base, force);
    }
  }
}

/// Map a symbol to its FIR address and evaluated specification expressions
/// provided as a fir::ExtendedValue. Will optionally create fir.declare.
void Fortran::lower::genDeclareSymbol(
    Fortran::lower::AbstractConverter &converter,
    Fortran::lower::SymMap &symMap, const Fortran::semantics::Symbol &sym,
    const fir::ExtendedValue &exv, fir::FortranVariableFlagsEnum extraFlags,
    bool force) {
  if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
      (!Fortran::semantics::IsProcedure(sym) ||
       Fortran::semantics::IsPointer(sym)) &&
      !sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
    fir::FirOpBuilder &builder = converter.getFirOpBuilder();
    const mlir::Location loc = genLocation(converter, sym);
    if (isCapturedInInternalProcedure(converter, sym))
      extraFlags = extraFlags | fir::FortranVariableFlagsEnum::internal_assoc;
    // FIXME: Using the ultimate symbol for translating symbol attributes will
    // lead to situations where the VOLATILE/ASYNCHRONOUS attributes are not
    // propagated to the hlfir.declare (these attributes can be added when
    // using module variables).
    fir::FortranVariableFlagsAttr attributes =
        Fortran::lower::translateSymbolAttributes(
            builder.getContext(), sym.GetUltimate(), extraFlags);
    cuf::DataAttributeAttr dataAttr =
        Fortran::lower::translateSymbolCUFDataAttribute(builder.getContext(),
                                                        sym.GetUltimate());
    auto name = converter.mangleName(sym);
    mlir::Value dummyScope;
    if (converter.isRegisteredDummySymbol(sym))
      dummyScope = converter.dummyArgsScopeValue();
    hlfir::EntityWithAttributes declare = hlfir::genDeclare(
        loc, builder, exv, name, attributes, dummyScope, dataAttr);
    symMap.addVariableDefinition(sym, declare.getIfVariableInterface(), force);
    return;
  }
  symMap.addSymbol(sym, exv, force);
}

/// Map an allocatable or pointer symbol to its FIR address and evaluated
/// specification expressions. Will optionally create fir.declare.
static void
genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter,
                               Fortran::lower::SymMap &symMap,
                               const Fortran::semantics::Symbol &sym,
                               fir::MutableBoxValue box, bool force = false) {
  if (!converter.getLoweringOptions().getLowerToHighLevelFIR()) {
    symMap.addAllocatableOrPointer(sym, box, force);
    return;
  }
  assert(!box.isDescribedByVariables() &&
         "HLFIR alloctables/pointers must be fir.ref<fir.box>");
  mlir::Value base = box.getAddr();
  mlir::Value explictLength;
  if (box.hasNonDeferredLenParams()) {
    if (!box.isCharacter())
      TODO(genLocation(converter, sym),
           "Pointer or Allocatable parametrized derived type");
    explictLength = box.nonDeferredLenParams()[0];
  }
  genDeclareSymbol(converter, symMap, sym, base, explictLength,
                   /*shape=*/std::nullopt,
                   /*lbounds=*/std::nullopt, force);
}

/// Map a procedure pointer
static void genProcPointer(Fortran::lower::AbstractConverter &converter,
                           Fortran::lower::SymMap &symMap,
                           const Fortran::semantics::Symbol &sym,
                           mlir::Value addr, bool force = false) {
  genDeclareSymbol(converter, symMap, sym, addr, mlir::Value{},
                   /*shape=*/std::nullopt,
                   /*lbounds=*/std::nullopt, force);
}

/// Map a symbol represented with a runtime descriptor to its FIR fir.box and
/// evaluated specification expressions. Will optionally create fir.declare.
static void genBoxDeclare(Fortran::lower::AbstractConverter &converter,
                          Fortran::lower::SymMap &symMap,
                          const Fortran::semantics::Symbol &sym,
                          mlir::Value box, llvm::ArrayRef<mlir::Value> lbounds,
                          llvm::ArrayRef<mlir::Value> explicitParams,
                          llvm::ArrayRef<mlir::Value> explicitExtents,
                          bool replace = false) {
  if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
    fir::BoxValue boxValue{box, lbounds, explicitParams, explicitExtents};
    Fortran::lower::genDeclareSymbol(
        converter, symMap, sym, std::move(boxValue),
        fir::FortranVariableFlagsEnum::None, replace);
    return;
  }
  symMap.addBoxSymbol(sym, box, lbounds, explicitParams, explicitExtents,
                      replace);
}

static unsigned getAllocatorIdx(const Fortran::semantics::Symbol &sym) {
  std::optional<Fortran::common::CUDADataAttr> cudaAttr =
      Fortran::semantics::GetCUDADataAttr(&sym.GetUltimate());
  if (cudaAttr) {
    if (*cudaAttr == Fortran::common::CUDADataAttr::Pinned)
      return kPinnedAllocatorPos;
    if (*cudaAttr == Fortran::common::CUDADataAttr::Device)
      return kDeviceAllocatorPos;
    if (*cudaAttr == Fortran::common::CUDADataAttr::Managed)
      return kManagedAllocatorPos;
    if (*cudaAttr == Fortran::common::CUDADataAttr::Unified)
      return kUnifiedAllocatorPos;
  }
  return kDefaultAllocator;
}

/// Lower specification expressions and attributes of variable \p var and
/// add it to the symbol map. For a global or an alias, the address must be
/// pre-computed and provided in \p preAlloc. A dummy argument for the current
/// entry point has already been mapped to an mlir block argument in
/// mapDummiesAndResults. Its mapping may be updated here.
void Fortran::lower::mapSymbolAttributes(
    AbstractConverter &converter, const Fortran::lower::pft::Variable &var,
    Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
    mlir::Value preAlloc) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  const mlir::Location loc = genLocation(converter, sym);
  mlir::IndexType idxTy = builder.getIndexType();
  const bool isDeclaredDummy = Fortran::semantics::IsDummy(sym);
  // An active dummy from the current entry point.
  const bool isDummy = isDeclaredDummy && symMap.lookupSymbol(sym).getAddr();
  // An unused dummy from another entry point.
  const bool isUnusedEntryDummy = isDeclaredDummy && !isDummy;
  const bool isResult = Fortran::semantics::IsFunctionResult(sym);
  const bool replace = isDummy || isResult;
  fir::factory::CharacterExprHelper charHelp{builder, loc};

  if (Fortran::semantics::IsProcedure(sym)) {
    if (isUnusedEntryDummy) {
      // Additional discussion below.
      mlir::Type dummyProcType =
          Fortran::lower::getDummyProcedureType(sym, converter);
      mlir::Value undefOp = builder.create<fir::UndefOp>(loc, dummyProcType);

      Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp);
    }

    // Procedure pointer.
    if (Fortran::semantics::IsPointer(sym)) {
      // global
      mlir::Value boxAlloc = preAlloc;
      // dummy or passed result
      if (!boxAlloc)
        if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym))
          boxAlloc = symbox.getAddr();
      // local
      if (!boxAlloc)
        boxAlloc = createNewLocal(converter, loc, var, preAlloc);
      genProcPointer(converter, symMap, sym, boxAlloc, replace);
    }
    return;
  }

  const bool isAssumedRank = Fortran::evaluate::IsAssumedRank(sym);
  if (isAssumedRank && !allowAssumedRank)
    TODO(loc, "assumed-rank variable in procedure implemented in Fortran");

  Fortran::lower::BoxAnalyzer ba;
  ba.analyze(sym);

  // First deal with pointers and allocatables, because their handling here
  // is the same regardless of their rank.
  if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
    // Get address of fir.box describing the entity.
    // global
    mlir::Value boxAlloc = preAlloc;
    // dummy or passed result
    if (!boxAlloc)
      if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym))
        boxAlloc = symbox.getAddr();
    assert((boxAlloc || !isAssumedRank) && "assumed-ranks cannot be local");
    // local
    if (!boxAlloc)
      boxAlloc = createNewLocal(converter, loc, var, preAlloc);
    // Lower non deferred parameters.
    llvm::SmallVector<mlir::Value> nonDeferredLenParams;
    if (ba.isChar()) {
      if (mlir::Value len =
              lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
        nonDeferredLenParams.push_back(len);
      else if (Fortran::semantics::IsAssumedLengthCharacter(sym))
        nonDeferredLenParams.push_back(
            Fortran::lower::getAssumedCharAllocatableOrPointerLen(
                builder, loc, sym, boxAlloc));
    } else if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) {
      if (const Fortran::semantics::DerivedTypeSpec *derived =
              declTy->AsDerived())
        if (Fortran::semantics::CountLenParameters(*derived) != 0)
          TODO(loc,
               "derived type allocatable or pointer with length parameters");
    }
    fir::MutableBoxValue box = Fortran::lower::createMutableBox(
        converter, loc, var, boxAlloc, nonDeferredLenParams,
        /*alwaysUseBox=*/
        converter.getLoweringOptions().getLowerToHighLevelFIR(),
        getAllocatorIdx(var.getSymbol()));
    genAllocatableOrPointerDeclare(converter, symMap, var.getSymbol(), box,
                                   replace);
    return;
  }

  if (isDummy) {
    mlir::Value dummyArg = symMap.lookupSymbol(sym).getAddr();
    if (lowerToBoxValue(sym, dummyArg, converter)) {
      llvm::SmallVector<mlir::Value> lbounds;
      llvm::SmallVector<mlir::Value> explicitExtents;
      llvm::SmallVector<mlir::Value> explicitParams;
      // Lower lower bounds, explicit type parameters and explicit
      // extents if any.
      if (ba.isChar()) {
        if (mlir::Value len =
                lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
          explicitParams.push_back(len);
        if (!isAssumedRank && sym.Rank() == 0) {
          // Do not keep scalar characters as fir.box (even when optional).
          // Lowering and FIR is not meant to deal with scalar characters as
          // fir.box outside of calls.
          auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(dummyArg.getType());
          mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
          mlir::Type lenType = builder.getCharacterLengthType();
          mlir::Value addr, len;
          if (Fortran::semantics::IsOptional(sym)) {
            auto isPresent = builder.create<fir::IsPresentOp>(
                loc, builder.getI1Type(), dummyArg);
            auto addrAndLen =
                builder
                    .genIfOp(loc, {refTy, lenType}, isPresent,
                             /*withElseRegion=*/true)
                    .genThen([&]() {
                      mlir::Value readAddr =
                          builder.create<fir::BoxAddrOp>(loc, refTy, dummyArg);
                      mlir::Value readLength =
                          charHelp.readLengthFromBox(dummyArg);
                      builder.create<fir::ResultOp>(
                          loc, mlir::ValueRange{readAddr, readLength});
                    })
                    .genElse([&] {
                      mlir::Value readAddr = builder.genAbsentOp(loc, refTy);
                      mlir::Value readLength =
                          fir::factory::createZeroValue(builder, loc, lenType);
                      builder.create<fir::ResultOp>(
                          loc, mlir::ValueRange{readAddr, readLength});
                    })
                    .getResults();
            addr = addrAndLen[0];
            len = addrAndLen[1];
          } else {
            addr = builder.create<fir::BoxAddrOp>(loc, refTy, dummyArg);
            len = charHelp.readLengthFromBox(dummyArg);
          }
          if (!explicitParams.empty())
            len = explicitParams[0];
          ::genDeclareSymbol(converter, symMap, sym, addr, len, /*extents=*/{},
                             /*lbounds=*/{}, replace);
          return;
        }
      }
      // TODO: derived type length parameters.
      if (!isAssumedRank) {
        lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
        lowerExplicitExtents(converter, loc, ba, lbounds, explicitExtents,
                             symMap, stmtCtx);
      }
      genBoxDeclare(converter, symMap, sym, dummyArg, lbounds, explicitParams,
                    explicitExtents, replace);
      return;
    }
  }

  // A dummy from another entry point that is not declared in the current
  // entry point requires a skeleton definition. Most such "unused" dummies
  // will not survive into final generated code, but some will. It is illegal
  // to reference one at run time if it does. Such a dummy is mapped to a
  // value in one of three ways:
  //
  //  - Generate a fir::UndefOp value. This is lightweight, easy to clean up,
  //    and often valid, but it may fail for a dummy with dynamic bounds,
  //    or a dummy used to define another dummy. Information to distinguish
  //    valid cases is not generally available here, with the exception of
  //    dummy procedures. See the first function exit above.
  //
  //  - Allocate an uninitialized stack slot. This is an intermediate-weight
  //    solution that is harder to clean up. It is often valid, but may fail
  //    for an object with dynamic bounds. This option is "automatically"
  //    used by default for cases that do not use one of the other options.
  //
  //  - Allocate a heap box/descriptor, initialized to zero. This always
  //    works, but is more heavyweight and harder to clean up. It is used
  //    for dynamic objects via calls to genUnusedEntryPointBox.

  auto genUnusedEntryPointBox = [&]() {
    if (isUnusedEntryDummy) {
      assert(!Fortran::semantics::IsAllocatableOrPointer(sym) &&
             "handled above");
      // The box is read right away because lowering code does not expect
      // a non pointer/allocatable symbol to be mapped to a MutableBox.
      mlir::Type ty = converter.genType(var);
      bool isPolymorphic = false;
      if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(ty)) {
        isPolymorphic = mlir::isa<fir::ClassType>(ty);
        ty = boxTy.getEleTy();
      }
      Fortran::lower::genDeclareSymbol(
          converter, symMap, sym,
          fir::factory::genMutableBoxRead(
              builder, loc,
              fir::factory::createTempMutableBox(builder, loc, ty, {}, {},
                                                 isPolymorphic)),
          fir::FortranVariableFlagsEnum::None,
          converter.isRegisteredDummySymbol(sym));
      return true;
    }
    return false;
  };

  if (isAssumedRank) {
    assert(isUnusedEntryDummy && "assumed rank must be pointers/allocatables "
                                 "or descriptor dummy arguments");
    genUnusedEntryPointBox();
    return;
  }

  // Helper to generate scalars for the symbol properties.
  auto genValue = [&](const Fortran::lower::SomeExpr &expr) {
    return genScalarValue(converter, loc, expr, symMap, stmtCtx);
  };

  // For symbols reaching this point, all properties are constant and can be
  // read/computed already into ssa values.

  // The origin must be \vec{1}.
  auto populateShape = [&](auto &shapes, const auto &bounds, mlir::Value box) {
    for (auto iter : llvm::enumerate(bounds)) {
      auto *spec = iter.value();
      assert(spec->lbound().GetExplicit() &&
             "lbound must be explicit with constant value 1");
      if (auto high = spec->ubound().GetExplicit()) {
        Fortran::lower::SomeExpr highEx{*high};
        mlir::Value ub = genValue(highEx);
        ub = builder.createConvert(loc, idxTy, ub);
        shapes.emplace_back(fir::factory::genMaxWithZero(builder, loc, ub));
      } else if (spec->ubound().isColon()) {
        assert(box && "assumed bounds require a descriptor");
        mlir::Value dim =
            builder.createIntegerConstant(loc, idxTy, iter.index());
        auto dimInfo =
            builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, dim);
        shapes.emplace_back(dimInfo.getResult(1));
      } else if (spec->ubound().isStar()) {
        shapes.emplace_back(getAssumedSizeExtent(loc, builder));
      } else {
        llvm::report_fatal_error("unknown bound category");
      }
    }
  };

  // The origin is not \vec{1}.
  auto populateLBoundsExtents = [&](auto &lbounds, auto &extents,
                                    const auto &bounds, mlir::Value box) {
    for (auto iter : llvm::enumerate(bounds)) {
      auto *spec = iter.value();
      fir::BoxDimsOp dimInfo;
      mlir::Value ub, lb;
      if (spec->lbound().isColon() || spec->ubound().isColon()) {
        // This is an assumed shape because allocatables and pointers extents
        // are not constant in the scope and are not read here.
        assert(box && "deferred bounds require a descriptor");
        mlir::Value dim =
            builder.createIntegerConstant(loc, idxTy, iter.index());
        dimInfo =
            builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, dim);
        extents.emplace_back(dimInfo.getResult(1));
        if (auto low = spec->lbound().GetExplicit()) {
          auto expr = Fortran::lower::SomeExpr{*low};
          mlir::Value lb = builder.createConvert(loc, idxTy, genValue(expr));
          lbounds.emplace_back(lb);
        } else {
          // Implicit lower bound is 1 (Fortran 2018 section 8.5.8.3 point 3.)
          lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, 1));
        }
      } else {
        if (auto low = spec->lbound().GetExplicit()) {
          auto expr = Fortran::lower::SomeExpr{*low};
          lb = builder.createConvert(loc, idxTy, genValue(expr));
        } else {
          TODO(loc, "support for assumed rank entities");
        }
        lbounds.emplace_back(lb);

        if (auto high = spec->ubound().GetExplicit()) {
          auto expr = Fortran::lower::SomeExpr{*high};
          ub = builder.createConvert(loc, idxTy, genValue(expr));
          extents.emplace_back(computeExtent(builder, loc, lb, ub));
        } else {
          // An assumed size array. The extent is not computed.
          assert(spec->ubound().isStar() && "expected assumed size");
          extents.emplace_back(getAssumedSizeExtent(loc, builder));
        }
      }
    }
  };

  //===--------------------------------------------------------------===//
  // Non Pointer non allocatable scalar, explicit shape, and assumed
  // size arrays.
  // Lower the specification expressions.
  //===--------------------------------------------------------------===//

  mlir::Value len;
  llvm::SmallVector<mlir::Value> extents;
  llvm::SmallVector<mlir::Value> lbounds;
  auto arg = symMap.lookupSymbol(sym).getAddr();
  mlir::Value addr = preAlloc;

  if (arg)
    if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(arg.getType())) {
      // Contiguous assumed shape that can be tracked without a fir.box.
      mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
      addr = builder.create<fir::BoxAddrOp>(loc, refTy, arg);
    }

  // Compute/Extract character length.
  if (ba.isChar()) {
    if (arg) {
      assert(!preAlloc && "dummy cannot be pre-allocated");
      if (mlir::isa<fir::BoxCharType>(arg.getType())) {
        std::tie(addr, len) = charHelp.createUnboxChar(arg);
      } else if (mlir::isa<fir::CharacterType>(arg.getType())) {
        // fir.char<1> passed by value (BIND(C) with VALUE attribute).
        addr = builder.create<fir::AllocaOp>(loc, arg.getType());
        builder.create<fir::StoreOp>(loc, arg, addr);
      } else if (!addr) {
        addr = arg;
      }
      // Ensure proper type is given to array/scalar that was transmitted as a
      // fir.boxchar arg or is a statement function actual argument with
      // a different length than the dummy.
      mlir::Type castTy = builder.getRefType(converter.genType(var));
      addr = builder.createConvert(loc, castTy, addr);
    }
    if (std::optional<int64_t> cstLen = ba.getCharLenConst()) {
      // Static length
      len = builder.createIntegerConstant(loc, idxTy, *cstLen);
    } else {
      // Dynamic length
      if (genUnusedEntryPointBox())
        return;
      if (std::optional<Fortran::lower::SomeExpr> charLenExpr =
              ba.getCharLenExpr()) {
        // Explicit length
        mlir::Value rawLen = genValue(*charLenExpr);
        // If the length expression is negative, the length is zero. See
        // F2018 7.4.4.2 point 5.
        len = fir::factory::genMaxWithZero(builder, loc, rawLen);
      } else if (!len) {
        // Assumed length fir.box (possible for contiguous assumed shapes).
        // Read length from box.
        assert(arg && mlir::isa<fir::BoxType>(arg.getType()) &&
               "must be character dummy fir.box");
        len = charHelp.readLengthFromBox(arg);
      }
    }
  }

  // Compute array extents and lower bounds.
  if (ba.isArray()) {
    if (ba.isStaticArray()) {
      if (ba.lboundIsAllOnes()) {
        for (std::int64_t extent :
             recoverShapeVector(ba.staticShape(), preAlloc))
          extents.push_back(genExtentValue(builder, loc, idxTy, extent));
      } else {
        for (auto [lb, extent] :
             llvm::zip(ba.staticLBound(),
                       recoverShapeVector(ba.staticShape(), preAlloc))) {
          lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, lb));
          extents.emplace_back(genExtentValue(builder, loc, idxTy, extent));
        }
      }
    } else {
      // Non compile time constant shape.
      if (genUnusedEntryPointBox())
        return;
      if (ba.lboundIsAllOnes())
        populateShape(extents, ba.dynamicBound(), arg);
      else
        populateLBoundsExtents(lbounds, extents, ba.dynamicBound(), arg);
    }
  }

  // Allocate or extract raw address for the entity
  if (!addr) {
    if (arg) {
      mlir::Type argType = arg.getType();
      const bool isCptrByVal = Fortran::semantics::IsBuiltinCPtr(sym) &&
                               Fortran::lower::isCPtrArgByValueType(argType);
      if (isCptrByVal || !fir::conformsWithPassByRef(argType)) {
        // Dummy argument passed in register. Place the value in memory at that
        // point since lowering expect symbols to be mapped to memory addresses.
        mlir::Type symType = converter.genType(sym);
        addr = builder.create<fir::AllocaOp>(loc, symType);
        if (isCptrByVal) {
          // Place the void* address into the CPTR address component.
          mlir::Value addrComponent =
              fir::factory::genCPtrOrCFunptrAddr(builder, loc, addr, symType);
          builder.createStoreWithConvert(loc, arg, addrComponent);
        } else {
          builder.createStoreWithConvert(loc, arg, addr);
        }
      } else {
        // Dummy address, or address of result whose storage is passed by the
        // caller.
        assert(fir::isa_ref_type(argType) && "must be a memory address");
        addr = arg;
      }
    } else {
      // Local variables
      llvm::SmallVector<mlir::Value> typeParams;
      if (len)
        typeParams.emplace_back(len);
      addr = createNewLocal(converter, loc, var, preAlloc, extents, typeParams);
    }
  }

  ::genDeclareSymbol(converter, symMap, sym, addr, len, extents, lbounds,
                     replace);
  return;
}

void Fortran::lower::defineModuleVariable(
    AbstractConverter &converter, const Fortran::lower::pft::Variable &var) {
  // Use empty linkage for module variables, which makes them available
  // for use in another unit.
  mlir::StringAttr linkage =
      getLinkageAttribute(converter.getFirOpBuilder(), var);
  if (!var.isGlobal())
    fir::emitFatalError(converter.getCurrentLocation(),
                        "attempting to lower module variable as local");
  // Define aggregate storages for equivalenced objects.
  if (var.isAggregateStore()) {
    const Fortran::lower::pft::Variable::AggregateStore &aggregate =
        var.getAggregateStore();
    std::string aggName = mangleGlobalAggregateStore(converter, aggregate);
    defineGlobalAggregateStore(converter, aggregate, aggName, linkage);
    return;
  }
  const Fortran::semantics::Symbol &sym = var.getSymbol();
  if (const Fortran::semantics::Symbol *common =
          Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) {
    // Nothing to do, common block are generated before everything. Ensure
    // this was done by calling getCommonBlockGlobal.
    getCommonBlockGlobal(converter, *common);
  } else if (var.isAlias()) {
    // Do nothing. Mapping will be done on user side.
  } else {
    std::string globalName = converter.mangleName(sym);
    cuf::DataAttributeAttr dataAttr =
        Fortran::lower::translateSymbolCUFDataAttribute(
            converter.getFirOpBuilder().getContext(), sym);
    defineGlobal(converter, var, globalName, linkage, dataAttr);
  }
}

void Fortran::lower::instantiateVariable(AbstractConverter &converter,
                                         const pft::Variable &var,
                                         Fortran::lower::SymMap &symMap,
                                         AggregateStoreMap &storeMap) {
  if (var.hasSymbol()) {
    // Do not try to instantiate symbols twice, except for dummies and results,
    // that may have been mapped to the MLIR entry block arguments, and for
    // which the explicit specifications, if any, has not yet been lowered.
    const auto &sym = var.getSymbol();
    if (!IsDummy(sym) && !IsFunctionResult(sym) && symMap.lookupSymbol(sym))
      return;
  }
  LLVM_DEBUG(llvm::dbgs() << "instantiateVariable: "; var.dump());
  if (var.isAggregateStore())
    instantiateAggregateStore(converter, var, storeMap);
  else if (const Fortran::semantics::Symbol *common =
               Fortran::semantics::FindCommonBlockContaining(
                   var.getSymbol().GetUltimate()))
    instantiateCommon(converter, *common, var, symMap);
  else if (var.isAlias())
    instantiateAlias(converter, var, symMap, storeMap);
  else if (var.isGlobal())
    instantiateGlobal(converter, var, symMap);
  else
    instantiateLocal(converter, var, symMap);
}

static void
mapCallInterfaceSymbol(const Fortran::semantics::Symbol &interfaceSymbol,
                       Fortran::lower::AbstractConverter &converter,
                       const Fortran::lower::CallerInterface &caller,
                       Fortran::lower::SymMap &symMap) {
  Fortran::lower::AggregateStoreMap storeMap;
  for (Fortran::lower::pft::Variable var :
       Fortran::lower::pft::getDependentVariableList(interfaceSymbol)) {
    if (var.isAggregateStore()) {
      instantiateVariable(converter, var, symMap, storeMap);
      continue;
    }
    const Fortran::semantics::Symbol &sym = var.getSymbol();
    if (&sym == &interfaceSymbol)
      continue;
    const auto *hostDetails =
        sym.detailsIf<Fortran::semantics::HostAssocDetails>();
    if (hostDetails && !var.isModuleOrSubmoduleVariable()) {
      // The callee is an internal procedure `A` whose result properties
      // depend on host variables. The caller may be the host, or another
      // internal procedure `B` contained in the same host. In the first
      // case, the host symbol is obviously mapped, in the second case, it
      // must also be mapped because
      // HostAssociations::internalProcedureBindings that was called when
      // lowering `B` will have mapped all host symbols of captured variables
      // to the tuple argument containing the composite of all host associated
      // variables, whether or not the host symbol is actually referred to in
      // `B`. Hence it is possible to simply lookup the variable associated to
      // the host symbol without having to go back to the tuple argument.
      symMap.copySymbolBinding(hostDetails->symbol(), sym);
      // The SymbolBox associated to the host symbols is complete, skip
      // instantiateVariable that would try to allocate a new storage.
      continue;
    }
    if (Fortran::semantics::IsDummy(sym) &&
        sym.owner() == interfaceSymbol.owner()) {
      // Get the argument for the dummy argument symbols of the current call.
      symMap.addSymbol(sym, caller.getArgumentValue(sym));
      // All the properties of the dummy variable may not come from the actual
      // argument, let instantiateVariable handle this.
    }
    // If this is neither a host associated or dummy symbol, it must be a
    // module or common block variable to satisfy specification expression
    // requirements in 10.1.11, instantiateVariable will get its address and
    // properties.
    instantiateVariable(converter, var, symMap, storeMap);
  }
}

void Fortran::lower::mapCallInterfaceSymbolsForResult(
    AbstractConverter &converter, const Fortran::lower::CallerInterface &caller,
    SymMap &symMap) {
  const Fortran::semantics::Symbol &result = caller.getResultSymbol();
  mapCallInterfaceSymbol(result, converter, caller, symMap);
}

void Fortran::lower::mapCallInterfaceSymbolsForDummyArgument(
    AbstractConverter &converter, const Fortran::lower::CallerInterface &caller,
    SymMap &symMap, const Fortran::semantics::Symbol &dummySymbol) {
  mapCallInterfaceSymbol(dummySymbol, converter, caller, symMap);
}

void Fortran::lower::mapSymbolAttributes(
    AbstractConverter &converter, const Fortran::semantics::SymbolRef &symbol,
    Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
    mlir::Value preAlloc) {
  mapSymbolAttributes(converter, pft::Variable{symbol}, symMap, stmtCtx,
                      preAlloc);
}

void Fortran::lower::createIntrinsicModuleGlobal(
    Fortran::lower::AbstractConverter &converter, const pft::Variable &var) {
  defineGlobal(converter, var, converter.mangleName(var.getSymbol()),
               converter.getFirOpBuilder().createLinkOnceODRLinkage());
}

void Fortran::lower::createRuntimeTypeInfoGlobal(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::semantics::Symbol &typeInfoSym) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  std::string globalName = converter.mangleName(typeInfoSym);
  auto var = Fortran::lower::pft::Variable(typeInfoSym, /*global=*/true);
  mlir::StringAttr linkage = getLinkageAttribute(builder, var);
  defineGlobal(converter, var, globalName, linkage);
}

mlir::Type Fortran::lower::getCrayPointeeBoxType(mlir::Type fortranType) {
  mlir::Type baseType = hlfir::getFortranElementOrSequenceType(fortranType);
  if (auto seqType = mlir::dyn_cast<fir::SequenceType>(baseType)) {
    // The pointer box's sequence type must be with unknown shape.
    llvm::SmallVector<int64_t> shape(seqType.getDimension(),
                                     fir::SequenceType::getUnknownExtent());
    baseType = fir::SequenceType::get(shape, seqType.getEleTy());
  }
  return fir::BoxType::get(fir::PointerType::get(baseType));
}