abc4f74df7
This is a first simple patch to introduce a new FIR attribute to carry the CUDA variable attribute information to hlfir.declare and fir.declare operations. It currently lowers this information for local variables. The texture attribute is omitted since it is rejected by semantic and will not make its way to MLIR. This new attribute is added as optional attribute to the hlfir.declare and fir.declare operations.
1214 lines
52 KiB
C++
1214 lines
52 KiB
C++
//===-- HLFIRTools.cpp ----------------------------------------------------===//
|
|
//
|
|
// 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
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
//
|
|
// Tools to manipulate HLFIR variable and expressions
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#include "flang/Optimizer/Builder/HLFIRTools.h"
|
|
#include "flang/Optimizer/Builder/Character.h"
|
|
#include "flang/Optimizer/Builder/FIRBuilder.h"
|
|
#include "flang/Optimizer/Builder/MutableBox.h"
|
|
#include "flang/Optimizer/Builder/Runtime/Allocatable.h"
|
|
#include "flang/Optimizer/Builder/Todo.h"
|
|
#include "flang/Optimizer/HLFIR/HLFIROps.h"
|
|
#include "mlir/IR/IRMapping.h"
|
|
#include "mlir/Support/LLVM.h"
|
|
#include "llvm/ADT/TypeSwitch.h"
|
|
#include <optional>
|
|
|
|
// Return explicit extents. If the base is a fir.box, this won't read it to
|
|
// return the extents and will instead return an empty vector.
|
|
llvm::SmallVector<mlir::Value>
|
|
hlfir::getExplicitExtentsFromShape(mlir::Value shape,
|
|
fir::FirOpBuilder &builder) {
|
|
llvm::SmallVector<mlir::Value> result;
|
|
auto *shapeOp = shape.getDefiningOp();
|
|
if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
|
|
auto e = s.getExtents();
|
|
result.append(e.begin(), e.end());
|
|
} else if (auto s = mlir::dyn_cast_or_null<fir::ShapeShiftOp>(shapeOp)) {
|
|
auto e = s.getExtents();
|
|
result.append(e.begin(), e.end());
|
|
} else if (mlir::dyn_cast_or_null<fir::ShiftOp>(shapeOp)) {
|
|
return {};
|
|
} else if (auto s = mlir::dyn_cast_or_null<hlfir::ShapeOfOp>(shapeOp)) {
|
|
hlfir::ExprType expr = s.getExpr().getType().cast<hlfir::ExprType>();
|
|
llvm::ArrayRef<int64_t> exprShape = expr.getShape();
|
|
mlir::Type indexTy = builder.getIndexType();
|
|
fir::ShapeType shapeTy = shape.getType().cast<fir::ShapeType>();
|
|
result.reserve(shapeTy.getRank());
|
|
for (unsigned i = 0; i < shapeTy.getRank(); ++i) {
|
|
int64_t extent = exprShape[i];
|
|
mlir::Value extentVal;
|
|
if (extent == expr.getUnknownExtent()) {
|
|
auto op = builder.create<hlfir::GetExtentOp>(shape.getLoc(), shape, i);
|
|
extentVal = op.getResult();
|
|
} else {
|
|
extentVal =
|
|
builder.createIntegerConstant(shape.getLoc(), indexTy, extent);
|
|
}
|
|
result.emplace_back(extentVal);
|
|
}
|
|
} else {
|
|
TODO(shape.getLoc(), "read fir.shape to get extents");
|
|
}
|
|
return result;
|
|
}
|
|
static llvm::SmallVector<mlir::Value>
|
|
getExplicitExtents(fir::FortranVariableOpInterface var,
|
|
fir::FirOpBuilder &builder) {
|
|
if (mlir::Value shape = var.getShape())
|
|
return hlfir::getExplicitExtentsFromShape(var.getShape(), builder);
|
|
return {};
|
|
}
|
|
|
|
// Return explicit lower bounds. For pointers and allocatables, this will not
|
|
// read the lower bounds and instead return an empty vector.
|
|
static llvm::SmallVector<mlir::Value>
|
|
getExplicitLboundsFromShape(mlir::Value shape) {
|
|
llvm::SmallVector<mlir::Value> result;
|
|
auto *shapeOp = shape.getDefiningOp();
|
|
if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
|
|
return {};
|
|
} else if (auto s = mlir::dyn_cast_or_null<fir::ShapeShiftOp>(shapeOp)) {
|
|
auto e = s.getOrigins();
|
|
result.append(e.begin(), e.end());
|
|
} else if (auto s = mlir::dyn_cast_or_null<fir::ShiftOp>(shapeOp)) {
|
|
auto e = s.getOrigins();
|
|
result.append(e.begin(), e.end());
|
|
} else {
|
|
TODO(shape.getLoc(), "read fir.shape to get lower bounds");
|
|
}
|
|
return result;
|
|
}
|
|
static llvm::SmallVector<mlir::Value>
|
|
getExplicitLbounds(fir::FortranVariableOpInterface var) {
|
|
if (mlir::Value shape = var.getShape())
|
|
return getExplicitLboundsFromShape(shape);
|
|
return {};
|
|
}
|
|
|
|
static void
|
|
genLboundsAndExtentsFromBox(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity boxEntity,
|
|
llvm::SmallVectorImpl<mlir::Value> &lbounds,
|
|
llvm::SmallVectorImpl<mlir::Value> *extents) {
|
|
assert(boxEntity.getType().isa<fir::BaseBoxType>() && "must be a box");
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
const int rank = boxEntity.getRank();
|
|
for (int i = 0; i < rank; ++i) {
|
|
mlir::Value dim = builder.createIntegerConstant(loc, idxTy, i);
|
|
auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
|
|
boxEntity, dim);
|
|
lbounds.push_back(dimInfo.getLowerBound());
|
|
if (extents)
|
|
extents->push_back(dimInfo.getExtent());
|
|
}
|
|
}
|
|
|
|
static llvm::SmallVector<mlir::Value>
|
|
getNonDefaultLowerBounds(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity entity) {
|
|
if (!entity.hasNonDefaultLowerBounds())
|
|
return {};
|
|
if (auto varIface = entity.getIfVariableInterface()) {
|
|
llvm::SmallVector<mlir::Value> lbounds = getExplicitLbounds(varIface);
|
|
if (!lbounds.empty())
|
|
return lbounds;
|
|
}
|
|
if (entity.isMutableBox())
|
|
entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
|
|
llvm::SmallVector<mlir::Value> lowerBounds;
|
|
genLboundsAndExtentsFromBox(loc, builder, entity, lowerBounds,
|
|
/*extents=*/nullptr);
|
|
return lowerBounds;
|
|
}
|
|
|
|
static llvm::SmallVector<mlir::Value> toSmallVector(mlir::ValueRange range) {
|
|
llvm::SmallVector<mlir::Value> res;
|
|
res.append(range.begin(), range.end());
|
|
return res;
|
|
}
|
|
|
|
static llvm::SmallVector<mlir::Value> getExplicitTypeParams(hlfir::Entity var) {
|
|
if (auto varIface = var.getMaybeDereferencedVariableInterface())
|
|
return toSmallVector(varIface.getExplicitTypeParams());
|
|
return {};
|
|
}
|
|
|
|
static mlir::Value tryGettingNonDeferredCharLen(hlfir::Entity var) {
|
|
if (auto varIface = var.getMaybeDereferencedVariableInterface())
|
|
if (!varIface.getExplicitTypeParams().empty())
|
|
return varIface.getExplicitTypeParams()[0];
|
|
return mlir::Value{};
|
|
}
|
|
|
|
static mlir::Value genCharacterVariableLength(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
hlfir::Entity var) {
|
|
if (mlir::Value len = tryGettingNonDeferredCharLen(var))
|
|
return len;
|
|
auto charType = var.getFortranElementType().cast<fir::CharacterType>();
|
|
if (charType.hasConstantLen())
|
|
return builder.createIntegerConstant(loc, builder.getIndexType(),
|
|
charType.getLen());
|
|
if (var.isMutableBox())
|
|
var = hlfir::Entity{builder.create<fir::LoadOp>(loc, var)};
|
|
mlir::Value len = fir::factory::CharacterExprHelper{builder, loc}.getLength(
|
|
var.getFirBase());
|
|
assert(len && "failed to retrieve length");
|
|
return len;
|
|
}
|
|
|
|
static fir::CharBoxValue genUnboxChar(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
mlir::Value boxChar) {
|
|
if (auto emboxChar = boxChar.getDefiningOp<fir::EmboxCharOp>())
|
|
return {emboxChar.getMemref(), emboxChar.getLen()};
|
|
mlir::Type refType = fir::ReferenceType::get(
|
|
boxChar.getType().cast<fir::BoxCharType>().getEleTy());
|
|
auto unboxed = builder.create<fir::UnboxCharOp>(
|
|
loc, refType, builder.getIndexType(), boxChar);
|
|
mlir::Value addr = unboxed.getResult(0);
|
|
mlir::Value len = unboxed.getResult(1);
|
|
if (auto varIface = boxChar.getDefiningOp<fir::FortranVariableOpInterface>())
|
|
if (mlir::Value explicitlen = varIface.getExplicitCharLen())
|
|
len = explicitlen;
|
|
return {addr, len};
|
|
}
|
|
|
|
mlir::Value hlfir::Entity::getFirBase() const {
|
|
if (fir::FortranVariableOpInterface variable = getIfVariableInterface()) {
|
|
if (auto declareOp =
|
|
mlir::dyn_cast<hlfir::DeclareOp>(variable.getOperation()))
|
|
return declareOp.getOriginalBase();
|
|
if (auto associateOp =
|
|
mlir::dyn_cast<hlfir::AssociateOp>(variable.getOperation()))
|
|
return associateOp.getFirBase();
|
|
}
|
|
return getBase();
|
|
}
|
|
|
|
fir::FortranVariableOpInterface
|
|
hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
const fir::ExtendedValue &exv, llvm::StringRef name,
|
|
fir::FortranVariableFlagsAttr flags,
|
|
fir::CUDAAttributeAttr cudaAttr) {
|
|
|
|
mlir::Value base = fir::getBase(exv);
|
|
assert(fir::conformsWithPassByRef(base.getType()) &&
|
|
"entity being declared must be in memory");
|
|
mlir::Value shapeOrShift;
|
|
llvm::SmallVector<mlir::Value> lenParams;
|
|
exv.match(
|
|
[&](const fir::CharBoxValue &box) {
|
|
lenParams.emplace_back(box.getLen());
|
|
},
|
|
[&](const fir::ArrayBoxValue &) {
|
|
shapeOrShift = builder.createShape(loc, exv);
|
|
},
|
|
[&](const fir::CharArrayBoxValue &box) {
|
|
shapeOrShift = builder.createShape(loc, exv);
|
|
lenParams.emplace_back(box.getLen());
|
|
},
|
|
[&](const fir::BoxValue &box) {
|
|
if (!box.getLBounds().empty())
|
|
shapeOrShift = builder.createShape(loc, exv);
|
|
lenParams.append(box.getExplicitParameters().begin(),
|
|
box.getExplicitParameters().end());
|
|
},
|
|
[&](const fir::MutableBoxValue &box) {
|
|
lenParams.append(box.nonDeferredLenParams().begin(),
|
|
box.nonDeferredLenParams().end());
|
|
},
|
|
[](const auto &) {});
|
|
auto declareOp = builder.create<hlfir::DeclareOp>(
|
|
loc, base, name, shapeOrShift, lenParams, flags, cudaAttr);
|
|
return mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());
|
|
}
|
|
|
|
hlfir::AssociateOp
|
|
hlfir::genAssociateExpr(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity value, mlir::Type variableType,
|
|
llvm::StringRef name,
|
|
std::optional<mlir::NamedAttribute> attr) {
|
|
assert(value.isValue() && "must not be a variable");
|
|
mlir::Value shape{};
|
|
if (value.isArray())
|
|
shape = genShape(loc, builder, value);
|
|
|
|
mlir::Value source = value;
|
|
// Lowered scalar expression values for numerical and logical may have a
|
|
// different type than what is required for the type in memory (logical
|
|
// expressions are typically manipulated as i1, but needs to be stored
|
|
// according to the fir.logical<kind> so that the storage size is correct).
|
|
// Character length mismatches are ignored (it is ok for one to be dynamic
|
|
// and the other static).
|
|
mlir::Type varEleTy = getFortranElementType(variableType);
|
|
mlir::Type valueEleTy = getFortranElementType(value.getType());
|
|
if (varEleTy != valueEleTy && !(valueEleTy.isa<fir::CharacterType>() &&
|
|
varEleTy.isa<fir::CharacterType>())) {
|
|
assert(value.isScalar() && fir::isa_trivial(value.getType()));
|
|
source = builder.createConvert(loc, fir::unwrapPassByRefType(variableType),
|
|
value);
|
|
}
|
|
llvm::SmallVector<mlir::Value> lenParams;
|
|
genLengthParameters(loc, builder, value, lenParams);
|
|
if (attr) {
|
|
assert(name.empty() && "It attribute is provided, no-name is expected");
|
|
return builder.create<hlfir::AssociateOp>(loc, source, shape, lenParams,
|
|
fir::FortranVariableFlagsAttr{},
|
|
llvm::ArrayRef{*attr});
|
|
}
|
|
return builder.create<hlfir::AssociateOp>(loc, source, name, shape, lenParams,
|
|
fir::FortranVariableFlagsAttr{});
|
|
}
|
|
|
|
mlir::Value hlfir::genVariableRawAddress(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
hlfir::Entity var) {
|
|
assert(var.isVariable() && "only address of variables can be taken");
|
|
mlir::Value baseAddr = var.getFirBase();
|
|
if (var.isMutableBox())
|
|
baseAddr = builder.create<fir::LoadOp>(loc, baseAddr);
|
|
// Get raw address.
|
|
if (var.getType().isa<fir::BoxCharType>())
|
|
baseAddr = genUnboxChar(loc, builder, var.getBase()).getAddr();
|
|
if (baseAddr.getType().isa<fir::BaseBoxType>())
|
|
baseAddr = builder.create<fir::BoxAddrOp>(loc, baseAddr);
|
|
return baseAddr;
|
|
}
|
|
|
|
mlir::Value hlfir::genVariableBoxChar(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
hlfir::Entity var) {
|
|
assert(var.isVariable() && "only address of variables can be taken");
|
|
if (var.getType().isa<fir::BoxCharType>())
|
|
return var;
|
|
mlir::Value addr = genVariableRawAddress(loc, builder, var);
|
|
llvm::SmallVector<mlir::Value> lengths;
|
|
genLengthParameters(loc, builder, var, lengths);
|
|
assert(lengths.size() == 1);
|
|
auto charType = var.getFortranElementType().cast<fir::CharacterType>();
|
|
auto boxCharType =
|
|
fir::BoxCharType::get(builder.getContext(), charType.getFKind());
|
|
auto scalarAddr =
|
|
builder.createConvert(loc, fir::ReferenceType::get(charType), addr);
|
|
return builder.create<fir::EmboxCharOp>(loc, boxCharType, scalarAddr,
|
|
lengths[0]);
|
|
}
|
|
|
|
hlfir::Entity hlfir::genVariableBox(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
hlfir::Entity var) {
|
|
assert(var.isVariable() && "must be a variable");
|
|
var = hlfir::derefPointersAndAllocatables(loc, builder, var);
|
|
if (var.getType().isa<fir::BaseBoxType>())
|
|
return var;
|
|
// Note: if the var is not a fir.box/fir.class at that point, it has default
|
|
// lower bounds and is not polymorphic.
|
|
mlir::Value shape =
|
|
var.isArray() ? hlfir::genShape(loc, builder, var) : mlir::Value{};
|
|
llvm::SmallVector<mlir::Value> typeParams;
|
|
auto maybeCharType =
|
|
var.getFortranElementType().dyn_cast<fir::CharacterType>();
|
|
if (!maybeCharType || maybeCharType.hasDynamicLen())
|
|
hlfir::genLengthParameters(loc, builder, var, typeParams);
|
|
mlir::Value addr = var.getBase();
|
|
if (var.getType().isa<fir::BoxCharType>())
|
|
addr = genVariableRawAddress(loc, builder, var);
|
|
mlir::Type boxType = fir::BoxType::get(var.getElementOrSequenceType());
|
|
auto embox =
|
|
builder.create<fir::EmboxOp>(loc, boxType, addr, shape,
|
|
/*slice=*/mlir::Value{}, typeParams);
|
|
return hlfir::Entity{embox.getResult()};
|
|
}
|
|
|
|
hlfir::Entity hlfir::loadTrivialScalar(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
Entity entity) {
|
|
entity = derefPointersAndAllocatables(loc, builder, entity);
|
|
if (entity.isVariable() && entity.isScalar() &&
|
|
fir::isa_trivial(entity.getFortranElementType())) {
|
|
return Entity{builder.create<fir::LoadOp>(loc, entity)};
|
|
}
|
|
return entity;
|
|
}
|
|
|
|
hlfir::Entity hlfir::getElementAt(mlir::Location loc,
|
|
fir::FirOpBuilder &builder, Entity entity,
|
|
mlir::ValueRange oneBasedIndices) {
|
|
if (entity.isScalar())
|
|
return entity;
|
|
llvm::SmallVector<mlir::Value> lenParams;
|
|
genLengthParameters(loc, builder, entity, lenParams);
|
|
if (entity.getType().isa<hlfir::ExprType>())
|
|
return hlfir::Entity{builder.create<hlfir::ApplyOp>(
|
|
loc, entity, oneBasedIndices, lenParams)};
|
|
// Build hlfir.designate. The lower bounds may need to be added to
|
|
// the oneBasedIndices since hlfir.designate expect indices
|
|
// based on the array operand lower bounds.
|
|
mlir::Type resultType = hlfir::getVariableElementType(entity);
|
|
hlfir::DesignateOp designate;
|
|
llvm::SmallVector<mlir::Value> lbounds =
|
|
getNonDefaultLowerBounds(loc, builder, entity);
|
|
if (!lbounds.empty()) {
|
|
llvm::SmallVector<mlir::Value> indices;
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
|
|
for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, lbounds)) {
|
|
auto lbIdx = builder.createConvert(loc, idxTy, lb);
|
|
auto oneBasedIdx = builder.createConvert(loc, idxTy, oneBased);
|
|
auto shift = builder.create<mlir::arith::SubIOp>(loc, lbIdx, one);
|
|
mlir::Value index =
|
|
builder.create<mlir::arith::AddIOp>(loc, oneBasedIdx, shift);
|
|
indices.push_back(index);
|
|
}
|
|
designate = builder.create<hlfir::DesignateOp>(loc, resultType, entity,
|
|
indices, lenParams);
|
|
} else {
|
|
designate = builder.create<hlfir::DesignateOp>(loc, resultType, entity,
|
|
oneBasedIndices, lenParams);
|
|
}
|
|
return mlir::cast<fir::FortranVariableOpInterface>(designate.getOperation());
|
|
}
|
|
|
|
static mlir::Value genUBound(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
mlir::Value lb, mlir::Value extent,
|
|
mlir::Value one) {
|
|
if (auto constantLb = fir::getIntIfConstant(lb))
|
|
if (*constantLb == 1)
|
|
return extent;
|
|
extent = builder.createConvert(loc, one.getType(), extent);
|
|
lb = builder.createConvert(loc, one.getType(), lb);
|
|
auto add = builder.create<mlir::arith::AddIOp>(loc, lb, extent);
|
|
return builder.create<mlir::arith::SubIOp>(loc, add, one);
|
|
}
|
|
|
|
llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
|
|
hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
Entity entity) {
|
|
if (entity.getType().isa<hlfir::ExprType>())
|
|
TODO(loc, "bounds of expressions in hlfir");
|
|
auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
|
|
assert(!cleanup && "translation of entity should not yield cleanup");
|
|
if (const auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>())
|
|
exv = fir::factory::genMutableBoxRead(builder, loc, *mutableBox);
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
|
|
llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> result;
|
|
for (unsigned dim = 0; dim < exv.rank(); ++dim) {
|
|
mlir::Value extent = fir::factory::readExtent(builder, loc, exv, dim);
|
|
mlir::Value lb = fir::factory::readLowerBound(builder, loc, exv, dim, one);
|
|
mlir::Value ub = genUBound(loc, builder, lb, extent, one);
|
|
result.push_back({lb, ub});
|
|
}
|
|
return result;
|
|
}
|
|
|
|
llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
|
|
hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
mlir::Value shape) {
|
|
assert((shape.getType().isa<fir::ShapeShiftType>() ||
|
|
shape.getType().isa<fir::ShapeType>()) &&
|
|
"shape must contain extents");
|
|
auto extents = hlfir::getExplicitExtentsFromShape(shape, builder);
|
|
auto lowers = getExplicitLboundsFromShape(shape);
|
|
assert(lowers.empty() || lowers.size() == extents.size());
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
|
|
llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> result;
|
|
for (auto extent : llvm::enumerate(extents)) {
|
|
mlir::Value lb = lowers.empty() ? one : lowers[extent.index()];
|
|
mlir::Value ub = lowers.empty()
|
|
? extent.value()
|
|
: genUBound(loc, builder, lb, extent.value(), one);
|
|
result.push_back({lb, ub});
|
|
}
|
|
return result;
|
|
}
|
|
|
|
llvm::SmallVector<mlir::Value> hlfir::genLowerbounds(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
mlir::Value shape,
|
|
unsigned rank) {
|
|
llvm::SmallVector<mlir::Value> lbounds;
|
|
if (shape)
|
|
lbounds = getExplicitLboundsFromShape(shape);
|
|
if (!lbounds.empty())
|
|
return lbounds;
|
|
mlir::Value one =
|
|
builder.createIntegerConstant(loc, builder.getIndexType(), 1);
|
|
return llvm::SmallVector<mlir::Value>(rank, one);
|
|
}
|
|
|
|
static hlfir::Entity followShapeInducingSource(hlfir::Entity entity) {
|
|
while (true) {
|
|
if (auto reassoc = entity.getDefiningOp<hlfir::NoReassocOp>()) {
|
|
entity = hlfir::Entity{reassoc.getVal()};
|
|
continue;
|
|
}
|
|
if (auto asExpr = entity.getDefiningOp<hlfir::AsExprOp>()) {
|
|
entity = hlfir::Entity{asExpr.getVar()};
|
|
continue;
|
|
}
|
|
break;
|
|
}
|
|
return entity;
|
|
}
|
|
|
|
static mlir::Value computeVariableExtent(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
hlfir::Entity variable,
|
|
fir::SequenceType seqTy,
|
|
unsigned dim) {
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
if (seqTy.getShape().size() > dim) {
|
|
fir::SequenceType::Extent typeExtent = seqTy.getShape()[dim];
|
|
if (typeExtent != fir::SequenceType::getUnknownExtent())
|
|
return builder.createIntegerConstant(loc, idxTy, typeExtent);
|
|
}
|
|
assert(variable.getType().isa<fir::BaseBoxType>() &&
|
|
"array variable with dynamic extent must be boxed");
|
|
mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim);
|
|
auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
|
|
variable, dimVal);
|
|
return dimInfo.getExtent();
|
|
}
|
|
llvm::SmallVector<mlir::Value> getVariableExtents(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
hlfir::Entity variable) {
|
|
llvm::SmallVector<mlir::Value> extents;
|
|
if (fir::FortranVariableOpInterface varIface =
|
|
variable.getIfVariableInterface()) {
|
|
extents = getExplicitExtents(varIface, builder);
|
|
if (!extents.empty())
|
|
return extents;
|
|
}
|
|
|
|
if (variable.isMutableBox())
|
|
variable = hlfir::derefPointersAndAllocatables(loc, builder, variable);
|
|
// Use the type shape information, and/or the fir.box/fir.class shape
|
|
// information if any extents are not static.
|
|
fir::SequenceType seqTy =
|
|
hlfir::getFortranElementOrSequenceType(variable.getType())
|
|
.cast<fir::SequenceType>();
|
|
unsigned rank = seqTy.getShape().size();
|
|
for (unsigned dim = 0; dim < rank; ++dim)
|
|
extents.push_back(
|
|
computeVariableExtent(loc, builder, variable, seqTy, dim));
|
|
return extents;
|
|
}
|
|
|
|
static mlir::Value tryRetrievingShapeOrShift(hlfir::Entity entity) {
|
|
if (entity.getType().isa<hlfir::ExprType>()) {
|
|
if (auto elemental = entity.getDefiningOp<hlfir::ElementalOp>())
|
|
return elemental.getShape();
|
|
return mlir::Value{};
|
|
}
|
|
if (auto varIface = entity.getIfVariableInterface())
|
|
return varIface.getShape();
|
|
return {};
|
|
}
|
|
|
|
mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity entity) {
|
|
assert(entity.isArray() && "entity must be an array");
|
|
entity = followShapeInducingSource(entity);
|
|
assert(entity && "what?");
|
|
if (auto shape = tryRetrievingShapeOrShift(entity)) {
|
|
if (shape.getType().isa<fir::ShapeType>())
|
|
return shape;
|
|
if (shape.getType().isa<fir::ShapeShiftType>())
|
|
if (auto s = shape.getDefiningOp<fir::ShapeShiftOp>())
|
|
return builder.create<fir::ShapeOp>(loc, s.getExtents());
|
|
}
|
|
if (entity.getType().isa<hlfir::ExprType>())
|
|
return builder.create<hlfir::ShapeOfOp>(loc, entity.getBase());
|
|
// There is no shape lying around for this entity. Retrieve the extents and
|
|
// build a new fir.shape.
|
|
return builder.create<fir::ShapeOp>(loc,
|
|
getVariableExtents(loc, builder, entity));
|
|
}
|
|
|
|
llvm::SmallVector<mlir::Value>
|
|
hlfir::getIndexExtents(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
mlir::Value shape) {
|
|
llvm::SmallVector<mlir::Value> extents =
|
|
hlfir::getExplicitExtentsFromShape(shape, builder);
|
|
mlir::Type indexType = builder.getIndexType();
|
|
for (auto &extent : extents)
|
|
extent = builder.createConvert(loc, indexType, extent);
|
|
return extents;
|
|
}
|
|
|
|
mlir::Value hlfir::genExtent(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity entity, unsigned dim) {
|
|
entity = followShapeInducingSource(entity);
|
|
if (auto shape = tryRetrievingShapeOrShift(entity)) {
|
|
auto extents = hlfir::getExplicitExtentsFromShape(shape, builder);
|
|
if (!extents.empty()) {
|
|
assert(extents.size() > dim && "bad inquiry");
|
|
return extents[dim];
|
|
}
|
|
}
|
|
if (entity.isVariable()) {
|
|
if (entity.isMutableBox())
|
|
entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
|
|
// Use the type shape information, and/or the fir.box/fir.class shape
|
|
// information if any extents are not static.
|
|
fir::SequenceType seqTy =
|
|
hlfir::getFortranElementOrSequenceType(entity.getType())
|
|
.cast<fir::SequenceType>();
|
|
return computeVariableExtent(loc, builder, entity, seqTy, dim);
|
|
}
|
|
TODO(loc, "get extent from HLFIR expr without producer holding the shape");
|
|
}
|
|
|
|
mlir::Value hlfir::genLBound(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity entity, unsigned dim) {
|
|
if (!entity.hasNonDefaultLowerBounds())
|
|
return builder.createIntegerConstant(loc, builder.getIndexType(), 1);
|
|
if (auto shape = tryRetrievingShapeOrShift(entity)) {
|
|
auto lbounds = getExplicitLboundsFromShape(shape);
|
|
if (!lbounds.empty()) {
|
|
assert(lbounds.size() > dim && "bad inquiry");
|
|
return lbounds[dim];
|
|
}
|
|
}
|
|
if (entity.isMutableBox())
|
|
entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
|
|
assert(entity.getType().isa<fir::BaseBoxType>() && "must be a box");
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim);
|
|
auto dimInfo =
|
|
builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, entity, dimVal);
|
|
return dimInfo.getLowerBound();
|
|
}
|
|
|
|
void hlfir::genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
Entity entity,
|
|
llvm::SmallVectorImpl<mlir::Value> &result) {
|
|
if (!entity.hasLengthParameters())
|
|
return;
|
|
if (entity.getType().isa<hlfir::ExprType>()) {
|
|
mlir::Value expr = entity;
|
|
if (auto reassoc = expr.getDefiningOp<hlfir::NoReassocOp>())
|
|
expr = reassoc.getVal();
|
|
// Going through fir::ExtendedValue would create a temp,
|
|
// which is not desired for an inquiry.
|
|
// TODO: make this an interface when adding further character producing ops.
|
|
if (auto concat = expr.getDefiningOp<hlfir::ConcatOp>()) {
|
|
result.push_back(concat.getLength());
|
|
return;
|
|
} else if (auto concat = expr.getDefiningOp<hlfir::SetLengthOp>()) {
|
|
result.push_back(concat.getLength());
|
|
return;
|
|
} else if (auto asExpr = expr.getDefiningOp<hlfir::AsExprOp>()) {
|
|
hlfir::genLengthParameters(loc, builder, hlfir::Entity{asExpr.getVar()},
|
|
result);
|
|
return;
|
|
} else if (auto elemental = expr.getDefiningOp<hlfir::ElementalOp>()) {
|
|
result.append(elemental.getTypeparams().begin(),
|
|
elemental.getTypeparams().end());
|
|
return;
|
|
} else if (auto apply = expr.getDefiningOp<hlfir::ApplyOp>()) {
|
|
result.append(apply.getTypeparams().begin(), apply.getTypeparams().end());
|
|
return;
|
|
}
|
|
if (entity.isCharacter()) {
|
|
result.push_back(builder.create<hlfir::GetLengthOp>(loc, expr));
|
|
return;
|
|
}
|
|
TODO(loc, "inquire PDTs length parameters of hlfir.expr");
|
|
}
|
|
|
|
if (entity.isCharacter()) {
|
|
result.push_back(genCharacterVariableLength(loc, builder, entity));
|
|
return;
|
|
}
|
|
TODO(loc, "inquire PDTs length parameters in HLFIR");
|
|
}
|
|
|
|
mlir::Value hlfir::genCharLength(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity entity) {
|
|
llvm::SmallVector<mlir::Value, 1> lenParams;
|
|
genLengthParameters(loc, builder, entity, lenParams);
|
|
assert(lenParams.size() == 1 && "characters must have one length parameters");
|
|
return lenParams[0];
|
|
}
|
|
|
|
// Return a "shape" that can be used in fir.embox/fir.rebox with \p exv base.
|
|
static mlir::Value asEmboxShape(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
const fir::ExtendedValue &exv,
|
|
mlir::Value shape) {
|
|
if (!shape)
|
|
return shape;
|
|
// fir.rebox does not need and does not accept extents (fir.shape or
|
|
// fir.shape_shift) since this information is already in the input fir.box,
|
|
// it only accepts fir.shift because local lower bounds may not be reflected
|
|
// in the fir.box.
|
|
if (fir::getBase(exv).getType().isa<fir::BaseBoxType>() &&
|
|
!shape.getType().isa<fir::ShiftType>())
|
|
return builder.createShape(loc, exv);
|
|
return shape;
|
|
}
|
|
|
|
std::pair<mlir::Value, mlir::Value> hlfir::genVariableFirBaseShapeAndParams(
|
|
mlir::Location loc, fir::FirOpBuilder &builder, Entity entity,
|
|
llvm::SmallVectorImpl<mlir::Value> &typeParams) {
|
|
auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
|
|
assert(!cleanup && "variable to Exv should not produce cleanup");
|
|
if (entity.hasLengthParameters()) {
|
|
auto params = fir::getTypeParams(exv);
|
|
typeParams.append(params.begin(), params.end());
|
|
}
|
|
if (entity.isScalar())
|
|
return {fir::getBase(exv), mlir::Value{}};
|
|
if (auto variableInterface = entity.getIfVariableInterface())
|
|
return {fir::getBase(exv),
|
|
asEmboxShape(loc, builder, exv, variableInterface.getShape())};
|
|
return {fir::getBase(exv), builder.createShape(loc, exv)};
|
|
}
|
|
|
|
hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
Entity entity) {
|
|
if (entity.isMutableBox()) {
|
|
hlfir::Entity boxLoad{builder.create<fir::LoadOp>(loc, entity)};
|
|
if (entity.isScalar()) {
|
|
if (!entity.isPolymorphic() && !entity.hasLengthParameters())
|
|
return hlfir::Entity{builder.create<fir::BoxAddrOp>(loc, boxLoad)};
|
|
mlir::Type elementType = boxLoad.getFortranElementType();
|
|
if (auto charType = elementType.dyn_cast<fir::CharacterType>()) {
|
|
mlir::Value base = builder.create<fir::BoxAddrOp>(loc, boxLoad);
|
|
if (charType.hasConstantLen())
|
|
return hlfir::Entity{base};
|
|
mlir::Value len = genCharacterVariableLength(loc, builder, entity);
|
|
auto boxCharType =
|
|
fir::BoxCharType::get(builder.getContext(), charType.getFKind());
|
|
return hlfir::Entity{
|
|
builder.create<fir::EmboxCharOp>(loc, boxCharType, base, len)
|
|
.getResult()};
|
|
}
|
|
}
|
|
// Otherwise, the entity is either an array, a polymorphic entity, or a
|
|
// derived type with length parameters. All these entities require a fir.box
|
|
// or fir.class to hold bounds, dynamic type or length parameter
|
|
// information. Keep them boxed.
|
|
return boxLoad;
|
|
} else if (entity.isProcedurePointer()) {
|
|
return hlfir::Entity{builder.create<fir::LoadOp>(loc, entity)};
|
|
}
|
|
return entity;
|
|
}
|
|
|
|
mlir::Type hlfir::getVariableElementType(hlfir::Entity variable) {
|
|
assert(variable.isVariable() && "entity must be a variable");
|
|
if (variable.isScalar())
|
|
return variable.getType();
|
|
mlir::Type eleTy = variable.getFortranElementType();
|
|
if (variable.isPolymorphic())
|
|
return fir::ClassType::get(eleTy);
|
|
if (auto charType = eleTy.dyn_cast<fir::CharacterType>()) {
|
|
if (charType.hasDynamicLen())
|
|
return fir::BoxCharType::get(charType.getContext(), charType.getFKind());
|
|
} else if (fir::isRecordWithTypeParameters(eleTy)) {
|
|
return fir::BoxType::get(eleTy);
|
|
}
|
|
return fir::ReferenceType::get(eleTy);
|
|
}
|
|
|
|
mlir::Type hlfir::getEntityElementType(hlfir::Entity entity) {
|
|
if (entity.isVariable())
|
|
return getVariableElementType(entity);
|
|
if (entity.isScalar())
|
|
return entity.getType();
|
|
auto exprType = mlir::dyn_cast<hlfir::ExprType>(entity.getType());
|
|
assert(exprType && "array value must be an hlfir.expr");
|
|
return exprType.getElementExprType();
|
|
}
|
|
|
|
static hlfir::ExprType getArrayExprType(mlir::Type elementType,
|
|
mlir::Value shape, bool isPolymorphic) {
|
|
unsigned rank = shape.getType().cast<fir::ShapeType>().getRank();
|
|
hlfir::ExprType::Shape typeShape(rank, hlfir::ExprType::getUnknownExtent());
|
|
if (auto shapeOp = shape.getDefiningOp<fir::ShapeOp>())
|
|
for (auto extent : llvm::enumerate(shapeOp.getExtents()))
|
|
if (auto cstExtent = fir::getIntIfConstant(extent.value()))
|
|
typeShape[extent.index()] = *cstExtent;
|
|
return hlfir::ExprType::get(elementType.getContext(), typeShape, elementType,
|
|
isPolymorphic);
|
|
}
|
|
|
|
hlfir::ElementalOp hlfir::genElementalOp(
|
|
mlir::Location loc, fir::FirOpBuilder &builder, mlir::Type elementType,
|
|
mlir::Value shape, mlir::ValueRange typeParams,
|
|
const ElementalKernelGenerator &genKernel, bool isUnordered,
|
|
mlir::Value polymorphicMold, mlir::Type exprType) {
|
|
if (!exprType)
|
|
exprType = getArrayExprType(elementType, shape, !!polymorphicMold);
|
|
auto elementalOp = builder.create<hlfir::ElementalOp>(
|
|
loc, exprType, shape, polymorphicMold, typeParams, isUnordered);
|
|
auto insertPt = builder.saveInsertionPoint();
|
|
builder.setInsertionPointToStart(elementalOp.getBody());
|
|
mlir::Value elementResult = genKernel(loc, builder, elementalOp.getIndices());
|
|
// Numerical and logical scalars may be lowered to another type than the
|
|
// Fortran expression type (e.g i1 instead of fir.logical). Array expression
|
|
// values are typed according to their Fortran type. Insert a cast if needed
|
|
// here.
|
|
if (fir::isa_trivial(elementResult.getType()))
|
|
elementResult = builder.createConvert(loc, elementType, elementResult);
|
|
builder.create<hlfir::YieldElementOp>(loc, elementResult);
|
|
builder.restoreInsertionPoint(insertPt);
|
|
return elementalOp;
|
|
}
|
|
|
|
// TODO: we do not actually need to clone the YieldElementOp,
|
|
// because returning its getElementValue() operand should be enough
|
|
// for all callers of this function.
|
|
hlfir::YieldElementOp
|
|
hlfir::inlineElementalOp(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::ElementalOp elemental,
|
|
mlir::ValueRange oneBasedIndices) {
|
|
// hlfir.elemental region is a SizedRegion<1>.
|
|
assert(elemental.getRegion().hasOneBlock() &&
|
|
"expect elemental region to have one block");
|
|
mlir::IRMapping mapper;
|
|
mapper.map(elemental.getIndices(), oneBasedIndices);
|
|
mlir::Operation *newOp;
|
|
for (auto &op : elemental.getRegion().back().getOperations())
|
|
newOp = builder.clone(op, mapper);
|
|
auto yield = mlir::dyn_cast_or_null<hlfir::YieldElementOp>(newOp);
|
|
assert(yield && "last ElementalOp operation must be am hlfir.yield_element");
|
|
return yield;
|
|
}
|
|
|
|
mlir::Value hlfir::inlineElementalOp(
|
|
mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::ElementalOpInterface elemental, mlir::ValueRange oneBasedIndices,
|
|
mlir::IRMapping &mapper,
|
|
const std::function<bool(hlfir::ElementalOp)> &mustRecursivelyInline) {
|
|
mlir::Region ®ion = elemental.getElementalRegion();
|
|
// hlfir.elemental region is a SizedRegion<1>.
|
|
assert(region.hasOneBlock() && "elemental region must have one block");
|
|
mapper.map(elemental.getIndices(), oneBasedIndices);
|
|
for (auto &op : region.front().without_terminator()) {
|
|
if (auto apply = mlir::dyn_cast<hlfir::ApplyOp>(op))
|
|
if (auto appliedElemental =
|
|
apply.getExpr().getDefiningOp<hlfir::ElementalOp>())
|
|
if (mustRecursivelyInline(appliedElemental)) {
|
|
llvm::SmallVector<mlir::Value> clonedApplyIndices;
|
|
for (auto indice : apply.getIndices())
|
|
clonedApplyIndices.push_back(mapper.lookupOrDefault(indice));
|
|
hlfir::ElementalOpInterface elementalIface =
|
|
mlir::cast<hlfir::ElementalOpInterface>(
|
|
appliedElemental.getOperation());
|
|
mlir::Value inlined = inlineElementalOp(loc, builder, elementalIface,
|
|
clonedApplyIndices, mapper,
|
|
mustRecursivelyInline);
|
|
mapper.map(apply.getResult(), inlined);
|
|
continue;
|
|
}
|
|
(void)builder.clone(op, mapper);
|
|
}
|
|
return mapper.lookupOrDefault(elemental.getElementEntity());
|
|
}
|
|
|
|
hlfir::LoopNest hlfir::genLoopNest(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
mlir::ValueRange extents, bool isUnordered) {
|
|
hlfir::LoopNest loopNest;
|
|
assert(!extents.empty() && "must have at least one extent");
|
|
auto insPt = builder.saveInsertionPoint();
|
|
loopNest.oneBasedIndices.assign(extents.size(), mlir::Value{});
|
|
// Build loop nest from column to row.
|
|
auto one = builder.create<mlir::arith::ConstantIndexOp>(loc, 1);
|
|
mlir::Type indexType = builder.getIndexType();
|
|
unsigned dim = extents.size() - 1;
|
|
for (auto extent : llvm::reverse(extents)) {
|
|
auto ub = builder.createConvert(loc, indexType, extent);
|
|
loopNest.innerLoop =
|
|
builder.create<fir::DoLoopOp>(loc, one, ub, one, isUnordered);
|
|
builder.setInsertionPointToStart(loopNest.innerLoop.getBody());
|
|
// Reverse the indices so they are in column-major order.
|
|
loopNest.oneBasedIndices[dim--] = loopNest.innerLoop.getInductionVar();
|
|
if (!loopNest.outerLoop)
|
|
loopNest.outerLoop = loopNest.innerLoop;
|
|
}
|
|
builder.restoreInsertionPoint(insPt);
|
|
return loopNest;
|
|
}
|
|
|
|
static fir::ExtendedValue
|
|
translateVariableToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity variable) {
|
|
assert(variable.isVariable() && "must be a variable");
|
|
/// When going towards FIR, use the original base value to avoid
|
|
/// introducing descriptors at runtime when they are not required.
|
|
mlir::Value firBase = variable.getFirBase();
|
|
if (variable.isMutableBox())
|
|
return fir::MutableBoxValue(firBase, getExplicitTypeParams(variable),
|
|
fir::MutableProperties{});
|
|
|
|
if (firBase.getType().isa<fir::BaseBoxType>()) {
|
|
if (!variable.isSimplyContiguous() || variable.isPolymorphic() ||
|
|
variable.isDerivedWithLengthParameters() || variable.isOptional()) {
|
|
llvm::SmallVector<mlir::Value> nonDefaultLbounds =
|
|
getNonDefaultLowerBounds(loc, builder, variable);
|
|
return fir::BoxValue(firBase, nonDefaultLbounds,
|
|
getExplicitTypeParams(variable));
|
|
}
|
|
// Otherwise, the variable can be represented in a fir::ExtendedValue
|
|
// without the overhead of a fir.box.
|
|
firBase = genVariableRawAddress(loc, builder, variable);
|
|
}
|
|
|
|
if (variable.isScalar()) {
|
|
if (variable.isCharacter()) {
|
|
if (firBase.getType().isa<fir::BoxCharType>())
|
|
return genUnboxChar(loc, builder, firBase);
|
|
mlir::Value len = genCharacterVariableLength(loc, builder, variable);
|
|
return fir::CharBoxValue{firBase, len};
|
|
}
|
|
return firBase;
|
|
}
|
|
llvm::SmallVector<mlir::Value> extents;
|
|
llvm::SmallVector<mlir::Value> nonDefaultLbounds;
|
|
if (variable.getType().isa<fir::BaseBoxType>() &&
|
|
!variable.getIfVariableInterface()) {
|
|
// This special case avoids generating two sets of identical
|
|
// fir.box_dim to get both the lower bounds and extents.
|
|
genLboundsAndExtentsFromBox(loc, builder, variable, nonDefaultLbounds,
|
|
&extents);
|
|
} else {
|
|
extents = getVariableExtents(loc, builder, variable);
|
|
nonDefaultLbounds = getNonDefaultLowerBounds(loc, builder, variable);
|
|
}
|
|
if (variable.isCharacter())
|
|
return fir::CharArrayBoxValue{
|
|
firBase, genCharacterVariableLength(loc, builder, variable), extents,
|
|
nonDefaultLbounds};
|
|
return fir::ArrayBoxValue{firBase, extents, nonDefaultLbounds};
|
|
}
|
|
|
|
fir::ExtendedValue
|
|
hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
fir::FortranVariableOpInterface var) {
|
|
return translateVariableToExtendedValue(loc, builder, var);
|
|
}
|
|
|
|
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
|
|
hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity entity) {
|
|
if (entity.isVariable())
|
|
return {translateVariableToExtendedValue(loc, builder, entity),
|
|
std::nullopt};
|
|
|
|
if (entity.isProcedure()) {
|
|
if (fir::isCharacterProcedureTuple(entity.getType())) {
|
|
auto [boxProc, len] = fir::factory::extractCharacterProcedureTuple(
|
|
builder, loc, entity, /*openBoxProc=*/false);
|
|
return {fir::CharBoxValue{boxProc, len}, std::nullopt};
|
|
}
|
|
return {static_cast<mlir::Value>(entity), std::nullopt};
|
|
}
|
|
|
|
if (entity.getType().isa<hlfir::ExprType>()) {
|
|
mlir::NamedAttribute byRefAttr = fir::getAdaptToByRefAttr(builder);
|
|
hlfir::AssociateOp associate = hlfir::genAssociateExpr(
|
|
loc, builder, entity, entity.getType(), "", byRefAttr);
|
|
auto *bldr = &builder;
|
|
hlfir::CleanupFunction cleanup = [bldr, loc, associate]() -> void {
|
|
bldr->create<hlfir::EndAssociateOp>(loc, associate);
|
|
};
|
|
hlfir::Entity temp{associate.getBase()};
|
|
return {translateToExtendedValue(loc, builder, temp).first, cleanup};
|
|
}
|
|
return {{static_cast<mlir::Value>(entity)}, {}};
|
|
}
|
|
|
|
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
|
|
hlfir::convertToValue(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity entity) {
|
|
// Load scalar references to integer, logical, real, or complex value
|
|
// to an mlir value, dereference allocatable and pointers, and get rid
|
|
// of fir.box that are not needed or create a copy into contiguous memory.
|
|
auto derefedAndLoadedEntity = loadTrivialScalar(loc, builder, entity);
|
|
return translateToExtendedValue(loc, builder, derefedAndLoadedEntity);
|
|
}
|
|
|
|
static fir::ExtendedValue placeTrivialInMemory(mlir::Location loc,
|
|
fir::FirOpBuilder &builder,
|
|
mlir::Value val,
|
|
mlir::Type targetType) {
|
|
auto temp = builder.createTemporary(loc, targetType);
|
|
if (targetType != val.getType())
|
|
builder.createStoreWithConvert(loc, val, temp);
|
|
else
|
|
builder.create<fir::StoreOp>(loc, val, temp);
|
|
return temp;
|
|
}
|
|
|
|
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
|
|
hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity entity, mlir::Type targetType) {
|
|
// fir::factory::createBoxValue is not meant to deal with procedures.
|
|
// Dereference procedure pointers here.
|
|
if (entity.isProcedurePointer())
|
|
entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
|
|
|
|
auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
|
|
// Procedure entities should not go through createBoxValue that embox
|
|
// object entities. Return the fir.boxproc directly.
|
|
if (entity.isProcedure())
|
|
return {exv, cleanup};
|
|
mlir::Value base = fir::getBase(exv);
|
|
if (fir::isa_trivial(base.getType()))
|
|
exv = placeTrivialInMemory(loc, builder, base, targetType);
|
|
fir::BoxValue box = fir::factory::createBoxValue(builder, loc, exv);
|
|
return {box, cleanup};
|
|
}
|
|
|
|
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
|
|
hlfir::convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity entity, mlir::Type targetType) {
|
|
hlfir::Entity derefedEntity =
|
|
hlfir::derefPointersAndAllocatables(loc, builder, entity);
|
|
auto [exv, cleanup] =
|
|
hlfir::translateToExtendedValue(loc, builder, derefedEntity);
|
|
mlir::Value base = fir::getBase(exv);
|
|
if (fir::isa_trivial(base.getType()))
|
|
exv = placeTrivialInMemory(loc, builder, base, targetType);
|
|
return {exv, cleanup};
|
|
}
|
|
|
|
/// Clone:
|
|
/// ```
|
|
/// hlfir.elemental_addr %shape : !fir.shape<1> {
|
|
/// ^bb0(%i : index)
|
|
/// .....
|
|
/// %hlfir.yield %scalarAddress : fir.ref<T>
|
|
/// }
|
|
/// ```
|
|
//
|
|
/// into
|
|
///
|
|
/// ```
|
|
/// %expr = hlfir.elemental %shape : (!fir.shape<1>) -> hlfir.expr<?xT> {
|
|
/// ^bb0(%i : index)
|
|
/// .....
|
|
/// %value = fir.load %scalarAddress : fir.ref<T>
|
|
/// %hlfir.yield_element %value : T
|
|
/// }
|
|
/// ```
|
|
hlfir::ElementalOp
|
|
hlfir::cloneToElementalOp(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::ElementalAddrOp elementalAddrOp) {
|
|
hlfir::Entity scalarAddress =
|
|
hlfir::Entity{mlir::cast<hlfir::YieldOp>(
|
|
elementalAddrOp.getBody().back().getTerminator())
|
|
.getEntity()};
|
|
llvm::SmallVector<mlir::Value, 1> typeParams;
|
|
hlfir::genLengthParameters(loc, builder, scalarAddress, typeParams);
|
|
|
|
builder.setInsertionPointAfter(elementalAddrOp);
|
|
auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b,
|
|
mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
|
|
mlir::IRMapping mapper;
|
|
mapper.map(elementalAddrOp.getIndices(), oneBasedIndices);
|
|
mlir::Operation *newOp = nullptr;
|
|
for (auto &op : elementalAddrOp.getBody().back().getOperations())
|
|
newOp = b.clone(op, mapper);
|
|
auto newYielOp = mlir::dyn_cast_or_null<hlfir::YieldOp>(newOp);
|
|
assert(newYielOp && "hlfir.elemental_addr is ill formed");
|
|
hlfir::Entity newAddr{newYielOp.getEntity()};
|
|
newYielOp->erase();
|
|
return hlfir::loadTrivialScalar(l, b, newAddr);
|
|
};
|
|
mlir::Type elementType = scalarAddress.getFortranElementType();
|
|
return hlfir::genElementalOp(loc, builder, elementType,
|
|
elementalAddrOp.getShape(), typeParams,
|
|
genKernel, !elementalAddrOp.isOrdered());
|
|
}
|
|
|
|
bool hlfir::elementalOpMustProduceTemp(hlfir::ElementalOp elemental) {
|
|
for (mlir::Operation *useOp : elemental->getUsers())
|
|
if (auto destroy = mlir::dyn_cast<hlfir::DestroyOp>(useOp))
|
|
if (destroy.mustFinalizeExpr())
|
|
return true;
|
|
|
|
return false;
|
|
}
|
|
|
|
std::pair<hlfir::Entity, mlir::Value>
|
|
hlfir::createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity mold) {
|
|
llvm::SmallVector<mlir::Value> lenParams;
|
|
hlfir::genLengthParameters(loc, builder, mold, lenParams);
|
|
llvm::StringRef tmpName{".tmp"};
|
|
mlir::Value alloc;
|
|
mlir::Value isHeapAlloc;
|
|
mlir::Value shape{};
|
|
fir::FortranVariableFlagsAttr declAttrs;
|
|
|
|
if (mold.isPolymorphic()) {
|
|
// Create unallocated polymorphic temporary using the dynamic type
|
|
// of the mold. The static type of the temporary matches
|
|
// the static type of the mold, but then the dynamic type
|
|
// of the mold is applied to the temporary's descriptor.
|
|
|
|
if (mold.isArray())
|
|
hlfir::genShape(loc, builder, mold);
|
|
|
|
// Create polymorphic allocatable box on the stack.
|
|
mlir::Type boxHeapType = fir::HeapType::get(fir::unwrapRefType(
|
|
mlir::cast<fir::BaseBoxType>(mold.getType()).getEleTy()));
|
|
// The box must be initialized, because AllocatableApplyMold
|
|
// may read its contents (e.g. for checking whether it is allocated).
|
|
alloc = fir::factory::genNullBoxStorage(builder, loc,
|
|
fir::ClassType::get(boxHeapType));
|
|
// The temporary is unallocated even after AllocatableApplyMold below.
|
|
// If the temporary is used as assignment LHS it will be automatically
|
|
// allocated on the heap, as long as we use Assign family
|
|
// runtime functions. So set MustFree to true.
|
|
isHeapAlloc = builder.createBool(loc, true);
|
|
declAttrs = fir::FortranVariableFlagsAttr::get(
|
|
builder.getContext(), fir::FortranVariableFlagsEnum::allocatable);
|
|
} else if (mold.isArray()) {
|
|
mlir::Type sequenceType =
|
|
hlfir::getFortranElementOrSequenceType(mold.getType());
|
|
shape = hlfir::genShape(loc, builder, mold);
|
|
auto extents = hlfir::getIndexExtents(loc, builder, shape);
|
|
alloc = builder.createHeapTemporary(loc, sequenceType, tmpName, extents,
|
|
lenParams);
|
|
isHeapAlloc = builder.createBool(loc, true);
|
|
} else {
|
|
alloc = builder.createTemporary(loc, mold.getFortranElementType(), tmpName,
|
|
/*shape=*/std::nullopt, lenParams);
|
|
isHeapAlloc = builder.createBool(loc, false);
|
|
}
|
|
auto declareOp = builder.create<hlfir::DeclareOp>(loc, alloc, tmpName, shape,
|
|
lenParams, declAttrs);
|
|
if (mold.isPolymorphic()) {
|
|
int rank = mold.getRank();
|
|
// TODO: should probably read rank from the mold.
|
|
if (rank < 0)
|
|
TODO(loc, "create temporary for assumed rank polymorphic");
|
|
fir::runtime::genAllocatableApplyMold(builder, loc, alloc,
|
|
mold.getFirBase(), rank);
|
|
}
|
|
|
|
return {hlfir::Entity{declareOp.getBase()}, isHeapAlloc};
|
|
}
|
|
|
|
hlfir::EntityWithAttributes
|
|
hlfir::convertCharacterKind(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity scalarChar, int toKind) {
|
|
auto src = hlfir::convertToAddress(loc, builder, scalarChar,
|
|
scalarChar.getFortranElementType());
|
|
assert(src.first.getCharBox() && "must be scalar character");
|
|
fir::CharBoxValue res = fir::factory::convertCharacterKind(
|
|
builder, loc, *src.first.getCharBox(), toKind);
|
|
if (src.second.has_value())
|
|
src.second.value()();
|
|
|
|
return hlfir::EntityWithAttributes{builder.create<hlfir::DeclareOp>(
|
|
loc, res.getAddr(), ".temp.kindconvert", /*shape=*/nullptr,
|
|
/*typeparams=*/mlir::ValueRange{res.getLen()},
|
|
fir::FortranVariableFlagsAttr{})};
|
|
}
|
|
|
|
std::pair<hlfir::Entity, std::optional<hlfir::CleanupFunction>>
|
|
hlfir::genTypeAndKindConvert(mlir::Location loc, fir::FirOpBuilder &builder,
|
|
hlfir::Entity source, mlir::Type toType,
|
|
bool preserveLowerBounds) {
|
|
mlir::Type fromType = source.getFortranElementType();
|
|
toType = hlfir::getFortranElementType(toType);
|
|
if (!toType || fromType == toType ||
|
|
!(fir::isa_trivial(toType) || mlir::isa<fir::CharacterType>(toType)))
|
|
return {source, std::nullopt};
|
|
|
|
std::optional<int> toKindCharConvert;
|
|
if (auto toCharTy = mlir::dyn_cast<fir::CharacterType>(toType)) {
|
|
if (auto fromCharTy = mlir::dyn_cast<fir::CharacterType>(fromType))
|
|
if (toCharTy.getFKind() != fromCharTy.getFKind()) {
|
|
toKindCharConvert = toCharTy.getFKind();
|
|
// Preserve source length (padding/truncation will occur in assignment
|
|
// if needed).
|
|
toType = fir::CharacterType::get(
|
|
fromType.getContext(), toCharTy.getFKind(), fromCharTy.getLen());
|
|
}
|
|
// Do not convert in case of character length mismatch only, hlfir.assign
|
|
// deals with it.
|
|
if (!toKindCharConvert)
|
|
return {source, std::nullopt};
|
|
}
|
|
|
|
if (source.getRank() == 0) {
|
|
mlir::Value cast = toKindCharConvert
|
|
? mlir::Value{hlfir::convertCharacterKind(
|
|
loc, builder, source, *toKindCharConvert)}
|
|
: builder.convertWithSemantics(loc, toType, source);
|
|
return {hlfir::Entity{cast}, std::nullopt};
|
|
}
|
|
|
|
mlir::Value shape = hlfir::genShape(loc, builder, source);
|
|
auto genKernel = [source, toType, toKindCharConvert](
|
|
mlir::Location loc, fir::FirOpBuilder &builder,
|
|
mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
|
|
auto elementPtr =
|
|
hlfir::getElementAt(loc, builder, source, oneBasedIndices);
|
|
auto val = hlfir::loadTrivialScalar(loc, builder, elementPtr);
|
|
if (toKindCharConvert)
|
|
return hlfir::convertCharacterKind(loc, builder, val, *toKindCharConvert);
|
|
return hlfir::EntityWithAttributes{
|
|
builder.convertWithSemantics(loc, toType, val)};
|
|
};
|
|
llvm::SmallVector<mlir::Value, 1> lenParams;
|
|
hlfir::genLengthParameters(loc, builder, source, lenParams);
|
|
mlir::Value convertedRhs =
|
|
hlfir::genElementalOp(loc, builder, toType, shape, lenParams, genKernel,
|
|
/*isUnordered=*/true);
|
|
|
|
if (preserveLowerBounds && source.hasNonDefaultLowerBounds()) {
|
|
hlfir::AssociateOp associate =
|
|
genAssociateExpr(loc, builder, hlfir::Entity{convertedRhs},
|
|
convertedRhs.getType(), ".tmp.keeplbounds");
|
|
fir::ShapeOp shapeOp = associate.getShape().getDefiningOp<fir::ShapeOp>();
|
|
assert(shapeOp && "associate shape must be a fir.shape");
|
|
const unsigned rank = shapeOp.getExtents().size();
|
|
llvm::SmallVector<mlir::Value> lbAndExtents;
|
|
for (unsigned dim = 0; dim < rank; ++dim) {
|
|
lbAndExtents.push_back(hlfir::genLBound(loc, builder, source, dim));
|
|
lbAndExtents.push_back(shapeOp.getExtents()[dim]);
|
|
}
|
|
auto shapeShiftType = fir::ShapeShiftType::get(builder.getContext(), rank);
|
|
mlir::Value shapeShift =
|
|
builder.create<fir::ShapeShiftOp>(loc, shapeShiftType, lbAndExtents);
|
|
auto declareOp = builder.create<hlfir::DeclareOp>(
|
|
loc, associate.getFirBase(), *associate.getUniqName(), shapeShift,
|
|
associate.getTypeparams(), /*flags=*/fir::FortranVariableFlagsAttr{});
|
|
hlfir::Entity castWithLbounds =
|
|
mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());
|
|
fir::FirOpBuilder *bldr = &builder;
|
|
auto cleanup = [loc, bldr, convertedRhs, associate]() {
|
|
bldr->create<hlfir::EndAssociateOp>(loc, associate);
|
|
bldr->create<hlfir::DestroyOp>(loc, convertedRhs);
|
|
};
|
|
return {castWithLbounds, cleanup};
|
|
}
|
|
|
|
fir::FirOpBuilder *bldr = &builder;
|
|
auto cleanup = [loc, bldr, convertedRhs]() {
|
|
bldr->create<hlfir::DestroyOp>(loc, convertedRhs);
|
|
};
|
|
return {hlfir::Entity{convertedRhs}, cleanup};
|
|
}
|