1788 lines · cpp
1//===-- HLFIRTools.cpp ----------------------------------------------------===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8//9// Tools to manipulate HLFIR variable and expressions10//11//===----------------------------------------------------------------------===//12 13#include "flang/Optimizer/Builder/HLFIRTools.h"14#include "flang/Optimizer/Builder/Character.h"15#include "flang/Optimizer/Builder/FIRBuilder.h"16#include "flang/Optimizer/Builder/MutableBox.h"17#include "flang/Optimizer/Builder/Runtime/Allocatable.h"18#include "flang/Optimizer/Builder/Todo.h"19#include "flang/Optimizer/Dialect/FIRType.h"20#include "flang/Optimizer/HLFIR/HLFIROps.h"21#include "mlir/IR/IRMapping.h"22#include "mlir/Support/LLVM.h"23#include "llvm/ADT/TypeSwitch.h"24#include <mlir/Dialect/LLVMIR/LLVMAttrs.h>25#include <mlir/Dialect/OpenMP/OpenMPDialect.h>26#include <optional>27 28// Return explicit extents. If the base is a fir.box, this won't read it to29// return the extents and will instead return an empty vector.30llvm::SmallVector<mlir::Value>31hlfir::getExplicitExtentsFromShape(mlir::Value shape,32 fir::FirOpBuilder &builder) {33 llvm::SmallVector<mlir::Value> result;34 auto *shapeOp = shape.getDefiningOp();35 if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {36 auto e = s.getExtents();37 result.append(e.begin(), e.end());38 } else if (auto s = mlir::dyn_cast_or_null<fir::ShapeShiftOp>(shapeOp)) {39 auto e = s.getExtents();40 result.append(e.begin(), e.end());41 } else if (mlir::dyn_cast_or_null<fir::ShiftOp>(shapeOp)) {42 return {};43 } else if (auto s = mlir::dyn_cast_or_null<hlfir::ShapeOfOp>(shapeOp)) {44 hlfir::ExprType expr = mlir::cast<hlfir::ExprType>(s.getExpr().getType());45 llvm::ArrayRef<int64_t> exprShape = expr.getShape();46 mlir::Type indexTy = builder.getIndexType();47 fir::ShapeType shapeTy = mlir::cast<fir::ShapeType>(shape.getType());48 result.reserve(shapeTy.getRank());49 for (unsigned i = 0; i < shapeTy.getRank(); ++i) {50 int64_t extent = exprShape[i];51 mlir::Value extentVal;52 if (extent == expr.getUnknownExtent()) {53 auto op = hlfir::GetExtentOp::create(builder, shape.getLoc(), shape, i);54 extentVal = op.getResult();55 } else {56 extentVal =57 builder.createIntegerConstant(shape.getLoc(), indexTy, extent);58 }59 result.emplace_back(extentVal);60 }61 } else {62 TODO(shape.getLoc(), "read fir.shape to get extents");63 }64 return result;65}66static llvm::SmallVector<mlir::Value>67getExplicitExtents(fir::FortranVariableOpInterface var,68 fir::FirOpBuilder &builder) {69 if (mlir::Value shape = var.getShape())70 return hlfir::getExplicitExtentsFromShape(var.getShape(), builder);71 return {};72}73 74// Return explicit lower bounds from a shape result.75// Only fir.shape, fir.shift and fir.shape_shift are currently76// supported as shape.77static llvm::SmallVector<mlir::Value>78getExplicitLboundsFromShape(mlir::Value shape) {79 llvm::SmallVector<mlir::Value> result;80 auto *shapeOp = shape.getDefiningOp();81 if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {82 return {};83 } else if (auto s = mlir::dyn_cast_or_null<fir::ShapeShiftOp>(shapeOp)) {84 auto e = s.getOrigins();85 result.append(e.begin(), e.end());86 } else if (auto s = mlir::dyn_cast_or_null<fir::ShiftOp>(shapeOp)) {87 auto e = s.getOrigins();88 result.append(e.begin(), e.end());89 } else {90 TODO(shape.getLoc(), "read fir.shape to get lower bounds");91 }92 return result;93}94 95// Return explicit lower bounds. For pointers and allocatables, this will not96// read the lower bounds and instead return an empty vector.97static llvm::SmallVector<mlir::Value>98getExplicitLbounds(fir::FortranVariableOpInterface var) {99 if (mlir::Value shape = var.getShape())100 return getExplicitLboundsFromShape(shape);101 return {};102}103 104static llvm::SmallVector<mlir::Value>105getNonDefaultLowerBounds(mlir::Location loc, fir::FirOpBuilder &builder,106 hlfir::Entity entity) {107 assert(!entity.isAssumedRank() &&108 "cannot compute assumed rank bounds statically");109 if (!entity.mayHaveNonDefaultLowerBounds())110 return {};111 if (auto varIface = entity.getIfVariableInterface()) {112 llvm::SmallVector<mlir::Value> lbounds = getExplicitLbounds(varIface);113 if (!lbounds.empty())114 return lbounds;115 }116 if (entity.isMutableBox())117 entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);118 llvm::SmallVector<mlir::Value> lowerBounds;119 fir::factory::genDimInfoFromBox(builder, loc, entity, &lowerBounds,120 /*extents=*/nullptr, /*strides=*/nullptr);121 return lowerBounds;122}123 124static llvm::SmallVector<mlir::Value> toSmallVector(mlir::ValueRange range) {125 llvm::SmallVector<mlir::Value> res;126 res.append(range.begin(), range.end());127 return res;128}129 130static llvm::SmallVector<mlir::Value> getExplicitTypeParams(hlfir::Entity var) {131 if (auto varIface = var.getMaybeDereferencedVariableInterface())132 return toSmallVector(varIface.getExplicitTypeParams());133 return {};134}135 136static mlir::Value tryGettingNonDeferredCharLen(hlfir::Entity var) {137 if (auto varIface = var.getMaybeDereferencedVariableInterface())138 if (!varIface.getExplicitTypeParams().empty())139 return varIface.getExplicitTypeParams()[0];140 return mlir::Value{};141}142 143static mlir::Value genCharacterVariableLength(mlir::Location loc,144 fir::FirOpBuilder &builder,145 hlfir::Entity var) {146 if (mlir::Value len = tryGettingNonDeferredCharLen(var))147 return len;148 auto charType = mlir::cast<fir::CharacterType>(var.getFortranElementType());149 if (charType.hasConstantLen())150 return builder.createIntegerConstant(loc, builder.getIndexType(),151 charType.getLen());152 if (var.isMutableBox())153 var = hlfir::Entity{fir::LoadOp::create(builder, loc, var)};154 mlir::Value len = fir::factory::CharacterExprHelper{builder, loc}.getLength(155 var.getFirBase());156 assert(len && "failed to retrieve length");157 return len;158}159 160static fir::CharBoxValue genUnboxChar(mlir::Location loc,161 fir::FirOpBuilder &builder,162 mlir::Value boxChar) {163 if (auto emboxChar = boxChar.getDefiningOp<fir::EmboxCharOp>())164 return {emboxChar.getMemref(), emboxChar.getLen()};165 mlir::Type refType = fir::ReferenceType::get(166 mlir::cast<fir::BoxCharType>(boxChar.getType()).getEleTy());167 auto unboxed = fir::UnboxCharOp::create(builder, loc, refType,168 builder.getIndexType(), boxChar);169 mlir::Value addr = unboxed.getResult(0);170 mlir::Value len = unboxed.getResult(1);171 if (auto varIface = boxChar.getDefiningOp<fir::FortranVariableOpInterface>())172 if (mlir::Value explicitlen = varIface.getExplicitCharLen())173 len = explicitlen;174 return {addr, len};175}176 177// To maximize chances of identifying usage of a same variables in the IR,178// always return the hlfirBase result of declare/associate if it is a raw179// pointer.180static mlir::Value getFirBaseHelper(mlir::Value hlfirBase,181 mlir::Value firBase) {182 if (fir::isa_ref_type(hlfirBase.getType()))183 return hlfirBase;184 return firBase;185}186 187mlir::Value hlfir::Entity::getFirBase() const {188 if (fir::FortranVariableOpInterface variable = getIfVariableInterface()) {189 if (auto declareOp =190 mlir::dyn_cast<hlfir::DeclareOp>(variable.getOperation()))191 return getFirBaseHelper(declareOp.getBase(), declareOp.getOriginalBase());192 if (auto associateOp =193 mlir::dyn_cast<hlfir::AssociateOp>(variable.getOperation()))194 return getFirBaseHelper(associateOp.getBase(), associateOp.getFirBase());195 }196 return getBase();197}198 199static bool isShapeWithLowerBounds(mlir::Value shape) {200 if (!shape)201 return false;202 auto shapeTy = shape.getType();203 return mlir::isa<fir::ShiftType>(shapeTy) ||204 mlir::isa<fir::ShapeShiftType>(shapeTy);205}206 207bool hlfir::Entity::mayHaveNonDefaultLowerBounds() const {208 if (!isBoxAddressOrValue() || isScalar())209 return false;210 if (isMutableBox())211 return true;212 if (auto varIface = getIfVariableInterface())213 return isShapeWithLowerBounds(varIface.getShape());214 // Go through chain of fir.box converts.215 if (auto convert = getDefiningOp<fir::ConvertOp>()) {216 return hlfir::Entity{convert.getValue()}.mayHaveNonDefaultLowerBounds();217 } else if (auto rebox = getDefiningOp<fir::ReboxOp>()) {218 // If slicing is involved, then the resulting box has219 // default lower bounds. If there is no slicing,220 // then the result depends on the shape operand221 // (whether it has non default lower bounds or not).222 return !rebox.getSlice() && isShapeWithLowerBounds(rebox.getShape());223 } else if (auto embox = getDefiningOp<fir::EmboxOp>()) {224 return !embox.getSlice() && isShapeWithLowerBounds(embox.getShape());225 }226 return true;227}228 229mlir::Operation *traverseConverts(mlir::Operation *op) {230 while (auto convert = llvm::dyn_cast_or_null<fir::ConvertOp>(op))231 op = convert.getValue().getDefiningOp();232 return op;233}234 235bool hlfir::Entity::mayBeOptional() const {236 if (!isVariable())237 return false;238 // TODO: introduce a fir type to better identify optionals.239 if (mlir::Operation *op = traverseConverts(getDefiningOp())) {240 if (auto varIface = llvm::dyn_cast<fir::FortranVariableOpInterface>(op))241 return varIface.isOptional();242 return !llvm::isa<fir::AllocaOp, fir::AllocMemOp, fir::ReboxOp,243 fir::EmboxOp, fir::LoadOp>(op);244 }245 return true;246}247 248fir::FortranVariableOpInterface249hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,250 const fir::ExtendedValue &exv, llvm::StringRef name,251 fir::FortranVariableFlagsAttr flags, mlir::Value dummyScope,252 mlir::Value storage, std::uint64_t storageOffset,253 cuf::DataAttributeAttr dataAttr, unsigned dummyArgNo) {254 255 mlir::Value base = fir::getBase(exv);256 assert(fir::conformsWithPassByRef(base.getType()) &&257 "entity being declared must be in memory");258 mlir::Value shapeOrShift;259 llvm::SmallVector<mlir::Value> lenParams;260 exv.match(261 [&](const fir::CharBoxValue &box) {262 lenParams.emplace_back(box.getLen());263 },264 [&](const fir::ArrayBoxValue &) {265 shapeOrShift = builder.createShape(loc, exv);266 },267 [&](const fir::CharArrayBoxValue &box) {268 shapeOrShift = builder.createShape(loc, exv);269 lenParams.emplace_back(box.getLen());270 },271 [&](const fir::BoxValue &box) {272 if (!box.getLBounds().empty())273 shapeOrShift = builder.createShape(loc, exv);274 lenParams.append(box.getExplicitParameters().begin(),275 box.getExplicitParameters().end());276 },277 [&](const fir::MutableBoxValue &box) {278 lenParams.append(box.nonDeferredLenParams().begin(),279 box.nonDeferredLenParams().end());280 },281 [](const auto &) {});282 auto declareOp = hlfir::DeclareOp::create(283 builder, loc, base, name, shapeOrShift, lenParams, dummyScope, storage,284 storageOffset, flags, dataAttr, dummyArgNo);285 return mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());286}287 288hlfir::AssociateOp289hlfir::genAssociateExpr(mlir::Location loc, fir::FirOpBuilder &builder,290 hlfir::Entity value, mlir::Type variableType,291 llvm::StringRef name,292 std::optional<mlir::NamedAttribute> attr) {293 assert(value.isValue() && "must not be a variable");294 mlir::Value shape{};295 if (value.isArray())296 shape = genShape(loc, builder, value);297 298 mlir::Value source = value;299 // Lowered scalar expression values for numerical and logical may have a300 // different type than what is required for the type in memory (logical301 // expressions are typically manipulated as i1, but needs to be stored302 // according to the fir.logical<kind> so that the storage size is correct).303 // Character length mismatches are ignored (it is ok for one to be dynamic304 // and the other static).305 mlir::Type varEleTy = getFortranElementType(variableType);306 mlir::Type valueEleTy = getFortranElementType(value.getType());307 if (varEleTy != valueEleTy && !(mlir::isa<fir::CharacterType>(valueEleTy) &&308 mlir::isa<fir::CharacterType>(varEleTy))) {309 assert(value.isScalar() && fir::isa_trivial(value.getType()));310 source = builder.createConvert(loc, fir::unwrapPassByRefType(variableType),311 value);312 }313 llvm::SmallVector<mlir::Value> lenParams;314 genLengthParameters(loc, builder, value, lenParams);315 if (attr) {316 assert(name.empty() && "It attribute is provided, no-name is expected");317 return hlfir::AssociateOp::create(builder, loc, source, shape, lenParams,318 fir::FortranVariableFlagsAttr{},319 llvm::ArrayRef{*attr});320 }321 return hlfir::AssociateOp::create(builder, loc, source, name, shape,322 lenParams, fir::FortranVariableFlagsAttr{});323}324 325mlir::Value hlfir::genVariableRawAddress(mlir::Location loc,326 fir::FirOpBuilder &builder,327 hlfir::Entity var) {328 assert(var.isVariable() && "only address of variables can be taken");329 mlir::Value baseAddr = var.getFirBase();330 if (var.isMutableBox())331 baseAddr = fir::LoadOp::create(builder, loc, baseAddr);332 // Get raw address.333 if (mlir::isa<fir::BoxCharType>(var.getType()))334 baseAddr = genUnboxChar(loc, builder, var.getBase()).getAddr();335 if (mlir::isa<fir::BaseBoxType>(baseAddr.getType()))336 baseAddr = fir::BoxAddrOp::create(builder, loc, baseAddr);337 return baseAddr;338}339 340mlir::Value hlfir::genVariableBoxChar(mlir::Location loc,341 fir::FirOpBuilder &builder,342 hlfir::Entity var) {343 assert(var.isVariable() && "only address of variables can be taken");344 if (mlir::isa<fir::BoxCharType>(var.getType()))345 return var;346 mlir::Value addr = genVariableRawAddress(loc, builder, var);347 llvm::SmallVector<mlir::Value> lengths;348 genLengthParameters(loc, builder, var, lengths);349 assert(lengths.size() == 1);350 auto charType = mlir::cast<fir::CharacterType>(var.getFortranElementType());351 auto boxCharType =352 fir::BoxCharType::get(builder.getContext(), charType.getFKind());353 auto scalarAddr =354 builder.createConvert(loc, fir::ReferenceType::get(charType), addr);355 return fir::EmboxCharOp::create(builder, loc, boxCharType, scalarAddr,356 lengths[0]);357}358 359static hlfir::Entity changeBoxAttributes(mlir::Location loc,360 fir::FirOpBuilder &builder,361 hlfir::Entity var,362 fir::BaseBoxType forceBoxType) {363 assert(llvm::isa<fir::BaseBoxType>(var.getType()) && "expect box type");364 // Propagate lower bounds.365 mlir::Value shift;366 llvm::SmallVector<mlir::Value> lbounds =367 getNonDefaultLowerBounds(loc, builder, var);368 if (!lbounds.empty())369 shift = builder.genShift(loc, lbounds);370 auto rebox = fir::ReboxOp::create(builder, loc, forceBoxType, var, shift,371 /*slice=*/nullptr);372 return hlfir::Entity{rebox};373}374 375hlfir::Entity hlfir::genVariableBox(mlir::Location loc,376 fir::FirOpBuilder &builder,377 hlfir::Entity var,378 fir::BaseBoxType forceBoxType) {379 assert(var.isVariable() && "must be a variable");380 var = hlfir::derefPointersAndAllocatables(loc, builder, var);381 if (mlir::isa<fir::BaseBoxType>(var.getType())) {382 if (!forceBoxType || forceBoxType == var.getType())383 return var;384 return changeBoxAttributes(loc, builder, var, forceBoxType);385 }386 // Note: if the var is not a fir.box/fir.class at that point, it has default387 // lower bounds and is not polymorphic.388 mlir::Value shape =389 var.isArray() ? hlfir::genShape(loc, builder, var) : mlir::Value{};390 llvm::SmallVector<mlir::Value> typeParams;391 mlir::Type elementType =392 forceBoxType ? fir::getFortranElementType(forceBoxType.getEleTy())393 : var.getFortranElementType();394 auto maybeCharType = mlir::dyn_cast<fir::CharacterType>(elementType);395 if (!maybeCharType || maybeCharType.hasDynamicLen())396 hlfir::genLengthParameters(loc, builder, var, typeParams);397 mlir::Value addr = var.getBase();398 if (mlir::isa<fir::BoxCharType>(var.getType()))399 addr = genVariableRawAddress(loc, builder, var);400 const bool isVolatile = fir::isa_volatile_type(var.getType());401 mlir::Type boxType =402 fir::BoxType::get(var.getElementOrSequenceType(), isVolatile);403 if (forceBoxType) {404 boxType = forceBoxType;405 mlir::Type baseType = fir::ReferenceType::get(406 fir::unwrapRefType(forceBoxType.getEleTy()), forceBoxType.isVolatile());407 addr = builder.createConvertWithVolatileCast(loc, baseType, addr);408 }409 auto embox = fir::EmboxOp::create(builder, loc, boxType, addr, shape,410 /*slice=*/mlir::Value{}, typeParams);411 return hlfir::Entity{embox.getResult()};412}413 414hlfir::Entity hlfir::loadTrivialScalar(mlir::Location loc,415 fir::FirOpBuilder &builder,416 Entity entity) {417 entity = derefPointersAndAllocatables(loc, builder, entity);418 if (entity.isVariable() && entity.isScalar() &&419 fir::isa_trivial(entity.getFortranElementType())) {420 // Optional entities may be represented with !fir.box<i32/f32/...>.421 // We need to take the data pointer before loading the scalar.422 mlir::Value base = genVariableRawAddress(loc, builder, entity);423 return Entity{fir::LoadOp::create(builder, loc, base)};424 }425 return entity;426}427 428hlfir::Entity hlfir::getElementAt(mlir::Location loc,429 fir::FirOpBuilder &builder, Entity entity,430 mlir::ValueRange oneBasedIndices) {431 if (entity.isScalar())432 return entity;433 llvm::SmallVector<mlir::Value> lenParams;434 genLengthParameters(loc, builder, entity, lenParams);435 if (mlir::isa<hlfir::ExprType>(entity.getType()))436 return hlfir::Entity{hlfir::ApplyOp::create(builder, loc, entity,437 oneBasedIndices, lenParams)};438 // Build hlfir.designate. The lower bounds may need to be added to439 // the oneBasedIndices since hlfir.designate expect indices440 // based on the array operand lower bounds.441 mlir::Type resultType = hlfir::getVariableElementType(entity);442 hlfir::DesignateOp designate;443 llvm::SmallVector<mlir::Value> lbounds =444 getNonDefaultLowerBounds(loc, builder, entity);445 if (!lbounds.empty()) {446 llvm::SmallVector<mlir::Value> indices;447 mlir::Type idxTy = builder.getIndexType();448 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);449 for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, lbounds)) {450 auto lbIdx = builder.createConvert(loc, idxTy, lb);451 auto oneBasedIdx = builder.createConvert(loc, idxTy, oneBased);452 auto shift = mlir::arith::SubIOp::create(builder, loc, lbIdx, one);453 mlir::Value index =454 mlir::arith::AddIOp::create(builder, loc, oneBasedIdx, shift);455 indices.push_back(index);456 }457 designate = hlfir::DesignateOp::create(builder, loc, resultType, entity,458 indices, lenParams);459 } else {460 designate = hlfir::DesignateOp::create(builder, loc, resultType, entity,461 oneBasedIndices, lenParams);462 }463 return mlir::cast<fir::FortranVariableOpInterface>(designate.getOperation());464}465 466static mlir::Value genUBound(mlir::Location loc, fir::FirOpBuilder &builder,467 mlir::Value lb, mlir::Value extent,468 mlir::Value one) {469 if (auto constantLb = fir::getIntIfConstant(lb))470 if (*constantLb == 1)471 return extent;472 extent = builder.createConvert(loc, one.getType(), extent);473 lb = builder.createConvert(loc, one.getType(), lb);474 auto add = mlir::arith::AddIOp::create(builder, loc, lb, extent);475 return mlir::arith::SubIOp::create(builder, loc, add, one);476}477 478llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>479hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,480 Entity entity) {481 if (mlir::isa<hlfir::ExprType>(entity.getType()))482 TODO(loc, "bounds of expressions in hlfir");483 auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);484 assert(!cleanup && "translation of entity should not yield cleanup");485 if (const auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>())486 exv = fir::factory::genMutableBoxRead(builder, loc, *mutableBox);487 mlir::Type idxTy = builder.getIndexType();488 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);489 llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> result;490 for (unsigned dim = 0; dim < exv.rank(); ++dim) {491 mlir::Value extent = fir::factory::readExtent(builder, loc, exv, dim);492 mlir::Value lb = fir::factory::readLowerBound(builder, loc, exv, dim, one);493 mlir::Value ub = genUBound(loc, builder, lb, extent, one);494 result.push_back({lb, ub});495 }496 return result;497}498 499llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>500hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,501 mlir::Value shape) {502 assert((mlir::isa<fir::ShapeShiftType>(shape.getType()) ||503 mlir::isa<fir::ShapeType>(shape.getType())) &&504 "shape must contain extents");505 auto extents = hlfir::getExplicitExtentsFromShape(shape, builder);506 auto lowers = getExplicitLboundsFromShape(shape);507 assert(lowers.empty() || lowers.size() == extents.size());508 mlir::Type idxTy = builder.getIndexType();509 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);510 llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> result;511 for (auto extent : llvm::enumerate(extents)) {512 mlir::Value lb = lowers.empty() ? one : lowers[extent.index()];513 mlir::Value ub = lowers.empty()514 ? extent.value()515 : genUBound(loc, builder, lb, extent.value(), one);516 result.push_back({lb, ub});517 }518 return result;519}520 521llvm::SmallVector<mlir::Value> hlfir::genLowerbounds(mlir::Location loc,522 fir::FirOpBuilder &builder,523 mlir::Value shape,524 unsigned rank) {525 llvm::SmallVector<mlir::Value> lbounds;526 if (shape)527 lbounds = getExplicitLboundsFromShape(shape);528 if (!lbounds.empty())529 return lbounds;530 mlir::Value one =531 builder.createIntegerConstant(loc, builder.getIndexType(), 1);532 return llvm::SmallVector<mlir::Value>(rank, one);533}534 535static hlfir::Entity followShapeInducingSource(hlfir::Entity entity) {536 while (true) {537 if (auto reassoc = entity.getDefiningOp<hlfir::NoReassocOp>()) {538 entity = hlfir::Entity{reassoc.getVal()};539 continue;540 }541 if (auto asExpr = entity.getDefiningOp<hlfir::AsExprOp>()) {542 entity = hlfir::Entity{asExpr.getVar()};543 continue;544 }545 break;546 }547 return entity;548}549 550static mlir::Value computeVariableExtent(mlir::Location loc,551 fir::FirOpBuilder &builder,552 hlfir::Entity variable,553 fir::SequenceType seqTy,554 unsigned dim) {555 mlir::Type idxTy = builder.getIndexType();556 if (seqTy.getShape().size() > dim) {557 fir::SequenceType::Extent typeExtent = seqTy.getShape()[dim];558 if (typeExtent != fir::SequenceType::getUnknownExtent())559 return builder.createIntegerConstant(loc, idxTy, typeExtent);560 }561 assert(mlir::isa<fir::BaseBoxType>(variable.getType()) &&562 "array variable with dynamic extent must be boxed");563 mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim);564 auto dimInfo = fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy,565 variable, dimVal);566 return dimInfo.getExtent();567}568llvm::SmallVector<mlir::Value> getVariableExtents(mlir::Location loc,569 fir::FirOpBuilder &builder,570 hlfir::Entity variable) {571 llvm::SmallVector<mlir::Value> extents;572 if (fir::FortranVariableOpInterface varIface =573 variable.getIfVariableInterface()) {574 extents = getExplicitExtents(varIface, builder);575 if (!extents.empty())576 return extents;577 }578 579 if (variable.isMutableBox())580 variable = hlfir::derefPointersAndAllocatables(loc, builder, variable);581 // Use the type shape information, and/or the fir.box/fir.class shape582 // information if any extents are not static.583 fir::SequenceType seqTy = mlir::cast<fir::SequenceType>(584 hlfir::getFortranElementOrSequenceType(variable.getType()));585 unsigned rank = seqTy.getShape().size();586 for (unsigned dim = 0; dim < rank; ++dim)587 extents.push_back(588 computeVariableExtent(loc, builder, variable, seqTy, dim));589 return extents;590}591 592static mlir::Value tryRetrievingShapeOrShift(hlfir::Entity entity) {593 if (mlir::isa<hlfir::ExprType>(entity.getType())) {594 if (auto elemental = entity.getDefiningOp<hlfir::ElementalOp>())595 return elemental.getShape();596 if (auto evalInMem = entity.getDefiningOp<hlfir::EvaluateInMemoryOp>())597 return evalInMem.getShape();598 return mlir::Value{};599 }600 if (auto varIface = entity.getIfVariableInterface())601 return varIface.getShape();602 return {};603}604 605mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder,606 hlfir::Entity entity) {607 assert(entity.isArray() && "entity must be an array");608 entity = followShapeInducingSource(entity);609 assert(entity && "what?");610 if (auto shape = tryRetrievingShapeOrShift(entity)) {611 if (mlir::isa<fir::ShapeType>(shape.getType()))612 return shape;613 if (mlir::isa<fir::ShapeShiftType>(shape.getType()))614 if (auto s = shape.getDefiningOp<fir::ShapeShiftOp>())615 return fir::ShapeOp::create(builder, loc, s.getExtents());616 }617 if (mlir::isa<hlfir::ExprType>(entity.getType()))618 return hlfir::ShapeOfOp::create(builder, loc, entity.getBase());619 // There is no shape lying around for this entity. Retrieve the extents and620 // build a new fir.shape.621 return fir::ShapeOp::create(builder, loc,622 getVariableExtents(loc, builder, entity));623}624 625llvm::SmallVector<mlir::Value>626hlfir::getIndexExtents(mlir::Location loc, fir::FirOpBuilder &builder,627 mlir::Value shape) {628 llvm::SmallVector<mlir::Value> extents =629 hlfir::getExplicitExtentsFromShape(shape, builder);630 mlir::Type indexType = builder.getIndexType();631 for (auto &extent : extents)632 extent = builder.createConvert(loc, indexType, extent);633 return extents;634}635 636mlir::Value hlfir::genExtent(mlir::Location loc, fir::FirOpBuilder &builder,637 hlfir::Entity entity, unsigned dim) {638 entity = followShapeInducingSource(entity);639 if (auto shape = tryRetrievingShapeOrShift(entity)) {640 auto extents = hlfir::getExplicitExtentsFromShape(shape, builder);641 if (!extents.empty()) {642 assert(extents.size() > dim && "bad inquiry");643 return extents[dim];644 }645 }646 if (entity.isVariable()) {647 if (entity.isMutableBox())648 entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);649 // Use the type shape information, and/or the fir.box/fir.class shape650 // information if any extents are not static.651 fir::SequenceType seqTy = mlir::cast<fir::SequenceType>(652 hlfir::getFortranElementOrSequenceType(entity.getType()));653 return computeVariableExtent(loc, builder, entity, seqTy, dim);654 }655 TODO(loc, "get extent from HLFIR expr without producer holding the shape");656}657 658mlir::Value hlfir::genLBound(mlir::Location loc, fir::FirOpBuilder &builder,659 hlfir::Entity entity, unsigned dim) {660 if (!entity.mayHaveNonDefaultLowerBounds())661 return builder.createIntegerConstant(loc, builder.getIndexType(), 1);662 if (auto shape = tryRetrievingShapeOrShift(entity)) {663 auto lbounds = getExplicitLboundsFromShape(shape);664 if (!lbounds.empty()) {665 assert(lbounds.size() > dim && "bad inquiry");666 return lbounds[dim];667 }668 }669 if (entity.isMutableBox())670 entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);671 assert(mlir::isa<fir::BaseBoxType>(entity.getType()) && "must be a box");672 mlir::Type idxTy = builder.getIndexType();673 mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim);674 auto dimInfo =675 fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy, entity, dimVal);676 return dimInfo.getLowerBound();677}678 679static bool680getExprLengthParameters(mlir::Value expr,681 llvm::SmallVectorImpl<mlir::Value> &result) {682 if (auto concat = expr.getDefiningOp<hlfir::ConcatOp>()) {683 result.push_back(concat.getLength());684 return true;685 }686 if (auto setLen = expr.getDefiningOp<hlfir::SetLengthOp>()) {687 result.push_back(setLen.getLength());688 return true;689 }690 if (auto elemental = expr.getDefiningOp<hlfir::ElementalOp>()) {691 result.append(elemental.getTypeparams().begin(),692 elemental.getTypeparams().end());693 return true;694 }695 if (auto evalInMem = expr.getDefiningOp<hlfir::EvaluateInMemoryOp>()) {696 result.append(evalInMem.getTypeparams().begin(),697 evalInMem.getTypeparams().end());698 return true;699 }700 if (auto apply = expr.getDefiningOp<hlfir::ApplyOp>()) {701 result.append(apply.getTypeparams().begin(), apply.getTypeparams().end());702 return true;703 }704 return false;705}706 707void hlfir::genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,708 Entity entity,709 llvm::SmallVectorImpl<mlir::Value> &result) {710 if (!entity.hasLengthParameters())711 return;712 if (mlir::isa<hlfir::ExprType>(entity.getType())) {713 mlir::Value expr = entity;714 if (auto reassoc = expr.getDefiningOp<hlfir::NoReassocOp>())715 expr = reassoc.getVal();716 // Going through fir::ExtendedValue would create a temp,717 // which is not desired for an inquiry.718 // TODO: make this an interface when adding further character producing ops.719 720 if (auto asExpr = expr.getDefiningOp<hlfir::AsExprOp>()) {721 hlfir::genLengthParameters(loc, builder, hlfir::Entity{asExpr.getVar()},722 result);723 return;724 }725 if (getExprLengthParameters(expr, result))726 return;727 if (entity.isCharacter()) {728 result.push_back(hlfir::GetLengthOp::create(builder, loc, expr));729 return;730 }731 TODO(loc, "inquire PDTs length parameters of hlfir.expr");732 }733 734 if (entity.isCharacter()) {735 result.push_back(genCharacterVariableLength(loc, builder, entity));736 return;737 }738 TODO(loc, "inquire PDTs length parameters in HLFIR");739}740 741mlir::Value hlfir::genCharLength(mlir::Location loc, fir::FirOpBuilder &builder,742 hlfir::Entity entity) {743 llvm::SmallVector<mlir::Value, 1> lenParams;744 genLengthParameters(loc, builder, entity, lenParams);745 assert(lenParams.size() == 1 && "characters must have one length parameters");746 return lenParams[0];747}748 749std::optional<std::int64_t> hlfir::getCharLengthIfConst(hlfir::Entity entity) {750 if (!entity.isCharacter()) {751 return std::nullopt;752 }753 if (mlir::isa<hlfir::ExprType>(entity.getType())) {754 mlir::Value expr = entity;755 if (auto reassoc = expr.getDefiningOp<hlfir::NoReassocOp>())756 expr = reassoc.getVal();757 758 if (auto asExpr = expr.getDefiningOp<hlfir::AsExprOp>())759 return getCharLengthIfConst(hlfir::Entity{asExpr.getVar()});760 761 llvm::SmallVector<mlir::Value> param;762 if (getExprLengthParameters(expr, param)) {763 assert(param.size() == 1 && "characters must have one length parameters");764 return fir::getIntIfConstant(param.pop_back_val());765 }766 return std::nullopt;767 }768 769 // entity is a var770 if (mlir::Value len = tryGettingNonDeferredCharLen(entity))771 return fir::getIntIfConstant(len);772 auto charType =773 mlir::cast<fir::CharacterType>(entity.getFortranElementType());774 if (charType.hasConstantLen())775 return charType.getLen();776 return std::nullopt;777}778 779mlir::Value hlfir::genRank(mlir::Location loc, fir::FirOpBuilder &builder,780 hlfir::Entity entity, mlir::Type resultType) {781 if (!entity.isAssumedRank())782 return builder.createIntegerConstant(loc, resultType, entity.getRank());783 assert(entity.isBoxAddressOrValue() &&784 "assumed-ranks are box addresses or values");785 return fir::BoxRankOp::create(builder, loc, resultType, entity);786}787 788// Return a "shape" that can be used in fir.embox/fir.rebox with \p exv base.789static mlir::Value asEmboxShape(mlir::Location loc, fir::FirOpBuilder &builder,790 const fir::ExtendedValue &exv,791 mlir::Value shape) {792 if (!shape)793 return shape;794 // fir.rebox does not need and does not accept extents (fir.shape or795 // fir.shape_shift) since this information is already in the input fir.box,796 // it only accepts fir.shift because local lower bounds may not be reflected797 // in the fir.box.798 if (mlir::isa<fir::BaseBoxType>(fir::getBase(exv).getType()) &&799 !mlir::isa<fir::ShiftType>(shape.getType()))800 return builder.createShape(loc, exv);801 return shape;802}803 804std::pair<mlir::Value, mlir::Value> hlfir::genVariableFirBaseShapeAndParams(805 mlir::Location loc, fir::FirOpBuilder &builder, Entity entity,806 llvm::SmallVectorImpl<mlir::Value> &typeParams) {807 auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);808 assert(!cleanup && "variable to Exv should not produce cleanup");809 if (entity.hasLengthParameters()) {810 auto params = fir::getTypeParams(exv);811 typeParams.append(params.begin(), params.end());812 }813 if (entity.isScalar())814 return {fir::getBase(exv), mlir::Value{}};815 816 // Contiguous variables that are represented with a box817 // may require the shape to be extracted from the box (i.e. evx),818 // because they itself may not have shape specified.819 // This happens during late propagationg of contiguous820 // attribute, e.g.:821 // %9:2 = hlfir.declare %6822 // {fortran_attrs = #fir.var_attrs<contiguous>} :823 // (!fir.box<!fir.array<?x?x...>>) ->824 // (!fir.box<!fir.array<?x?x...>>, !fir.box<!fir.array<?x?x...>>)825 // The extended value is an ArrayBoxValue with base being826 // the raw address of the array.827 if (auto variableInterface = entity.getIfVariableInterface()) {828 mlir::Value shape = variableInterface.getShape();829 if (mlir::isa<fir::BaseBoxType>(fir::getBase(exv).getType()) ||830 !mlir::isa<fir::BaseBoxType>(entity.getType()) ||831 // Still use the variable's shape if it is present.832 // If it only specifies a shift, then we have to create833 // a shape from the exv.834 (shape && (shape.getDefiningOp<fir::ShapeShiftOp>() ||835 shape.getDefiningOp<fir::ShapeOp>())))836 return {fir::getBase(exv),837 asEmboxShape(loc, builder, exv, variableInterface.getShape())};838 }839 return {fir::getBase(exv), builder.createShape(loc, exv)};840}841 842hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,843 fir::FirOpBuilder &builder,844 Entity entity) {845 if (entity.isMutableBox()) {846 hlfir::Entity boxLoad{fir::LoadOp::create(builder, loc, entity)};847 if (entity.isScalar()) {848 if (!entity.isPolymorphic() && !entity.hasLengthParameters())849 return hlfir::Entity{fir::BoxAddrOp::create(builder, loc, boxLoad)};850 mlir::Type elementType = boxLoad.getFortranElementType();851 if (auto charType = mlir::dyn_cast<fir::CharacterType>(elementType)) {852 mlir::Value base = fir::BoxAddrOp::create(builder, loc, boxLoad);853 if (charType.hasConstantLen())854 return hlfir::Entity{base};855 mlir::Value len = genCharacterVariableLength(loc, builder, entity);856 auto boxCharType =857 fir::BoxCharType::get(builder.getContext(), charType.getFKind());858 return hlfir::Entity{859 fir::EmboxCharOp::create(builder, loc, boxCharType, base, len)860 .getResult()};861 }862 }863 // Otherwise, the entity is either an array, a polymorphic entity, or a864 // derived type with length parameters. All these entities require a fir.box865 // or fir.class to hold bounds, dynamic type or length parameter866 // information. Keep them boxed.867 return boxLoad;868 } else if (entity.isProcedurePointer()) {869 return hlfir::Entity{fir::LoadOp::create(builder, loc, entity)};870 }871 return entity;872}873 874mlir::Type hlfir::getVariableElementType(hlfir::Entity variable) {875 assert(variable.isVariable() && "entity must be a variable");876 if (variable.isScalar())877 return variable.getType();878 mlir::Type eleTy = variable.getFortranElementType();879 const bool isVolatile = fir::isa_volatile_type(variable.getType());880 if (variable.isPolymorphic())881 return fir::ClassType::get(eleTy, isVolatile);882 if (auto charType = mlir::dyn_cast<fir::CharacterType>(eleTy)) {883 if (charType.hasDynamicLen())884 return fir::BoxCharType::get(charType.getContext(), charType.getFKind());885 } else if (fir::isRecordWithTypeParameters(eleTy)) {886 return fir::BoxType::get(eleTy, isVolatile);887 }888 return fir::ReferenceType::get(eleTy, isVolatile);889}890 891mlir::Type hlfir::getEntityElementType(hlfir::Entity entity) {892 if (entity.isVariable())893 return getVariableElementType(entity);894 if (entity.isScalar())895 return entity.getType();896 auto exprType = mlir::dyn_cast<hlfir::ExprType>(entity.getType());897 assert(exprType && "array value must be an hlfir.expr");898 return exprType.getElementExprType();899}900 901static hlfir::ExprType getArrayExprType(mlir::Type elementType,902 mlir::Value shape, bool isPolymorphic) {903 unsigned rank = mlir::cast<fir::ShapeType>(shape.getType()).getRank();904 hlfir::ExprType::Shape typeShape(rank, hlfir::ExprType::getUnknownExtent());905 if (auto shapeOp = shape.getDefiningOp<fir::ShapeOp>())906 for (auto extent : llvm::enumerate(shapeOp.getExtents()))907 if (auto cstExtent = fir::getIntIfConstant(extent.value()))908 typeShape[extent.index()] = *cstExtent;909 return hlfir::ExprType::get(elementType.getContext(), typeShape, elementType,910 isPolymorphic);911}912 913hlfir::ElementalOp hlfir::genElementalOp(914 mlir::Location loc, fir::FirOpBuilder &builder, mlir::Type elementType,915 mlir::Value shape, mlir::ValueRange typeParams,916 const ElementalKernelGenerator &genKernel, bool isUnordered,917 mlir::Value polymorphicMold, mlir::Type exprType) {918 if (!exprType)919 exprType = getArrayExprType(elementType, shape, !!polymorphicMold);920 auto elementalOp = hlfir::ElementalOp::create(921 builder, loc, exprType, shape, polymorphicMold, typeParams, isUnordered);922 auto insertPt = builder.saveInsertionPoint();923 builder.setInsertionPointToStart(elementalOp.getBody());924 mlir::Value elementResult = genKernel(loc, builder, elementalOp.getIndices());925 // Numerical and logical scalars may be lowered to another type than the926 // Fortran expression type (e.g i1 instead of fir.logical). Array expression927 // values are typed according to their Fortran type. Insert a cast if needed928 // here.929 if (fir::isa_trivial(elementResult.getType()))930 elementResult = builder.createConvert(loc, elementType, elementResult);931 hlfir::YieldElementOp::create(builder, loc, elementResult);932 builder.restoreInsertionPoint(insertPt);933 return elementalOp;934}935 936// TODO: we do not actually need to clone the YieldElementOp,937// because returning its getElementValue() operand should be enough938// for all callers of this function.939hlfir::YieldElementOp940hlfir::inlineElementalOp(mlir::Location loc, fir::FirOpBuilder &builder,941 hlfir::ElementalOp elemental,942 mlir::ValueRange oneBasedIndices) {943 // hlfir.elemental region is a SizedRegion<1>.944 assert(elemental.getRegion().hasOneBlock() &&945 "expect elemental region to have one block");946 mlir::IRMapping mapper;947 mapper.map(elemental.getIndices(), oneBasedIndices);948 mlir::Operation *newOp;949 for (auto &op : elemental.getRegion().back().getOperations())950 newOp = builder.clone(op, mapper);951 auto yield = mlir::dyn_cast_or_null<hlfir::YieldElementOp>(newOp);952 assert(yield && "last ElementalOp operation must be am hlfir.yield_element");953 return yield;954}955 956mlir::Value hlfir::inlineElementalOp(957 mlir::Location loc, fir::FirOpBuilder &builder,958 hlfir::ElementalOpInterface elemental, mlir::ValueRange oneBasedIndices,959 mlir::IRMapping &mapper,960 const std::function<bool(hlfir::ElementalOp)> &mustRecursivelyInline) {961 mlir::Region ®ion = elemental.getElementalRegion();962 // hlfir.elemental region is a SizedRegion<1>.963 assert(region.hasOneBlock() && "elemental region must have one block");964 mapper.map(elemental.getIndices(), oneBasedIndices);965 for (auto &op : region.front().without_terminator()) {966 if (auto apply = mlir::dyn_cast<hlfir::ApplyOp>(op))967 if (auto appliedElemental =968 apply.getExpr().getDefiningOp<hlfir::ElementalOp>())969 if (mustRecursivelyInline(appliedElemental)) {970 llvm::SmallVector<mlir::Value> clonedApplyIndices;971 for (auto indice : apply.getIndices())972 clonedApplyIndices.push_back(mapper.lookupOrDefault(indice));973 hlfir::ElementalOpInterface elementalIface =974 mlir::cast<hlfir::ElementalOpInterface>(975 appliedElemental.getOperation());976 mlir::Value inlined = inlineElementalOp(loc, builder, elementalIface,977 clonedApplyIndices, mapper,978 mustRecursivelyInline);979 mapper.map(apply.getResult(), inlined);980 continue;981 }982 (void)builder.clone(op, mapper);983 }984 return mapper.lookupOrDefault(elemental.getElementEntity());985}986 987hlfir::LoopNest hlfir::genLoopNest(mlir::Location loc,988 fir::FirOpBuilder &builder,989 mlir::ValueRange extents, bool isUnordered,990 bool emitWorkshareLoop,991 bool couldVectorize) {992 emitWorkshareLoop = emitWorkshareLoop && isUnordered;993 hlfir::LoopNest loopNest;994 assert(!extents.empty() && "must have at least one extent");995 mlir::OpBuilder::InsertionGuard guard(builder);996 loopNest.oneBasedIndices.assign(extents.size(), mlir::Value{});997 // Build loop nest from column to row.998 auto one = mlir::arith::ConstantIndexOp::create(builder, loc, 1);999 mlir::Type indexType = builder.getIndexType();1000 if (emitWorkshareLoop) {1001 auto wslw = mlir::omp::WorkshareLoopWrapperOp::create(builder, loc);1002 loopNest.outerOp = wslw;1003 builder.createBlock(&wslw.getRegion());1004 mlir::omp::LoopNestOperands lnops;1005 lnops.loopInclusive = builder.getUnitAttr();1006 for (auto extent : llvm::reverse(extents)) {1007 lnops.loopLowerBounds.push_back(one);1008 lnops.loopUpperBounds.push_back(extent);1009 lnops.loopSteps.push_back(one);1010 }1011 auto lnOp = mlir::omp::LoopNestOp::create(builder, loc, lnops);1012 mlir::Block *block = builder.createBlock(&lnOp.getRegion());1013 for (auto extent : llvm::reverse(extents))1014 block->addArgument(extent.getType(), extent.getLoc());1015 loopNest.body = block;1016 mlir::omp::YieldOp::create(builder, loc);1017 for (unsigned dim = 0; dim < extents.size(); dim++)1018 loopNest.oneBasedIndices[extents.size() - dim - 1] =1019 lnOp.getRegion().front().getArgument(dim);1020 } else {1021 unsigned dim = extents.size() - 1;1022 for (auto extent : llvm::reverse(extents)) {1023 auto ub = builder.createConvert(loc, indexType, extent);1024 auto doLoop =1025 fir::DoLoopOp::create(builder, loc, one, ub, one, isUnordered);1026 if (!couldVectorize) {1027 mlir::LLVM::LoopVectorizeAttr va{mlir::LLVM::LoopVectorizeAttr::get(1028 builder.getContext(),1029 /*disable=*/builder.getBoolAttr(true), {}, {}, {}, {}, {}, {})};1030 mlir::LLVM::LoopAnnotationAttr la = mlir::LLVM::LoopAnnotationAttr::get(1031 builder.getContext(), {}, /*vectorize=*/va, {}, /*unroll*/ {},1032 /*unroll_and_jam*/ {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {});1033 doLoop.setLoopAnnotationAttr(la);1034 }1035 loopNest.body = doLoop.getBody();1036 builder.setInsertionPointToStart(loopNest.body);1037 // Reverse the indices so they are in column-major order.1038 loopNest.oneBasedIndices[dim--] = doLoop.getInductionVar();1039 if (!loopNest.outerOp)1040 loopNest.outerOp = doLoop;1041 }1042 }1043 return loopNest;1044}1045 1046llvm::SmallVector<mlir::Value> hlfir::genLoopNestWithReductions(1047 mlir::Location loc, fir::FirOpBuilder &builder, mlir::ValueRange extents,1048 mlir::ValueRange reductionInits, const ReductionLoopBodyGenerator &genBody,1049 bool isUnordered) {1050 assert(!extents.empty() && "must have at least one extent");1051 // Build loop nest from column to row.1052 auto one = mlir::arith::ConstantIndexOp::create(builder, loc, 1);1053 mlir::Type indexType = builder.getIndexType();1054 unsigned dim = extents.size() - 1;1055 fir::DoLoopOp outerLoop = nullptr;1056 fir::DoLoopOp parentLoop = nullptr;1057 llvm::SmallVector<mlir::Value> oneBasedIndices;1058 oneBasedIndices.resize(dim + 1);1059 for (auto extent : llvm::reverse(extents)) {1060 auto ub = builder.createConvert(loc, indexType, extent);1061 1062 // The outermost loop takes reductionInits as the initial1063 // values of its iter-args.1064 // A child loop takes its iter-args from the region iter-args1065 // of its parent loop.1066 fir::DoLoopOp doLoop;1067 if (!parentLoop) {1068 doLoop = fir::DoLoopOp::create(builder, loc, one, ub, one, isUnordered,1069 /*finalCountValue=*/false, reductionInits);1070 } else {1071 doLoop = fir::DoLoopOp::create(builder, loc, one, ub, one, isUnordered,1072 /*finalCountValue=*/false,1073 parentLoop.getRegionIterArgs());1074 if (!reductionInits.empty()) {1075 // Return the results of the child loop from its parent loop.1076 fir::ResultOp::create(builder, loc, doLoop.getResults());1077 }1078 }1079 1080 builder.setInsertionPointToStart(doLoop.getBody());1081 // Reverse the indices so they are in column-major order.1082 oneBasedIndices[dim--] = doLoop.getInductionVar();1083 if (!outerLoop)1084 outerLoop = doLoop;1085 parentLoop = doLoop;1086 }1087 1088 llvm::SmallVector<mlir::Value> reductionValues;1089 reductionValues =1090 genBody(loc, builder, oneBasedIndices, parentLoop.getRegionIterArgs());1091 builder.setInsertionPointToEnd(parentLoop.getBody());1092 if (!reductionValues.empty())1093 fir::ResultOp::create(builder, loc, reductionValues);1094 builder.setInsertionPointAfter(outerLoop);1095 return outerLoop->getResults();1096}1097 1098template <typename Lambda>1099static fir::ExtendedValue1100conditionallyEvaluate(mlir::Location loc, fir::FirOpBuilder &builder,1101 mlir::Value condition, const Lambda &genIfTrue) {1102 mlir::OpBuilder::InsertPoint insertPt = builder.saveInsertionPoint();1103 1104 // Evaluate in some region that will be moved into the actual ifOp (the actual1105 // ifOp can only be created when the result types are known).1106 auto badIfOp = fir::IfOp::create(builder, loc, condition.getType(), condition,1107 /*withElseRegion=*/false);1108 mlir::Block *preparationBlock = &badIfOp.getThenRegion().front();1109 builder.setInsertionPointToStart(preparationBlock);1110 fir::ExtendedValue result = genIfTrue();1111 fir::ResultOp resultOp = result.match(1112 [&](const fir::CharBoxValue &box) -> fir::ResultOp {1113 return fir::ResultOp::create(1114 builder, loc, mlir::ValueRange{box.getAddr(), box.getLen()});1115 },1116 [&](const mlir::Value &addr) -> fir::ResultOp {1117 return fir::ResultOp::create(builder, loc, addr);1118 },1119 [&](const auto &) -> fir::ResultOp {1120 TODO(loc, "unboxing non scalar optional fir.box");1121 });1122 builder.restoreInsertionPoint(insertPt);1123 1124 // Create actual fir.if operation.1125 auto ifOp =1126 fir::IfOp::create(builder, loc, resultOp->getOperandTypes(), condition,1127 /*withElseRegion=*/true);1128 // Move evaluation into Then block,1129 preparationBlock->moveBefore(&ifOp.getThenRegion().back());1130 ifOp.getThenRegion().back().erase();1131 // Create absent result in the Else block.1132 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());1133 llvm::SmallVector<mlir::Value> absentValues;1134 for (mlir::Type resTy : ifOp->getResultTypes()) {1135 if (fir::isa_ref_type(resTy) || fir::isa_box_type(resTy))1136 absentValues.emplace_back(fir::AbsentOp::create(builder, loc, resTy));1137 else1138 absentValues.emplace_back(fir::ZeroOp::create(builder, loc, resTy));1139 }1140 fir::ResultOp::create(builder, loc, absentValues);1141 badIfOp->erase();1142 1143 // Build fir::ExtendedValue from the result values.1144 builder.setInsertionPointAfter(ifOp);1145 return result.match(1146 [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {1147 return fir::CharBoxValue{ifOp.getResult(0), ifOp.getResult(1)};1148 },1149 [&](const mlir::Value &) -> fir::ExtendedValue {1150 return ifOp.getResult(0);1151 },1152 [&](const auto &) -> fir::ExtendedValue {1153 TODO(loc, "unboxing non scalar optional fir.box");1154 });1155}1156 1157static fir::ExtendedValue translateVariableToExtendedValue(1158 mlir::Location loc, fir::FirOpBuilder &builder, hlfir::Entity variable,1159 bool forceHlfirBase = false, bool contiguousHint = false,1160 bool keepScalarOptionalBoxed = false) {1161 assert(variable.isVariable() && "must be a variable");1162 // When going towards FIR, use the original base value to avoid1163 // introducing descriptors at runtime when they are not required.1164 // This is not done for assumed-rank since the fir::ExtendedValue cannot1165 // held the related lower bounds in an vector. The lower bounds of the1166 // descriptor must always be used instead.1167 1168 mlir::Value base = (forceHlfirBase || variable.isAssumedRank())1169 ? variable.getBase()1170 : variable.getFirBase();1171 if (variable.isMutableBox())1172 return fir::MutableBoxValue(base, getExplicitTypeParams(variable),1173 fir::MutableProperties{});1174 1175 if (mlir::isa<fir::BaseBoxType>(base.getType())) {1176 const bool contiguous = variable.isSimplyContiguous() || contiguousHint;1177 const bool isAssumedRank = variable.isAssumedRank();1178 if (!contiguous || variable.isPolymorphic() ||1179 variable.isDerivedWithLengthParameters() || isAssumedRank) {1180 llvm::SmallVector<mlir::Value> nonDefaultLbounds;1181 if (!isAssumedRank)1182 nonDefaultLbounds = getNonDefaultLowerBounds(loc, builder, variable);1183 return fir::BoxValue(base, nonDefaultLbounds,1184 getExplicitTypeParams(variable));1185 }1186 if (variable.mayBeOptional()) {1187 if (!keepScalarOptionalBoxed && variable.isScalar()) {1188 mlir::Value isPresent = fir::IsPresentOp::create(1189 builder, loc, builder.getI1Type(), variable);1190 return conditionallyEvaluate(1191 loc, builder, isPresent, [&]() -> fir::ExtendedValue {1192 mlir::Value base = genVariableRawAddress(loc, builder, variable);1193 if (variable.isCharacter()) {1194 mlir::Value len =1195 genCharacterVariableLength(loc, builder, variable);1196 return fir::CharBoxValue{base, len};1197 }1198 return base;1199 });1200 }1201 llvm::SmallVector<mlir::Value> nonDefaultLbounds =1202 getNonDefaultLowerBounds(loc, builder, variable);1203 return fir::BoxValue(base, nonDefaultLbounds,1204 getExplicitTypeParams(variable));1205 }1206 // Otherwise, the variable can be represented in a fir::ExtendedValue1207 // without the overhead of a fir.box.1208 base = genVariableRawAddress(loc, builder, variable);1209 }1210 1211 if (variable.isScalar()) {1212 if (variable.isCharacter()) {1213 if (mlir::isa<fir::BoxCharType>(base.getType()))1214 return genUnboxChar(loc, builder, base);1215 mlir::Value len = genCharacterVariableLength(loc, builder, variable);1216 return fir::CharBoxValue{base, len};1217 }1218 return base;1219 }1220 llvm::SmallVector<mlir::Value> extents;1221 llvm::SmallVector<mlir::Value> nonDefaultLbounds;1222 if (mlir::isa<fir::BaseBoxType>(variable.getType()) &&1223 !variable.getIfVariableInterface() &&1224 variable.mayHaveNonDefaultLowerBounds()) {1225 // This special case avoids generating two sets of identical1226 // fir.box_dim to get both the lower bounds and extents.1227 fir::factory::genDimInfoFromBox(builder, loc, variable, &nonDefaultLbounds,1228 &extents, /*strides=*/nullptr);1229 } else {1230 extents = getVariableExtents(loc, builder, variable);1231 nonDefaultLbounds = getNonDefaultLowerBounds(loc, builder, variable);1232 }1233 if (variable.isCharacter())1234 return fir::CharArrayBoxValue{1235 base, genCharacterVariableLength(loc, builder, variable), extents,1236 nonDefaultLbounds};1237 return fir::ArrayBoxValue{base, extents, nonDefaultLbounds};1238}1239 1240fir::ExtendedValue1241hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,1242 fir::FortranVariableOpInterface var,1243 bool forceHlfirBase) {1244 return translateVariableToExtendedValue(loc, builder, var, forceHlfirBase);1245}1246 1247std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>1248hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,1249 hlfir::Entity entity, bool contiguousHint,1250 bool keepScalarOptionalBoxed) {1251 if (entity.isVariable())1252 return {translateVariableToExtendedValue(loc, builder, entity, false,1253 contiguousHint,1254 keepScalarOptionalBoxed),1255 std::nullopt};1256 1257 if (entity.isProcedure()) {1258 if (fir::isCharacterProcedureTuple(entity.getType())) {1259 auto [boxProc, len] = fir::factory::extractCharacterProcedureTuple(1260 builder, loc, entity, /*openBoxProc=*/false);1261 return {fir::CharBoxValue{boxProc, len}, std::nullopt};1262 }1263 return {static_cast<mlir::Value>(entity), std::nullopt};1264 }1265 1266 if (mlir::isa<hlfir::ExprType>(entity.getType())) {1267 mlir::NamedAttribute byRefAttr = fir::getAdaptToByRefAttr(builder);1268 hlfir::AssociateOp associate = hlfir::genAssociateExpr(1269 loc, builder, entity, entity.getType(), "", byRefAttr);1270 auto *bldr = &builder;1271 hlfir::CleanupFunction cleanup = [bldr, loc, associate]() -> void {1272 hlfir::EndAssociateOp::create(*bldr, loc, associate);1273 };1274 hlfir::Entity temp{associate.getBase()};1275 return {translateToExtendedValue(loc, builder, temp).first, cleanup};1276 }1277 return {{static_cast<mlir::Value>(entity)}, {}};1278}1279 1280std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>1281hlfir::convertToValue(mlir::Location loc, fir::FirOpBuilder &builder,1282 hlfir::Entity entity) {1283 // Load scalar references to integer, logical, real, or complex value1284 // to an mlir value, dereference allocatable and pointers, and get rid1285 // of fir.box that are not needed or create a copy into contiguous memory.1286 auto derefedAndLoadedEntity = loadTrivialScalar(loc, builder, entity);1287 return translateToExtendedValue(loc, builder, derefedAndLoadedEntity);1288}1289 1290static fir::ExtendedValue placeTrivialInMemory(mlir::Location loc,1291 fir::FirOpBuilder &builder,1292 mlir::Value val,1293 mlir::Type targetType) {1294 auto temp = builder.createTemporary(loc, targetType);1295 if (targetType != val.getType())1296 builder.createStoreWithConvert(loc, val, temp);1297 else1298 fir::StoreOp::create(builder, loc, val, temp);1299 return temp;1300}1301 1302std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>1303hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,1304 hlfir::Entity entity, mlir::Type targetType) {1305 // fir::factory::createBoxValue is not meant to deal with procedures.1306 // Dereference procedure pointers here.1307 if (entity.isProcedurePointer())1308 entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);1309 1310 auto [exv, cleanup] =1311 translateToExtendedValue(loc, builder, entity, /*contiguousHint=*/false,1312 /*keepScalarOptionalBoxed=*/true);1313 // Procedure entities should not go through createBoxValue that embox1314 // object entities. Return the fir.boxproc directly.1315 if (entity.isProcedure())1316 return {exv, cleanup};1317 mlir::Value base = fir::getBase(exv);1318 if (fir::isa_trivial(base.getType()))1319 exv = placeTrivialInMemory(loc, builder, base, targetType);1320 fir::BoxValue box = fir::factory::createBoxValue(builder, loc, exv);1321 return {box, cleanup};1322}1323 1324std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>1325hlfir::convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder,1326 hlfir::Entity entity, mlir::Type targetType) {1327 hlfir::Entity derefedEntity =1328 hlfir::derefPointersAndAllocatables(loc, builder, entity);1329 auto [exv, cleanup] =1330 hlfir::translateToExtendedValue(loc, builder, derefedEntity);1331 mlir::Value base = fir::getBase(exv);1332 if (fir::isa_trivial(base.getType()))1333 exv = placeTrivialInMemory(loc, builder, base, targetType);1334 return {exv, cleanup};1335}1336 1337/// Clone:1338/// ```1339/// hlfir.elemental_addr %shape : !fir.shape<1> {1340/// ^bb0(%i : index)1341/// .....1342/// %hlfir.yield %scalarAddress : fir.ref<T>1343/// }1344/// ```1345//1346/// into1347///1348/// ```1349/// %expr = hlfir.elemental %shape : (!fir.shape<1>) -> hlfir.expr<?xT> {1350/// ^bb0(%i : index)1351/// .....1352/// %value = fir.load %scalarAddress : fir.ref<T>1353/// %hlfir.yield_element %value : T1354/// }1355/// ```1356hlfir::ElementalOp1357hlfir::cloneToElementalOp(mlir::Location loc, fir::FirOpBuilder &builder,1358 hlfir::ElementalAddrOp elementalAddrOp) {1359 hlfir::Entity scalarAddress =1360 hlfir::Entity{mlir::cast<hlfir::YieldOp>(1361 elementalAddrOp.getBody().back().getTerminator())1362 .getEntity()};1363 llvm::SmallVector<mlir::Value, 1> typeParams;1364 hlfir::genLengthParameters(loc, builder, scalarAddress, typeParams);1365 1366 builder.setInsertionPointAfter(elementalAddrOp);1367 auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b,1368 mlir::ValueRange oneBasedIndices) -> hlfir::Entity {1369 mlir::IRMapping mapper;1370 mapper.map(elementalAddrOp.getIndices(), oneBasedIndices);1371 mlir::Operation *newOp = nullptr;1372 for (auto &op : elementalAddrOp.getBody().back().getOperations())1373 newOp = b.clone(op, mapper);1374 auto newYielOp = mlir::dyn_cast_or_null<hlfir::YieldOp>(newOp);1375 assert(newYielOp && "hlfir.elemental_addr is ill formed");1376 hlfir::Entity newAddr{newYielOp.getEntity()};1377 newYielOp->erase();1378 return hlfir::loadTrivialScalar(l, b, newAddr);1379 };1380 mlir::Type elementType = scalarAddress.getFortranElementType();1381 return hlfir::genElementalOp(1382 loc, builder, elementType, elementalAddrOp.getShape(), typeParams,1383 genKernel, !elementalAddrOp.isOrdered(), elementalAddrOp.getMold());1384}1385 1386bool hlfir::elementalOpMustProduceTemp(hlfir::ElementalOp elemental) {1387 for (mlir::Operation *useOp : elemental->getUsers())1388 if (auto destroy = mlir::dyn_cast<hlfir::DestroyOp>(useOp))1389 if (destroy.mustFinalizeExpr())1390 return true;1391 1392 return false;1393}1394 1395static void combineAndStoreElement(1396 mlir::Location loc, fir::FirOpBuilder &builder, hlfir::Entity lhs,1397 hlfir::Entity rhs, bool temporaryLHS,1398 std::function<hlfir::Entity(mlir::Location, fir::FirOpBuilder &,1399 hlfir::Entity, hlfir::Entity)> *combiner) {1400 hlfir::Entity valueToAssign = hlfir::loadTrivialScalar(loc, builder, rhs);1401 if (combiner) {1402 hlfir::Entity lhsValue = hlfir::loadTrivialScalar(loc, builder, lhs);1403 valueToAssign = (*combiner)(loc, builder, lhsValue, valueToAssign);1404 }1405 hlfir::AssignOp::create(builder, loc, valueToAssign, lhs,1406 /*realloc=*/false,1407 /*keep_lhs_length_if_realloc=*/false,1408 /*temporary_lhs=*/temporaryLHS);1409}1410 1411void hlfir::genNoAliasArrayAssignment(1412 mlir::Location loc, fir::FirOpBuilder &builder, hlfir::Entity rhs,1413 hlfir::Entity lhs, bool emitWorkshareLoop, bool temporaryLHS,1414 std::function<hlfir::Entity(mlir::Location, fir::FirOpBuilder &,1415 hlfir::Entity, hlfir::Entity)> *combiner) {1416 mlir::OpBuilder::InsertionGuard guard(builder);1417 rhs = hlfir::derefPointersAndAllocatables(loc, builder, rhs);1418 lhs = hlfir::derefPointersAndAllocatables(loc, builder, lhs);1419 mlir::Value lhsShape = hlfir::genShape(loc, builder, lhs);1420 llvm::SmallVector<mlir::Value> lhsExtents =1421 hlfir::getIndexExtents(loc, builder, lhsShape);1422 mlir::Value rhsShape = hlfir::genShape(loc, builder, rhs);1423 llvm::SmallVector<mlir::Value> rhsExtents =1424 hlfir::getIndexExtents(loc, builder, rhsShape);1425 llvm::SmallVector<mlir::Value> extents =1426 fir::factory::deduceOptimalExtents(lhsExtents, rhsExtents);1427 hlfir::LoopNest loopNest =1428 hlfir::genLoopNest(loc, builder, extents,1429 /*isUnordered=*/true, emitWorkshareLoop);1430 builder.setInsertionPointToStart(loopNest.body);1431 auto rhsArrayElement =1432 hlfir::getElementAt(loc, builder, rhs, loopNest.oneBasedIndices);1433 rhsArrayElement = hlfir::loadTrivialScalar(loc, builder, rhsArrayElement);1434 auto lhsArrayElement =1435 hlfir::getElementAt(loc, builder, lhs, loopNest.oneBasedIndices);1436 combineAndStoreElement(loc, builder, lhsArrayElement, rhsArrayElement,1437 temporaryLHS, combiner);1438}1439 1440void hlfir::genNoAliasAssignment(1441 mlir::Location loc, fir::FirOpBuilder &builder, hlfir::Entity rhs,1442 hlfir::Entity lhs, bool emitWorkshareLoop, bool temporaryLHS,1443 std::function<hlfir::Entity(mlir::Location, fir::FirOpBuilder &,1444 hlfir::Entity, hlfir::Entity)> *combiner) {1445 if (lhs.isArray()) {1446 genNoAliasArrayAssignment(loc, builder, rhs, lhs, emitWorkshareLoop,1447 temporaryLHS, combiner);1448 return;1449 }1450 rhs = hlfir::derefPointersAndAllocatables(loc, builder, rhs);1451 lhs = hlfir::derefPointersAndAllocatables(loc, builder, lhs);1452 combineAndStoreElement(loc, builder, lhs, rhs, temporaryLHS, combiner);1453}1454 1455std::pair<hlfir::Entity, bool>1456hlfir::createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,1457 hlfir::Entity mold) {1458 assert(!mold.isAssumedRank() &&1459 "cannot create temporary from assumed-rank mold");1460 llvm::SmallVector<mlir::Value> lenParams;1461 hlfir::genLengthParameters(loc, builder, mold, lenParams);1462 llvm::StringRef tmpName{".tmp"};1463 1464 mlir::Value shape{};1465 llvm::SmallVector<mlir::Value> extents;1466 if (mold.isArray()) {1467 shape = hlfir::genShape(loc, builder, mold);1468 extents = hlfir::getExplicitExtentsFromShape(shape, builder);1469 }1470 1471 bool useStack = !mold.isArray() && !mold.isPolymorphic();1472 auto genTempDeclareOp =1473 [](fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value memref,1474 llvm::StringRef name, mlir::Value shape,1475 llvm::ArrayRef<mlir::Value> typeParams,1476 fir::FortranVariableFlagsAttr attrs) -> mlir::Value {1477 auto declareOp =1478 hlfir::DeclareOp::create(builder, loc, memref, name, shape, typeParams,1479 /*dummy_scope=*/nullptr, /*storage=*/nullptr,1480 /*storage_offset=*/0, attrs);1481 return declareOp.getBase();1482 };1483 1484 auto [base, isHeapAlloc] = builder.createAndDeclareTemp(1485 loc, mold.getElementOrSequenceType(), shape, extents, lenParams,1486 genTempDeclareOp, mold.isPolymorphic() ? mold.getBase() : nullptr,1487 useStack, tmpName);1488 return {hlfir::Entity{base}, isHeapAlloc};1489}1490 1491hlfir::Entity hlfir::createStackTempFromMold(mlir::Location loc,1492 fir::FirOpBuilder &builder,1493 hlfir::Entity mold) {1494 llvm::SmallVector<mlir::Value> lenParams;1495 hlfir::genLengthParameters(loc, builder, mold, lenParams);1496 llvm::StringRef tmpName{".tmp"};1497 mlir::Value alloc;1498 mlir::Value shape{};1499 fir::FortranVariableFlagsAttr declAttrs;1500 1501 if (mold.isPolymorphic()) {1502 // genAllocatableApplyMold does heap allocation1503 TODO(loc, "createStackTempFromMold for polymorphic type");1504 } else if (mold.isArray()) {1505 mlir::Type sequenceType =1506 hlfir::getFortranElementOrSequenceType(mold.getType());1507 shape = hlfir::genShape(loc, builder, mold);1508 auto extents = hlfir::getIndexExtents(loc, builder, shape);1509 alloc =1510 builder.createTemporary(loc, sequenceType, tmpName, extents, lenParams);1511 } else {1512 alloc = builder.createTemporary(loc, mold.getFortranElementType(), tmpName,1513 /*shape=*/{}, lenParams);1514 }1515 auto declareOp =1516 hlfir::DeclareOp::create(builder, loc, alloc, tmpName, shape, lenParams,1517 /*dummy_scope=*/nullptr, /*storage=*/nullptr,1518 /*storage_offset=*/0, declAttrs);1519 return hlfir::Entity{declareOp.getBase()};1520}1521 1522hlfir::EntityWithAttributes1523hlfir::convertCharacterKind(mlir::Location loc, fir::FirOpBuilder &builder,1524 hlfir::Entity scalarChar, int toKind) {1525 auto src = hlfir::convertToAddress(loc, builder, scalarChar,1526 scalarChar.getFortranElementType());1527 assert(src.first.getCharBox() && "must be scalar character");1528 fir::CharBoxValue res = fir::factory::convertCharacterKind(1529 builder, loc, *src.first.getCharBox(), toKind);1530 if (src.second.has_value())1531 src.second.value()();1532 1533 return hlfir::EntityWithAttributes{hlfir::DeclareOp::create(1534 builder, loc, res.getAddr(), ".temp.kindconvert", /*shape=*/nullptr,1535 /*typeparams=*/mlir::ValueRange{res.getLen()})};1536}1537 1538std::pair<hlfir::Entity, std::optional<hlfir::CleanupFunction>>1539hlfir::genTypeAndKindConvert(mlir::Location loc, fir::FirOpBuilder &builder,1540 hlfir::Entity source, mlir::Type toType,1541 bool preserveLowerBounds) {1542 mlir::Type fromType = source.getFortranElementType();1543 toType = hlfir::getFortranElementType(toType);1544 if (!toType || fromType == toType ||1545 !(fir::isa_trivial(toType) || mlir::isa<fir::CharacterType>(toType)))1546 return {source, std::nullopt};1547 1548 std::optional<int> toKindCharConvert;1549 if (auto toCharTy = mlir::dyn_cast<fir::CharacterType>(toType)) {1550 if (auto fromCharTy = mlir::dyn_cast<fir::CharacterType>(fromType))1551 if (toCharTy.getFKind() != fromCharTy.getFKind()) {1552 toKindCharConvert = toCharTy.getFKind();1553 // Preserve source length (padding/truncation will occur in assignment1554 // if needed).1555 toType = fir::CharacterType::get(1556 fromType.getContext(), toCharTy.getFKind(), fromCharTy.getLen());1557 }1558 // Do not convert in case of character length mismatch only, hlfir.assign1559 // deals with it.1560 if (!toKindCharConvert)1561 return {source, std::nullopt};1562 }1563 1564 if (source.getRank() == 0) {1565 mlir::Value cast = toKindCharConvert1566 ? mlir::Value{hlfir::convertCharacterKind(1567 loc, builder, source, *toKindCharConvert)}1568 : builder.convertWithSemantics(loc, toType, source);1569 return {hlfir::Entity{cast}, std::nullopt};1570 }1571 1572 mlir::Value shape = hlfir::genShape(loc, builder, source);1573 auto genKernel = [source, toType, toKindCharConvert](1574 mlir::Location loc, fir::FirOpBuilder &builder,1575 mlir::ValueRange oneBasedIndices) -> hlfir::Entity {1576 auto elementPtr =1577 hlfir::getElementAt(loc, builder, source, oneBasedIndices);1578 auto val = hlfir::loadTrivialScalar(loc, builder, elementPtr);1579 if (toKindCharConvert)1580 return hlfir::convertCharacterKind(loc, builder, val, *toKindCharConvert);1581 return hlfir::EntityWithAttributes{1582 builder.convertWithSemantics(loc, toType, val)};1583 };1584 llvm::SmallVector<mlir::Value, 1> lenParams;1585 hlfir::genLengthParameters(loc, builder, source, lenParams);1586 mlir::Value convertedRhs =1587 hlfir::genElementalOp(loc, builder, toType, shape, lenParams, genKernel,1588 /*isUnordered=*/true);1589 1590 if (preserveLowerBounds && source.mayHaveNonDefaultLowerBounds()) {1591 hlfir::AssociateOp associate =1592 genAssociateExpr(loc, builder, hlfir::Entity{convertedRhs},1593 convertedRhs.getType(), ".tmp.keeplbounds");1594 fir::ShapeOp shapeOp = associate.getShape().getDefiningOp<fir::ShapeOp>();1595 assert(shapeOp && "associate shape must be a fir.shape");1596 const unsigned rank = shapeOp.getExtents().size();1597 llvm::SmallVector<mlir::Value> lbAndExtents;1598 for (unsigned dim = 0; dim < rank; ++dim) {1599 lbAndExtents.push_back(hlfir::genLBound(loc, builder, source, dim));1600 lbAndExtents.push_back(shapeOp.getExtents()[dim]);1601 }1602 auto shapeShiftType = fir::ShapeShiftType::get(builder.getContext(), rank);1603 mlir::Value shapeShift =1604 fir::ShapeShiftOp::create(builder, loc, shapeShiftType, lbAndExtents);1605 auto declareOp = hlfir::DeclareOp::create(1606 builder, loc, associate.getFirBase(), *associate.getUniqName(),1607 shapeShift, associate.getTypeparams());1608 hlfir::Entity castWithLbounds =1609 mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());1610 fir::FirOpBuilder *bldr = &builder;1611 auto cleanup = [loc, bldr, convertedRhs, associate]() {1612 hlfir::EndAssociateOp::create(*bldr, loc, associate);1613 hlfir::DestroyOp::create(*bldr, loc, convertedRhs);1614 };1615 return {castWithLbounds, cleanup};1616 }1617 1618 fir::FirOpBuilder *bldr = &builder;1619 auto cleanup = [loc, bldr, convertedRhs]() {1620 hlfir::DestroyOp::create(*bldr, loc, convertedRhs);1621 };1622 return {hlfir::Entity{convertedRhs}, cleanup};1623}1624 1625std::pair<hlfir::Entity, bool> hlfir::computeEvaluateOpInNewTemp(1626 mlir::Location loc, fir::FirOpBuilder &builder,1627 hlfir::EvaluateInMemoryOp evalInMem, mlir::Value shape,1628 mlir::ValueRange typeParams) {1629 llvm::StringRef tmpName{".tmp.expr_result"};1630 llvm::SmallVector<mlir::Value> extents =1631 hlfir::getIndexExtents(loc, builder, shape);1632 mlir::Type baseType =1633 hlfir::getFortranElementOrSequenceType(evalInMem.getType());1634 bool heapAllocated = fir::hasDynamicSize(baseType);1635 // Note: temporaries are stack allocated here when possible (do not require1636 // stack save/restore) because flang has always stack allocated function1637 // results.1638 mlir::Value temp = heapAllocated1639 ? builder.createHeapTemporary(loc, baseType, tmpName,1640 extents, typeParams)1641 : builder.createTemporary(loc, baseType, tmpName,1642 extents, typeParams);1643 mlir::Value innerMemory = evalInMem.getMemory();1644 temp = builder.createConvert(loc, innerMemory.getType(), temp);1645 auto declareOp =1646 hlfir::DeclareOp::create(builder, loc, temp, tmpName, shape, typeParams);1647 computeEvaluateOpIn(loc, builder, evalInMem, declareOp.getOriginalBase());1648 return {hlfir::Entity{declareOp.getBase()}, /*heapAllocated=*/heapAllocated};1649}1650 1651void hlfir::computeEvaluateOpIn(mlir::Location loc, fir::FirOpBuilder &builder,1652 hlfir::EvaluateInMemoryOp evalInMem,1653 mlir::Value storage) {1654 mlir::Value innerMemory = evalInMem.getMemory();1655 mlir::Value storageCast =1656 builder.createConvert(loc, innerMemory.getType(), storage);1657 mlir::IRMapping mapper;1658 mapper.map(innerMemory, storageCast);1659 for (auto &op : evalInMem.getBody().front().without_terminator())1660 builder.clone(op, mapper);1661 return;1662}1663 1664hlfir::Entity hlfir::loadElementAt(mlir::Location loc,1665 fir::FirOpBuilder &builder,1666 hlfir::Entity entity,1667 mlir::ValueRange oneBasedIndices) {1668 return loadTrivialScalar(loc, builder,1669 getElementAt(loc, builder, entity, oneBasedIndices));1670}1671 1672llvm::SmallVector<mlir::Value, Fortran::common::maxRank>1673hlfir::genExtentsVector(mlir::Location loc, fir::FirOpBuilder &builder,1674 hlfir::Entity entity) {1675 entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);1676 mlir::Value shape = hlfir::genShape(loc, builder, entity);1677 llvm::SmallVector<mlir::Value, Fortran::common::maxRank> extents =1678 hlfir::getExplicitExtentsFromShape(shape, builder);1679 if (shape.getUses().empty())1680 shape.getDefiningOp()->erase();1681 return extents;1682}1683 1684hlfir::Entity hlfir::gen1DSection(mlir::Location loc,1685 fir::FirOpBuilder &builder,1686 hlfir::Entity array, int64_t dim,1687 mlir::ArrayRef<mlir::Value> lbounds,1688 mlir::ArrayRef<mlir::Value> extents,1689 mlir::ValueRange oneBasedIndices,1690 mlir::ArrayRef<mlir::Value> typeParams) {1691 assert(array.isVariable() && "array must be a variable");1692 assert(dim > 0 && dim <= array.getRank() && "invalid dim number");1693 mlir::Value one =1694 builder.createIntegerConstant(loc, builder.getIndexType(), 1);1695 hlfir::DesignateOp::Subscripts subscripts;1696 unsigned indexId = 0;1697 for (int i = 0; i < array.getRank(); ++i) {1698 if (i == dim - 1) {1699 mlir::Value ubound = genUBound(loc, builder, lbounds[i], extents[i], one);1700 subscripts.emplace_back(1701 hlfir::DesignateOp::Triplet{lbounds[i], ubound, one});1702 } else {1703 mlir::Value index =1704 genUBound(loc, builder, lbounds[i], oneBasedIndices[indexId++], one);1705 subscripts.emplace_back(index);1706 }1707 }1708 mlir::Value sectionShape =1709 fir::ShapeOp::create(builder, loc, extents[dim - 1]);1710 1711 // The result type is one of:1712 // !fir.box/class<!fir.array<NxT>>1713 // !fir.box/class<!fir.array<?xT>>1714 //1715 // We could use !fir.ref<!fir.array<NxT>> when the whole dimension's1716 // size is known and it is the leading dimension, but let it be simple1717 // for the time being.1718 auto seqType =1719 mlir::cast<fir::SequenceType>(array.getElementOrSequenceType());1720 int64_t dimExtent = seqType.getShape()[dim - 1];1721 mlir::Type sectionType =1722 fir::SequenceType::get({dimExtent}, seqType.getEleTy());1723 sectionType = fir::wrapInClassOrBoxType(sectionType, array.isPolymorphic());1724 1725 auto designate = hlfir::DesignateOp::create(1726 builder, loc, sectionType, array, /*component=*/"",1727 /*componentShape=*/nullptr, subscripts,1728 /*substring=*/mlir::ValueRange{}, /*complexPartAttr=*/std::nullopt,1729 sectionShape, typeParams);1730 return hlfir::Entity{designate.getResult()};1731}1732 1733bool hlfir::designatePreservesContinuity(hlfir::DesignateOp op) {1734 if (op.getComponent() || op.getComplexPart() || !op.getSubstring().empty())1735 return false;1736 auto subscripts = op.getIndices();1737 unsigned i = 0;1738 for (auto isTriplet : llvm::enumerate(op.getIsTriplet())) {1739 // TODO: we should allow any number of leading triplets1740 // that describe a whole dimension slice, then one optional1741 // triplet describing potentially partial dimension slice,1742 // then any number of non-triplet subscripts.1743 // For the time being just allow a single leading1744 // triplet and then any number of non-triplet subscripts.1745 if (isTriplet.value()) {1746 if (isTriplet.index() != 0) {1747 return false;1748 } else {1749 i += 2;1750 mlir::Value step = subscripts[i++];1751 auto constantStep = fir::getIntIfConstant(step);1752 if (!constantStep || *constantStep != 1)1753 return false;1754 }1755 } else {1756 ++i;1757 }1758 }1759 return true;1760}1761 1762bool hlfir::isSimplyContiguous(mlir::Value base, bool checkWhole) {1763 hlfir::Entity entity{base};1764 if (entity.isSimplyContiguous())1765 return true;1766 1767 // Look at the definition.1768 mlir::Operation *def = base.getDefiningOp();1769 if (!def)1770 return false;1771 1772 return mlir::TypeSwitch<mlir::Operation *, bool>(def)1773 .Case<fir::EmboxOp>(1774 [&](auto op) { return fir::isContiguousEmbox(op, checkWhole); })1775 .Case<fir::ReboxOp>([&](auto op) {1776 hlfir::Entity box{op.getBox()};1777 return fir::reboxPreservesContinuity(1778 op, box.mayHaveNonDefaultLowerBounds(), checkWhole) &&1779 isSimplyContiguous(box, checkWhole);1780 })1781 .Case<fir::DeclareOp, hlfir::DeclareOp>([&](auto op) {1782 return isSimplyContiguous(op.getMemref(), checkWhole);1783 })1784 .Case<fir::ConvertOp>(1785 [&](auto op) { return isSimplyContiguous(op.getValue()); })1786 .Default([](auto &&) { return false; });1787}1788