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-exception
6//
7//===----------------------------------------------------------------------===//
8//
9// Tools to manipulate HLFIR variable and expressions
10//
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 to
29// 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 = builder.create<hlfir::GetExtentOp>(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 currently
76// 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 not
96// 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(in_start: range.begin(), in_end: 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{builder.create<fir::LoadOp>(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 = builder.create<fir::UnboxCharOp>(
168 loc, refType, 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 raw
179// 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 has
219 // default lower bounds. If there is no slicing,
220 // then the result depends on the shape operand
221 // (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::FortranVariableOpInterface
249hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
250 const fir::ExtendedValue &exv, llvm::StringRef name,
251 fir::FortranVariableFlagsAttr flags, mlir::Value dummyScope,
252 cuf::DataAttributeAttr dataAttr) {
253
254 mlir::Value base = fir::getBase(exv);
255 assert(fir::conformsWithPassByRef(base.getType()) &&
256 "entity being declared must be in memory");
257 mlir::Value shapeOrShift;
258 llvm::SmallVector<mlir::Value> lenParams;
259 exv.match(
260 [&](const fir::CharBoxValue &box) {
261 lenParams.emplace_back(box.getLen());
262 },
263 [&](const fir::ArrayBoxValue &) {
264 shapeOrShift = builder.createShape(loc, exv);
265 },
266 [&](const fir::CharArrayBoxValue &box) {
267 shapeOrShift = builder.createShape(loc, exv);
268 lenParams.emplace_back(box.getLen());
269 },
270 [&](const fir::BoxValue &box) {
271 if (!box.getLBounds().empty())
272 shapeOrShift = builder.createShape(loc, exv);
273 lenParams.append(box.getExplicitParameters().begin(),
274 box.getExplicitParameters().end());
275 },
276 [&](const fir::MutableBoxValue &box) {
277 lenParams.append(box.nonDeferredLenParams().begin(),
278 box.nonDeferredLenParams().end());
279 },
280 [](const auto &) {});
281 auto declareOp = builder.create<hlfir::DeclareOp>(
282 loc, base, name, shapeOrShift, lenParams, dummyScope, flags, dataAttr);
283 return mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());
284}
285
286hlfir::AssociateOp
287hlfir::genAssociateExpr(mlir::Location loc, fir::FirOpBuilder &builder,
288 hlfir::Entity value, mlir::Type variableType,
289 llvm::StringRef name,
290 std::optional<mlir::NamedAttribute> attr) {
291 assert(value.isValue() && "must not be a variable");
292 mlir::Value shape{};
293 if (value.isArray())
294 shape = genShape(loc, builder, value);
295
296 mlir::Value source = value;
297 // Lowered scalar expression values for numerical and logical may have a
298 // different type than what is required for the type in memory (logical
299 // expressions are typically manipulated as i1, but needs to be stored
300 // according to the fir.logical<kind> so that the storage size is correct).
301 // Character length mismatches are ignored (it is ok for one to be dynamic
302 // and the other static).
303 mlir::Type varEleTy = getFortranElementType(variableType);
304 mlir::Type valueEleTy = getFortranElementType(value.getType());
305 if (varEleTy != valueEleTy && !(mlir::isa<fir::CharacterType>(valueEleTy) &&
306 mlir::isa<fir::CharacterType>(varEleTy))) {
307 assert(value.isScalar() && fir::isa_trivial(value.getType()));
308 source = builder.createConvert(loc, fir::unwrapPassByRefType(variableType),
309 value);
310 }
311 llvm::SmallVector<mlir::Value> lenParams;
312 genLengthParameters(loc, builder, value, lenParams);
313 if (attr) {
314 assert(name.empty() && "It attribute is provided, no-name is expected");
315 return builder.create<hlfir::AssociateOp>(loc, source, shape, lenParams,
316 fir::FortranVariableFlagsAttr{},
317 llvm::ArrayRef{*attr});
318 }
319 return builder.create<hlfir::AssociateOp>(loc, source, name, shape, lenParams,
320 fir::FortranVariableFlagsAttr{});
321}
322
323mlir::Value hlfir::genVariableRawAddress(mlir::Location loc,
324 fir::FirOpBuilder &builder,
325 hlfir::Entity var) {
326 assert(var.isVariable() && "only address of variables can be taken");
327 mlir::Value baseAddr = var.getFirBase();
328 if (var.isMutableBox())
329 baseAddr = builder.create<fir::LoadOp>(loc, baseAddr);
330 // Get raw address.
331 if (mlir::isa<fir::BoxCharType>(var.getType()))
332 baseAddr = genUnboxChar(loc, builder, var.getBase()).getAddr();
333 if (mlir::isa<fir::BaseBoxType>(baseAddr.getType()))
334 baseAddr = builder.create<fir::BoxAddrOp>(loc, baseAddr);
335 return baseAddr;
336}
337
338mlir::Value hlfir::genVariableBoxChar(mlir::Location loc,
339 fir::FirOpBuilder &builder,
340 hlfir::Entity var) {
341 assert(var.isVariable() && "only address of variables can be taken");
342 if (mlir::isa<fir::BoxCharType>(var.getType()))
343 return var;
344 mlir::Value addr = genVariableRawAddress(loc, builder, var);
345 llvm::SmallVector<mlir::Value> lengths;
346 genLengthParameters(loc, builder, var, lengths);
347 assert(lengths.size() == 1);
348 auto charType = mlir::cast<fir::CharacterType>(var.getFortranElementType());
349 auto boxCharType =
350 fir::BoxCharType::get(builder.getContext(), charType.getFKind());
351 auto scalarAddr =
352 builder.createConvert(loc, fir::ReferenceType::get(charType), addr);
353 return builder.create<fir::EmboxCharOp>(loc, boxCharType, scalarAddr,
354 lengths[0]);
355}
356
357static hlfir::Entity changeBoxAttributes(mlir::Location loc,
358 fir::FirOpBuilder &builder,
359 hlfir::Entity var,
360 fir::BaseBoxType forceBoxType) {
361 assert(llvm::isa<fir::BaseBoxType>(var.getType()) && "expect box type");
362 // Propagate lower bounds.
363 mlir::Value shift;
364 llvm::SmallVector<mlir::Value> lbounds =
365 getNonDefaultLowerBounds(loc, builder, var);
366 if (!lbounds.empty())
367 shift = builder.genShift(loc, lbounds);
368 auto rebox = builder.create<fir::ReboxOp>(loc, forceBoxType, var, shift,
369 /*slice=*/nullptr);
370 return hlfir::Entity{rebox};
371}
372
373hlfir::Entity hlfir::genVariableBox(mlir::Location loc,
374 fir::FirOpBuilder &builder,
375 hlfir::Entity var,
376 fir::BaseBoxType forceBoxType) {
377 assert(var.isVariable() && "must be a variable");
378 var = hlfir::derefPointersAndAllocatables(loc, builder, var);
379 if (mlir::isa<fir::BaseBoxType>(var.getType())) {
380 if (!forceBoxType || forceBoxType == var.getType())
381 return var;
382 return changeBoxAttributes(loc, builder, var, forceBoxType);
383 }
384 // Note: if the var is not a fir.box/fir.class at that point, it has default
385 // lower bounds and is not polymorphic.
386 mlir::Value shape =
387 var.isArray() ? hlfir::genShape(loc, builder, var) : mlir::Value{};
388 llvm::SmallVector<mlir::Value> typeParams;
389 mlir::Type elementType =
390 forceBoxType ? fir::getFortranElementType(forceBoxType.getEleTy())
391 : var.getFortranElementType();
392 auto maybeCharType = mlir::dyn_cast<fir::CharacterType>(elementType);
393 if (!maybeCharType || maybeCharType.hasDynamicLen())
394 hlfir::genLengthParameters(loc, builder, var, typeParams);
395 mlir::Value addr = var.getBase();
396 if (mlir::isa<fir::BoxCharType>(var.getType()))
397 addr = genVariableRawAddress(loc, builder, var);
398 const bool isVolatile = fir::isa_volatile_type(var.getType());
399 mlir::Type boxType =
400 fir::BoxType::get(var.getElementOrSequenceType(), isVolatile);
401 if (forceBoxType) {
402 boxType = forceBoxType;
403 mlir::Type baseType =
404 fir::ReferenceType::get(fir::unwrapRefType(forceBoxType.getEleTy()));
405 addr = builder.createConvert(loc, baseType, addr);
406 }
407 auto embox =
408 builder.create<fir::EmboxOp>(loc, boxType, addr, shape,
409 /*slice=*/mlir::Value{}, typeParams);
410 return hlfir::Entity{embox.getResult()};
411}
412
413hlfir::Entity hlfir::loadTrivialScalar(mlir::Location loc,
414 fir::FirOpBuilder &builder,
415 Entity entity) {
416 entity = derefPointersAndAllocatables(loc, builder, entity);
417 if (entity.isVariable() && entity.isScalar() &&
418 fir::isa_trivial(entity.getFortranElementType())) {
419 return Entity{builder.create<fir::LoadOp>(loc, entity)};
420 }
421 return entity;
422}
423
424hlfir::Entity hlfir::getElementAt(mlir::Location loc,
425 fir::FirOpBuilder &builder, Entity entity,
426 mlir::ValueRange oneBasedIndices) {
427 if (entity.isScalar())
428 return entity;
429 llvm::SmallVector<mlir::Value> lenParams;
430 genLengthParameters(loc, builder, entity, lenParams);
431 if (mlir::isa<hlfir::ExprType>(entity.getType()))
432 return hlfir::Entity{builder.create<hlfir::ApplyOp>(
433 loc, entity, oneBasedIndices, lenParams)};
434 // Build hlfir.designate. The lower bounds may need to be added to
435 // the oneBasedIndices since hlfir.designate expect indices
436 // based on the array operand lower bounds.
437 mlir::Type resultType = hlfir::getVariableElementType(entity);
438 hlfir::DesignateOp designate;
439 llvm::SmallVector<mlir::Value> lbounds =
440 getNonDefaultLowerBounds(loc, builder, entity);
441 if (!lbounds.empty()) {
442 llvm::SmallVector<mlir::Value> indices;
443 mlir::Type idxTy = builder.getIndexType();
444 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
445 for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, lbounds)) {
446 auto lbIdx = builder.createConvert(loc, idxTy, lb);
447 auto oneBasedIdx = builder.createConvert(loc, idxTy, oneBased);
448 auto shift = builder.create<mlir::arith::SubIOp>(loc, lbIdx, one);
449 mlir::Value index =
450 builder.create<mlir::arith::AddIOp>(loc, oneBasedIdx, shift);
451 indices.push_back(index);
452 }
453 designate = builder.create<hlfir::DesignateOp>(loc, resultType, entity,
454 indices, lenParams);
455 } else {
456 designate = builder.create<hlfir::DesignateOp>(loc, resultType, entity,
457 oneBasedIndices, lenParams);
458 }
459 return mlir::cast<fir::FortranVariableOpInterface>(designate.getOperation());
460}
461
462static mlir::Value genUBound(mlir::Location loc, fir::FirOpBuilder &builder,
463 mlir::Value lb, mlir::Value extent,
464 mlir::Value one) {
465 if (auto constantLb = fir::getIntIfConstant(lb))
466 if (*constantLb == 1)
467 return extent;
468 extent = builder.createConvert(loc, one.getType(), extent);
469 lb = builder.createConvert(loc, one.getType(), lb);
470 auto add = builder.create<mlir::arith::AddIOp>(loc, lb, extent);
471 return builder.create<mlir::arith::SubIOp>(loc, add, one);
472}
473
474llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
475hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,
476 Entity entity) {
477 if (mlir::isa<hlfir::ExprType>(entity.getType()))
478 TODO(loc, "bounds of expressions in hlfir");
479 auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
480 assert(!cleanup && "translation of entity should not yield cleanup");
481 if (const auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>())
482 exv = fir::factory::genMutableBoxRead(builder, loc, *mutableBox);
483 mlir::Type idxTy = builder.getIndexType();
484 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
485 llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> result;
486 for (unsigned dim = 0; dim < exv.rank(); ++dim) {
487 mlir::Value extent = fir::factory::readExtent(builder, loc, exv, dim);
488 mlir::Value lb = fir::factory::readLowerBound(builder, loc, exv, dim, one);
489 mlir::Value ub = genUBound(loc, builder, lb, extent, one);
490 result.push_back({lb, ub});
491 }
492 return result;
493}
494
495llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
496hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,
497 mlir::Value shape) {
498 assert((mlir::isa<fir::ShapeShiftType>(shape.getType()) ||
499 mlir::isa<fir::ShapeType>(shape.getType())) &&
500 "shape must contain extents");
501 auto extents = hlfir::getExplicitExtentsFromShape(shape, builder);
502 auto lowers = getExplicitLboundsFromShape(shape);
503 assert(lowers.empty() || lowers.size() == extents.size());
504 mlir::Type idxTy = builder.getIndexType();
505 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
506 llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> result;
507 for (auto extent : llvm::enumerate(extents)) {
508 mlir::Value lb = lowers.empty() ? one : lowers[extent.index()];
509 mlir::Value ub = lowers.empty()
510 ? extent.value()
511 : genUBound(loc, builder, lb, extent.value(), one);
512 result.push_back({lb, ub});
513 }
514 return result;
515}
516
517llvm::SmallVector<mlir::Value> hlfir::genLowerbounds(mlir::Location loc,
518 fir::FirOpBuilder &builder,
519 mlir::Value shape,
520 unsigned rank) {
521 llvm::SmallVector<mlir::Value> lbounds;
522 if (shape)
523 lbounds = getExplicitLboundsFromShape(shape);
524 if (!lbounds.empty())
525 return lbounds;
526 mlir::Value one =
527 builder.createIntegerConstant(loc, builder.getIndexType(), 1);
528 return llvm::SmallVector<mlir::Value>(rank, one);
529}
530
531static hlfir::Entity followShapeInducingSource(hlfir::Entity entity) {
532 while (true) {
533 if (auto reassoc = entity.getDefiningOp<hlfir::NoReassocOp>()) {
534 entity = hlfir::Entity{reassoc.getVal()};
535 continue;
536 }
537 if (auto asExpr = entity.getDefiningOp<hlfir::AsExprOp>()) {
538 entity = hlfir::Entity{asExpr.getVar()};
539 continue;
540 }
541 break;
542 }
543 return entity;
544}
545
546static mlir::Value computeVariableExtent(mlir::Location loc,
547 fir::FirOpBuilder &builder,
548 hlfir::Entity variable,
549 fir::SequenceType seqTy,
550 unsigned dim) {
551 mlir::Type idxTy = builder.getIndexType();
552 if (seqTy.getShape().size() > dim) {
553 fir::SequenceType::Extent typeExtent = seqTy.getShape()[dim];
554 if (typeExtent != fir::SequenceType::getUnknownExtent())
555 return builder.createIntegerConstant(loc, idxTy, typeExtent);
556 }
557 assert(mlir::isa<fir::BaseBoxType>(variable.getType()) &&
558 "array variable with dynamic extent must be boxed");
559 mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim);
560 auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
561 variable, dimVal);
562 return dimInfo.getExtent();
563}
564llvm::SmallVector<mlir::Value> getVariableExtents(mlir::Location loc,
565 fir::FirOpBuilder &builder,
566 hlfir::Entity variable) {
567 llvm::SmallVector<mlir::Value> extents;
568 if (fir::FortranVariableOpInterface varIface =
569 variable.getIfVariableInterface()) {
570 extents = getExplicitExtents(varIface, builder);
571 if (!extents.empty())
572 return extents;
573 }
574
575 if (variable.isMutableBox())
576 variable = hlfir::derefPointersAndAllocatables(loc, builder, variable);
577 // Use the type shape information, and/or the fir.box/fir.class shape
578 // information if any extents are not static.
579 fir::SequenceType seqTy = mlir::cast<fir::SequenceType>(
580 hlfir::getFortranElementOrSequenceType(variable.getType()));
581 unsigned rank = seqTy.getShape().size();
582 for (unsigned dim = 0; dim < rank; ++dim)
583 extents.push_back(
584 computeVariableExtent(loc, builder, variable, seqTy, dim));
585 return extents;
586}
587
588static mlir::Value tryRetrievingShapeOrShift(hlfir::Entity entity) {
589 if (mlir::isa<hlfir::ExprType>(entity.getType())) {
590 if (auto elemental = entity.getDefiningOp<hlfir::ElementalOp>())
591 return elemental.getShape();
592 if (auto evalInMem = entity.getDefiningOp<hlfir::EvaluateInMemoryOp>())
593 return evalInMem.getShape();
594 return mlir::Value{};
595 }
596 if (auto varIface = entity.getIfVariableInterface())
597 return varIface.getShape();
598 return {};
599}
600
601mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder,
602 hlfir::Entity entity) {
603 assert(entity.isArray() && "entity must be an array");
604 entity = followShapeInducingSource(entity);
605 assert(entity && "what?");
606 if (auto shape = tryRetrievingShapeOrShift(entity)) {
607 if (mlir::isa<fir::ShapeType>(shape.getType()))
608 return shape;
609 if (mlir::isa<fir::ShapeShiftType>(shape.getType()))
610 if (auto s = shape.getDefiningOp<fir::ShapeShiftOp>())
611 return builder.create<fir::ShapeOp>(loc, s.getExtents());
612 }
613 if (mlir::isa<hlfir::ExprType>(entity.getType()))
614 return builder.create<hlfir::ShapeOfOp>(loc, entity.getBase());
615 // There is no shape lying around for this entity. Retrieve the extents and
616 // build a new fir.shape.
617 return builder.create<fir::ShapeOp>(loc,
618 getVariableExtents(loc, builder, entity));
619}
620
621llvm::SmallVector<mlir::Value>
622hlfir::getIndexExtents(mlir::Location loc, fir::FirOpBuilder &builder,
623 mlir::Value shape) {
624 llvm::SmallVector<mlir::Value> extents =
625 hlfir::getExplicitExtentsFromShape(shape, builder);
626 mlir::Type indexType = builder.getIndexType();
627 for (auto &extent : extents)
628 extent = builder.createConvert(loc, indexType, extent);
629 return extents;
630}
631
632mlir::Value hlfir::genExtent(mlir::Location loc, fir::FirOpBuilder &builder,
633 hlfir::Entity entity, unsigned dim) {
634 entity = followShapeInducingSource(entity);
635 if (auto shape = tryRetrievingShapeOrShift(entity)) {
636 auto extents = hlfir::getExplicitExtentsFromShape(shape, builder);
637 if (!extents.empty()) {
638 assert(extents.size() > dim && "bad inquiry");
639 return extents[dim];
640 }
641 }
642 if (entity.isVariable()) {
643 if (entity.isMutableBox())
644 entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
645 // Use the type shape information, and/or the fir.box/fir.class shape
646 // information if any extents are not static.
647 fir::SequenceType seqTy = mlir::cast<fir::SequenceType>(
648 hlfir::getFortranElementOrSequenceType(entity.getType()));
649 return computeVariableExtent(loc, builder, entity, seqTy, dim);
650 }
651 TODO(loc, "get extent from HLFIR expr without producer holding the shape");
652}
653
654mlir::Value hlfir::genLBound(mlir::Location loc, fir::FirOpBuilder &builder,
655 hlfir::Entity entity, unsigned dim) {
656 if (!entity.mayHaveNonDefaultLowerBounds())
657 return builder.createIntegerConstant(loc, builder.getIndexType(), 1);
658 if (auto shape = tryRetrievingShapeOrShift(entity)) {
659 auto lbounds = getExplicitLboundsFromShape(shape);
660 if (!lbounds.empty()) {
661 assert(lbounds.size() > dim && "bad inquiry");
662 return lbounds[dim];
663 }
664 }
665 if (entity.isMutableBox())
666 entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
667 assert(mlir::isa<fir::BaseBoxType>(entity.getType()) && "must be a box");
668 mlir::Type idxTy = builder.getIndexType();
669 mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim);
670 auto dimInfo =
671 builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, entity, dimVal);
672 return dimInfo.getLowerBound();
673}
674
675void hlfir::genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
676 Entity entity,
677 llvm::SmallVectorImpl<mlir::Value> &result) {
678 if (!entity.hasLengthParameters())
679 return;
680 if (mlir::isa<hlfir::ExprType>(entity.getType())) {
681 mlir::Value expr = entity;
682 if (auto reassoc = expr.getDefiningOp<hlfir::NoReassocOp>())
683 expr = reassoc.getVal();
684 // Going through fir::ExtendedValue would create a temp,
685 // which is not desired for an inquiry.
686 // TODO: make this an interface when adding further character producing ops.
687 if (auto concat = expr.getDefiningOp<hlfir::ConcatOp>()) {
688 result.push_back(concat.getLength());
689 return;
690 } else if (auto concat = expr.getDefiningOp<hlfir::SetLengthOp>()) {
691 result.push_back(concat.getLength());
692 return;
693 } else if (auto asExpr = expr.getDefiningOp<hlfir::AsExprOp>()) {
694 hlfir::genLengthParameters(loc, builder, hlfir::Entity{asExpr.getVar()},
695 result);
696 return;
697 } else if (auto elemental = expr.getDefiningOp<hlfir::ElementalOp>()) {
698 result.append(elemental.getTypeparams().begin(),
699 elemental.getTypeparams().end());
700 return;
701 } else if (auto evalInMem =
702 expr.getDefiningOp<hlfir::EvaluateInMemoryOp>()) {
703 result.append(evalInMem.getTypeparams().begin(),
704 evalInMem.getTypeparams().end());
705 return;
706 } else if (auto apply = expr.getDefiningOp<hlfir::ApplyOp>()) {
707 result.append(apply.getTypeparams().begin(), apply.getTypeparams().end());
708 return;
709 }
710 if (entity.isCharacter()) {
711 result.push_back(builder.create<hlfir::GetLengthOp>(loc, expr));
712 return;
713 }
714 TODO(loc, "inquire PDTs length parameters of hlfir.expr");
715 }
716
717 if (entity.isCharacter()) {
718 result.push_back(genCharacterVariableLength(loc, builder, entity));
719 return;
720 }
721 TODO(loc, "inquire PDTs length parameters in HLFIR");
722}
723
724mlir::Value hlfir::genCharLength(mlir::Location loc, fir::FirOpBuilder &builder,
725 hlfir::Entity entity) {
726 llvm::SmallVector<mlir::Value, 1> lenParams;
727 genLengthParameters(loc, builder, entity, lenParams);
728 assert(lenParams.size() == 1 && "characters must have one length parameters");
729 return lenParams[0];
730}
731
732mlir::Value hlfir::genRank(mlir::Location loc, fir::FirOpBuilder &builder,
733 hlfir::Entity entity, mlir::Type resultType) {
734 if (!entity.isAssumedRank())
735 return builder.createIntegerConstant(loc, resultType, entity.getRank());
736 assert(entity.isBoxAddressOrValue() &&
737 "assumed-ranks are box addresses or values");
738 return builder.create<fir::BoxRankOp>(loc, resultType, entity);
739}
740
741// Return a "shape" that can be used in fir.embox/fir.rebox with \p exv base.
742static mlir::Value asEmboxShape(mlir::Location loc, fir::FirOpBuilder &builder,
743 const fir::ExtendedValue &exv,
744 mlir::Value shape) {
745 if (!shape)
746 return shape;
747 // fir.rebox does not need and does not accept extents (fir.shape or
748 // fir.shape_shift) since this information is already in the input fir.box,
749 // it only accepts fir.shift because local lower bounds may not be reflected
750 // in the fir.box.
751 if (mlir::isa<fir::BaseBoxType>(fir::getBase(exv).getType()) &&
752 !mlir::isa<fir::ShiftType>(shape.getType()))
753 return builder.createShape(loc, exv);
754 return shape;
755}
756
757std::pair<mlir::Value, mlir::Value> hlfir::genVariableFirBaseShapeAndParams(
758 mlir::Location loc, fir::FirOpBuilder &builder, Entity entity,
759 llvm::SmallVectorImpl<mlir::Value> &typeParams) {
760 auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
761 assert(!cleanup && "variable to Exv should not produce cleanup");
762 if (entity.hasLengthParameters()) {
763 auto params = fir::getTypeParams(exv);
764 typeParams.append(params.begin(), params.end());
765 }
766 if (entity.isScalar())
767 return {fir::getBase(exv), mlir::Value{}};
768
769 // Contiguous variables that are represented with a box
770 // may require the shape to be extracted from the box (i.e. evx),
771 // because they itself may not have shape specified.
772 // This happens during late propagationg of contiguous
773 // attribute, e.g.:
774 // %9:2 = hlfir.declare %6
775 // {fortran_attrs = #fir.var_attrs<contiguous>} :
776 // (!fir.box<!fir.array<?x?x...>>) ->
777 // (!fir.box<!fir.array<?x?x...>>, !fir.box<!fir.array<?x?x...>>)
778 // The extended value is an ArrayBoxValue with base being
779 // the raw address of the array.
780 if (auto variableInterface = entity.getIfVariableInterface()) {
781 mlir::Value shape = variableInterface.getShape();
782 if (mlir::isa<fir::BaseBoxType>(fir::getBase(exv).getType()) ||
783 !mlir::isa<fir::BaseBoxType>(entity.getType()) ||
784 // Still use the variable's shape if it is present.
785 // If it only specifies a shift, then we have to create
786 // a shape from the exv.
787 (shape && (shape.getDefiningOp<fir::ShapeShiftOp>() ||
788 shape.getDefiningOp<fir::ShapeOp>())))
789 return {fir::getBase(exv),
790 asEmboxShape(loc, builder, exv, variableInterface.getShape())};
791 }
792 return {fir::getBase(exv), builder.createShape(loc, exv)};
793}
794
795hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
796 fir::FirOpBuilder &builder,
797 Entity entity) {
798 if (entity.isMutableBox()) {
799 hlfir::Entity boxLoad{builder.create<fir::LoadOp>(loc, entity)};
800 if (entity.isScalar()) {
801 if (!entity.isPolymorphic() && !entity.hasLengthParameters())
802 return hlfir::Entity{builder.create<fir::BoxAddrOp>(loc, boxLoad)};
803 mlir::Type elementType = boxLoad.getFortranElementType();
804 if (auto charType = mlir::dyn_cast<fir::CharacterType>(elementType)) {
805 mlir::Value base = builder.create<fir::BoxAddrOp>(loc, boxLoad);
806 if (charType.hasConstantLen())
807 return hlfir::Entity{base};
808 mlir::Value len = genCharacterVariableLength(loc, builder, entity);
809 auto boxCharType =
810 fir::BoxCharType::get(builder.getContext(), charType.getFKind());
811 return hlfir::Entity{
812 builder.create<fir::EmboxCharOp>(loc, boxCharType, base, len)
813 .getResult()};
814 }
815 }
816 // Otherwise, the entity is either an array, a polymorphic entity, or a
817 // derived type with length parameters. All these entities require a fir.box
818 // or fir.class to hold bounds, dynamic type or length parameter
819 // information. Keep them boxed.
820 return boxLoad;
821 } else if (entity.isProcedurePointer()) {
822 return hlfir::Entity{builder.create<fir::LoadOp>(loc, entity)};
823 }
824 return entity;
825}
826
827mlir::Type hlfir::getVariableElementType(hlfir::Entity variable) {
828 assert(variable.isVariable() && "entity must be a variable");
829 if (variable.isScalar())
830 return variable.getType();
831 mlir::Type eleTy = variable.getFortranElementType();
832 const bool isVolatile = fir::isa_volatile_type(variable.getType());
833 if (variable.isPolymorphic())
834 return fir::ClassType::get(eleTy, isVolatile);
835 if (auto charType = mlir::dyn_cast<fir::CharacterType>(eleTy)) {
836 if (charType.hasDynamicLen())
837 return fir::BoxCharType::get(charType.getContext(), charType.getFKind());
838 } else if (fir::isRecordWithTypeParameters(eleTy)) {
839 return fir::BoxType::get(eleTy, isVolatile);
840 }
841 return fir::ReferenceType::get(eleTy, isVolatile);
842}
843
844mlir::Type hlfir::getEntityElementType(hlfir::Entity entity) {
845 if (entity.isVariable())
846 return getVariableElementType(entity);
847 if (entity.isScalar())
848 return entity.getType();
849 auto exprType = mlir::dyn_cast<hlfir::ExprType>(entity.getType());
850 assert(exprType && "array value must be an hlfir.expr");
851 return exprType.getElementExprType();
852}
853
854static hlfir::ExprType getArrayExprType(mlir::Type elementType,
855 mlir::Value shape, bool isPolymorphic) {
856 unsigned rank = mlir::cast<fir::ShapeType>(shape.getType()).getRank();
857 hlfir::ExprType::Shape typeShape(rank, hlfir::ExprType::getUnknownExtent());
858 if (auto shapeOp = shape.getDefiningOp<fir::ShapeOp>())
859 for (auto extent : llvm::enumerate(shapeOp.getExtents()))
860 if (auto cstExtent = fir::getIntIfConstant(extent.value()))
861 typeShape[extent.index()] = *cstExtent;
862 return hlfir::ExprType::get(elementType.getContext(), typeShape, elementType,
863 isPolymorphic);
864}
865
866hlfir::ElementalOp hlfir::genElementalOp(
867 mlir::Location loc, fir::FirOpBuilder &builder, mlir::Type elementType,
868 mlir::Value shape, mlir::ValueRange typeParams,
869 const ElementalKernelGenerator &genKernel, bool isUnordered,
870 mlir::Value polymorphicMold, mlir::Type exprType) {
871 if (!exprType)
872 exprType = getArrayExprType(elementType, shape, !!polymorphicMold);
873 auto elementalOp = builder.create<hlfir::ElementalOp>(
874 loc, exprType, shape, polymorphicMold, typeParams, isUnordered);
875 auto insertPt = builder.saveInsertionPoint();
876 builder.setInsertionPointToStart(elementalOp.getBody());
877 mlir::Value elementResult = genKernel(loc, builder, elementalOp.getIndices());
878 // Numerical and logical scalars may be lowered to another type than the
879 // Fortran expression type (e.g i1 instead of fir.logical). Array expression
880 // values are typed according to their Fortran type. Insert a cast if needed
881 // here.
882 if (fir::isa_trivial(elementResult.getType()))
883 elementResult = builder.createConvert(loc, elementType, elementResult);
884 builder.create<hlfir::YieldElementOp>(loc, elementResult);
885 builder.restoreInsertionPoint(insertPt);
886 return elementalOp;
887}
888
889// TODO: we do not actually need to clone the YieldElementOp,
890// because returning its getElementValue() operand should be enough
891// for all callers of this function.
892hlfir::YieldElementOp
893hlfir::inlineElementalOp(mlir::Location loc, fir::FirOpBuilder &builder,
894 hlfir::ElementalOp elemental,
895 mlir::ValueRange oneBasedIndices) {
896 // hlfir.elemental region is a SizedRegion<1>.
897 assert(elemental.getRegion().hasOneBlock() &&
898 "expect elemental region to have one block");
899 mlir::IRMapping mapper;
900 mapper.map(elemental.getIndices(), oneBasedIndices);
901 mlir::Operation *newOp;
902 for (auto &op : elemental.getRegion().back().getOperations())
903 newOp = builder.clone(op, mapper);
904 auto yield = mlir::dyn_cast_or_null<hlfir::YieldElementOp>(newOp);
905 assert(yield && "last ElementalOp operation must be am hlfir.yield_element");
906 return yield;
907}
908
909mlir::Value hlfir::inlineElementalOp(
910 mlir::Location loc, fir::FirOpBuilder &builder,
911 hlfir::ElementalOpInterface elemental, mlir::ValueRange oneBasedIndices,
912 mlir::IRMapping &mapper,
913 const std::function<bool(hlfir::ElementalOp)> &mustRecursivelyInline) {
914 mlir::Region &region = elemental.getElementalRegion();
915 // hlfir.elemental region is a SizedRegion<1>.
916 assert(region.hasOneBlock() && "elemental region must have one block");
917 mapper.map(elemental.getIndices(), oneBasedIndices);
918 for (auto &op : region.front().without_terminator()) {
919 if (auto apply = mlir::dyn_cast<hlfir::ApplyOp>(op))
920 if (auto appliedElemental =
921 apply.getExpr().getDefiningOp<hlfir::ElementalOp>())
922 if (mustRecursivelyInline(appliedElemental)) {
923 llvm::SmallVector<mlir::Value> clonedApplyIndices;
924 for (auto indice : apply.getIndices())
925 clonedApplyIndices.push_back(mapper.lookupOrDefault(indice));
926 hlfir::ElementalOpInterface elementalIface =
927 mlir::cast<hlfir::ElementalOpInterface>(
928 appliedElemental.getOperation());
929 mlir::Value inlined = inlineElementalOp(loc, builder, elementalIface,
930 clonedApplyIndices, mapper,
931 mustRecursivelyInline);
932 mapper.map(apply.getResult(), inlined);
933 continue;
934 }
935 (void)builder.clone(op, mapper);
936 }
937 return mapper.lookupOrDefault(elemental.getElementEntity());
938}
939
940hlfir::LoopNest hlfir::genLoopNest(mlir::Location loc,
941 fir::FirOpBuilder &builder,
942 mlir::ValueRange extents, bool isUnordered,
943 bool emitWorkshareLoop,
944 bool couldVectorize) {
945 emitWorkshareLoop = emitWorkshareLoop && isUnordered;
946 hlfir::LoopNest loopNest;
947 assert(!extents.empty() && "must have at least one extent");
948 mlir::OpBuilder::InsertionGuard guard(builder);
949 loopNest.oneBasedIndices.assign(extents.size(), mlir::Value{});
950 // Build loop nest from column to row.
951 auto one = builder.create<mlir::arith::ConstantIndexOp>(loc, 1);
952 mlir::Type indexType = builder.getIndexType();
953 if (emitWorkshareLoop) {
954 auto wslw = builder.create<mlir::omp::WorkshareLoopWrapperOp>(loc);
955 loopNest.outerOp = wslw;
956 builder.createBlock(&wslw.getRegion());
957 mlir::omp::LoopNestOperands lnops;
958 lnops.loopInclusive = builder.getUnitAttr();
959 for (auto extent : llvm::reverse(extents)) {
960 lnops.loopLowerBounds.push_back(one);
961 lnops.loopUpperBounds.push_back(extent);
962 lnops.loopSteps.push_back(one);
963 }
964 auto lnOp = builder.create<mlir::omp::LoopNestOp>(loc, lnops);
965 mlir::Block *block = builder.createBlock(&lnOp.getRegion());
966 for (auto extent : llvm::reverse(extents))
967 block->addArgument(extent.getType(), extent.getLoc());
968 loopNest.body = block;
969 builder.create<mlir::omp::YieldOp>(loc);
970 for (unsigned dim = 0; dim < extents.size(); dim++)
971 loopNest.oneBasedIndices[extents.size() - dim - 1] =
972 lnOp.getRegion().front().getArgument(dim);
973 } else {
974 unsigned dim = extents.size() - 1;
975 for (auto extent : llvm::reverse(extents)) {
976 auto ub = builder.createConvert(loc, indexType, extent);
977 auto doLoop =
978 builder.create<fir::DoLoopOp>(loc, one, ub, one, isUnordered);
979 if (!couldVectorize) {
980 mlir::LLVM::LoopVectorizeAttr va{mlir::LLVM::LoopVectorizeAttr::get(
981 builder.getContext(),
982 /*disable=*/builder.getBoolAttr(true), {}, {}, {}, {}, {}, {})};
983 mlir::LLVM::LoopAnnotationAttr la = mlir::LLVM::LoopAnnotationAttr::get(
984 builder.getContext(), {}, /*vectorize=*/va, {}, /*unroll*/ {},
985 /*unroll_and_jam*/ {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {});
986 doLoop.setLoopAnnotationAttr(la);
987 }
988 loopNest.body = doLoop.getBody();
989 builder.setInsertionPointToStart(loopNest.body);
990 // Reverse the indices so they are in column-major order.
991 loopNest.oneBasedIndices[dim--] = doLoop.getInductionVar();
992 if (!loopNest.outerOp)
993 loopNest.outerOp = doLoop;
994 }
995 }
996 return loopNest;
997}
998
999llvm::SmallVector<mlir::Value> hlfir::genLoopNestWithReductions(
1000 mlir::Location loc, fir::FirOpBuilder &builder, mlir::ValueRange extents,
1001 mlir::ValueRange reductionInits, const ReductionLoopBodyGenerator &genBody,
1002 bool isUnordered) {
1003 assert(!extents.empty() && "must have at least one extent");
1004 // Build loop nest from column to row.
1005 auto one = builder.create<mlir::arith::ConstantIndexOp>(loc, 1);
1006 mlir::Type indexType = builder.getIndexType();
1007 unsigned dim = extents.size() - 1;
1008 fir::DoLoopOp outerLoop = nullptr;
1009 fir::DoLoopOp parentLoop = nullptr;
1010 llvm::SmallVector<mlir::Value> oneBasedIndices;
1011 oneBasedIndices.resize(dim + 1);
1012 for (auto extent : llvm::reverse(extents)) {
1013 auto ub = builder.createConvert(loc, indexType, extent);
1014
1015 // The outermost loop takes reductionInits as the initial
1016 // values of its iter-args.
1017 // A child loop takes its iter-args from the region iter-args
1018 // of its parent loop.
1019 fir::DoLoopOp doLoop;
1020 if (!parentLoop) {
1021 doLoop = builder.create<fir::DoLoopOp>(loc, one, ub, one, isUnordered,
1022 /*finalCountValue=*/false,
1023 reductionInits);
1024 } else {
1025 doLoop = builder.create<fir::DoLoopOp>(loc, one, ub, one, isUnordered,
1026 /*finalCountValue=*/false,
1027 parentLoop.getRegionIterArgs());
1028 if (!reductionInits.empty()) {
1029 // Return the results of the child loop from its parent loop.
1030 builder.create<fir::ResultOp>(loc, doLoop.getResults());
1031 }
1032 }
1033
1034 builder.setInsertionPointToStart(doLoop.getBody());
1035 // Reverse the indices so they are in column-major order.
1036 oneBasedIndices[dim--] = doLoop.getInductionVar();
1037 if (!outerLoop)
1038 outerLoop = doLoop;
1039 parentLoop = doLoop;
1040 }
1041
1042 llvm::SmallVector<mlir::Value> reductionValues;
1043 reductionValues =
1044 genBody(loc, builder, oneBasedIndices, parentLoop.getRegionIterArgs());
1045 builder.setInsertionPointToEnd(parentLoop.getBody());
1046 if (!reductionValues.empty())
1047 builder.create<fir::ResultOp>(loc, reductionValues);
1048 builder.setInsertionPointAfter(outerLoop);
1049 return outerLoop->getResults();
1050}
1051
1052template <typename Lambda>
1053static fir::ExtendedValue
1054conditionallyEvaluate(mlir::Location loc, fir::FirOpBuilder &builder,
1055 mlir::Value condition, const Lambda &genIfTrue) {
1056 mlir::OpBuilder::InsertPoint insertPt = builder.saveInsertionPoint();
1057
1058 // Evaluate in some region that will be moved into the actual ifOp (the actual
1059 // ifOp can only be created when the result types are known).
1060 auto badIfOp = builder.create<fir::IfOp>(loc, condition.getType(), condition,
1061 /*withElseRegion=*/false);
1062 mlir::Block *preparationBlock = &badIfOp.getThenRegion().front();
1063 builder.setInsertionPointToStart(preparationBlock);
1064 fir::ExtendedValue result = genIfTrue();
1065 fir::ResultOp resultOp = result.match(
1066 [&](const fir::CharBoxValue &box) -> fir::ResultOp {
1067 return builder.create<fir::ResultOp>(
1068 loc, mlir::ValueRange{box.getAddr(), box.getLen()});
1069 },
1070 [&](const mlir::Value &addr) -> fir::ResultOp {
1071 return builder.create<fir::ResultOp>(loc, addr);
1072 },
1073 [&](const auto &) -> fir::ResultOp {
1074 TODO(loc, "unboxing non scalar optional fir.box");
1075 });
1076 builder.restoreInsertionPoint(insertPt);
1077
1078 // Create actual fir.if operation.
1079 auto ifOp =
1080 builder.create<fir::IfOp>(loc, resultOp->getOperandTypes(), condition,
1081 /*withElseRegion=*/true);
1082 // Move evaluation into Then block,
1083 preparationBlock->moveBefore(&ifOp.getThenRegion().back());
1084 ifOp.getThenRegion().back().erase();
1085 // Create absent result in the Else block.
1086 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
1087 llvm::SmallVector<mlir::Value> absentValues;
1088 for (mlir::Type resTy : ifOp->getResultTypes()) {
1089 if (fir::isa_ref_type(resTy) || fir::isa_box_type(resTy))
1090 absentValues.emplace_back(builder.create<fir::AbsentOp>(loc, resTy));
1091 else
1092 absentValues.emplace_back(builder.create<fir::ZeroOp>(loc, resTy));
1093 }
1094 builder.create<fir::ResultOp>(loc, absentValues);
1095 badIfOp->erase();
1096
1097 // Build fir::ExtendedValue from the result values.
1098 builder.setInsertionPointAfter(ifOp);
1099 return result.match(
1100 [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
1101 return fir::CharBoxValue{ifOp.getResult(0), ifOp.getResult(1)};
1102 },
1103 [&](const mlir::Value &) -> fir::ExtendedValue {
1104 return ifOp.getResult(0);
1105 },
1106 [&](const auto &) -> fir::ExtendedValue {
1107 TODO(loc, "unboxing non scalar optional fir.box");
1108 });
1109}
1110
1111static fir::ExtendedValue translateVariableToExtendedValue(
1112 mlir::Location loc, fir::FirOpBuilder &builder, hlfir::Entity variable,
1113 bool forceHlfirBase = false, bool contiguousHint = false,
1114 bool keepScalarOptionalBoxed = false) {
1115 assert(variable.isVariable() && "must be a variable");
1116 // When going towards FIR, use the original base value to avoid
1117 // introducing descriptors at runtime when they are not required.
1118 // This is not done for assumed-rank since the fir::ExtendedValue cannot
1119 // held the related lower bounds in an vector. The lower bounds of the
1120 // descriptor must always be used instead.
1121
1122 mlir::Value base = (forceHlfirBase || variable.isAssumedRank())
1123 ? variable.getBase()
1124 : variable.getFirBase();
1125 if (variable.isMutableBox())
1126 return fir::MutableBoxValue(base, getExplicitTypeParams(variable),
1127 fir::MutableProperties{});
1128
1129 if (mlir::isa<fir::BaseBoxType>(base.getType())) {
1130 const bool contiguous = variable.isSimplyContiguous() || contiguousHint;
1131 const bool isAssumedRank = variable.isAssumedRank();
1132 if (!contiguous || variable.isPolymorphic() ||
1133 variable.isDerivedWithLengthParameters() || isAssumedRank) {
1134 llvm::SmallVector<mlir::Value> nonDefaultLbounds;
1135 if (!isAssumedRank)
1136 nonDefaultLbounds = getNonDefaultLowerBounds(loc, builder, variable);
1137 return fir::BoxValue(base, nonDefaultLbounds,
1138 getExplicitTypeParams(variable));
1139 }
1140 if (variable.mayBeOptional()) {
1141 if (!keepScalarOptionalBoxed && variable.isScalar()) {
1142 mlir::Value isPresent = builder.create<fir::IsPresentOp>(
1143 loc, builder.getI1Type(), variable);
1144 return conditionallyEvaluate(
1145 loc, builder, isPresent, [&]() -> fir::ExtendedValue {
1146 mlir::Value base = genVariableRawAddress(loc, builder, variable);
1147 if (variable.isCharacter()) {
1148 mlir::Value len =
1149 genCharacterVariableLength(loc, builder, variable);
1150 return fir::CharBoxValue{base, len};
1151 }
1152 return base;
1153 });
1154 }
1155 llvm::SmallVector<mlir::Value> nonDefaultLbounds =
1156 getNonDefaultLowerBounds(loc, builder, variable);
1157 return fir::BoxValue(base, nonDefaultLbounds,
1158 getExplicitTypeParams(variable));
1159 }
1160 // Otherwise, the variable can be represented in a fir::ExtendedValue
1161 // without the overhead of a fir.box.
1162 base = genVariableRawAddress(loc, builder, variable);
1163 }
1164
1165 if (variable.isScalar()) {
1166 if (variable.isCharacter()) {
1167 if (mlir::isa<fir::BoxCharType>(base.getType()))
1168 return genUnboxChar(loc, builder, base);
1169 mlir::Value len = genCharacterVariableLength(loc, builder, variable);
1170 return fir::CharBoxValue{base, len};
1171 }
1172 return base;
1173 }
1174 llvm::SmallVector<mlir::Value> extents;
1175 llvm::SmallVector<mlir::Value> nonDefaultLbounds;
1176 if (mlir::isa<fir::BaseBoxType>(variable.getType()) &&
1177 !variable.getIfVariableInterface() &&
1178 variable.mayHaveNonDefaultLowerBounds()) {
1179 // This special case avoids generating two sets of identical
1180 // fir.box_dim to get both the lower bounds and extents.
1181 fir::factory::genDimInfoFromBox(builder, loc, variable, &nonDefaultLbounds,
1182 &extents, /*strides=*/nullptr);
1183 } else {
1184 extents = getVariableExtents(loc, builder, variable);
1185 nonDefaultLbounds = getNonDefaultLowerBounds(loc, builder, variable);
1186 }
1187 if (variable.isCharacter())
1188 return fir::CharArrayBoxValue{
1189 base, genCharacterVariableLength(loc, builder, variable), extents,
1190 nonDefaultLbounds};
1191 return fir::ArrayBoxValue{base, extents, nonDefaultLbounds};
1192}
1193
1194fir::ExtendedValue
1195hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
1196 fir::FortranVariableOpInterface var,
1197 bool forceHlfirBase) {
1198 return translateVariableToExtendedValue(loc, builder, var, forceHlfirBase);
1199}
1200
1201std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
1202hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
1203 hlfir::Entity entity, bool contiguousHint,
1204 bool keepScalarOptionalBoxed) {
1205 if (entity.isVariable())
1206 return {translateVariableToExtendedValue(loc, builder, entity, false,
1207 contiguousHint,
1208 keepScalarOptionalBoxed),
1209 std::nullopt};
1210
1211 if (entity.isProcedure()) {
1212 if (fir::isCharacterProcedureTuple(entity.getType())) {
1213 auto [boxProc, len] = fir::factory::extractCharacterProcedureTuple(
1214 builder, loc, entity, /*openBoxProc=*/false);
1215 return {fir::CharBoxValue{boxProc, len}, std::nullopt};
1216 }
1217 return {static_cast<mlir::Value>(entity), std::nullopt};
1218 }
1219
1220 if (mlir::isa<hlfir::ExprType>(entity.getType())) {
1221 mlir::NamedAttribute byRefAttr = fir::getAdaptToByRefAttr(builder);
1222 hlfir::AssociateOp associate = hlfir::genAssociateExpr(
1223 loc, builder, entity, entity.getType(), "", byRefAttr);
1224 auto *bldr = &builder;
1225 hlfir::CleanupFunction cleanup = [bldr, loc, associate]() -> void {
1226 bldr->create<hlfir::EndAssociateOp>(loc, associate);
1227 };
1228 hlfir::Entity temp{associate.getBase()};
1229 return {translateToExtendedValue(loc, builder, temp).first, cleanup};
1230 }
1231 return {{static_cast<mlir::Value>(entity)}, {}};
1232}
1233
1234std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
1235hlfir::convertToValue(mlir::Location loc, fir::FirOpBuilder &builder,
1236 hlfir::Entity entity) {
1237 // Load scalar references to integer, logical, real, or complex value
1238 // to an mlir value, dereference allocatable and pointers, and get rid
1239 // of fir.box that are not needed or create a copy into contiguous memory.
1240 auto derefedAndLoadedEntity = loadTrivialScalar(loc, builder, entity);
1241 return translateToExtendedValue(loc, builder, derefedAndLoadedEntity);
1242}
1243
1244static fir::ExtendedValue placeTrivialInMemory(mlir::Location loc,
1245 fir::FirOpBuilder &builder,
1246 mlir::Value val,
1247 mlir::Type targetType) {
1248 auto temp = builder.createTemporary(loc, targetType);
1249 if (targetType != val.getType())
1250 builder.createStoreWithConvert(loc, val, temp);
1251 else
1252 builder.create<fir::StoreOp>(loc, val, temp);
1253 return temp;
1254}
1255
1256std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
1257hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
1258 hlfir::Entity entity, mlir::Type targetType) {
1259 // fir::factory::createBoxValue is not meant to deal with procedures.
1260 // Dereference procedure pointers here.
1261 if (entity.isProcedurePointer())
1262 entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
1263
1264 auto [exv, cleanup] =
1265 translateToExtendedValue(loc, builder, entity, /*contiguousHint=*/false,
1266 /*keepScalarOptionalBoxed=*/true);
1267 // Procedure entities should not go through createBoxValue that embox
1268 // object entities. Return the fir.boxproc directly.
1269 if (entity.isProcedure())
1270 return {exv, cleanup};
1271 mlir::Value base = fir::getBase(exv);
1272 if (fir::isa_trivial(base.getType()))
1273 exv = placeTrivialInMemory(loc, builder, base, targetType);
1274 fir::BoxValue box = fir::factory::createBoxValue(builder, loc, exv);
1275 return {box, cleanup};
1276}
1277
1278std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
1279hlfir::convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder,
1280 hlfir::Entity entity, mlir::Type targetType) {
1281 hlfir::Entity derefedEntity =
1282 hlfir::derefPointersAndAllocatables(loc, builder, entity);
1283 auto [exv, cleanup] =
1284 hlfir::translateToExtendedValue(loc, builder, derefedEntity);
1285 mlir::Value base = fir::getBase(exv);
1286 if (fir::isa_trivial(base.getType()))
1287 exv = placeTrivialInMemory(loc, builder, base, targetType);
1288 return {exv, cleanup};
1289}
1290
1291/// Clone:
1292/// ```
1293/// hlfir.elemental_addr %shape : !fir.shape<1> {
1294/// ^bb0(%i : index)
1295/// .....
1296/// %hlfir.yield %scalarAddress : fir.ref<T>
1297/// }
1298/// ```
1299//
1300/// into
1301///
1302/// ```
1303/// %expr = hlfir.elemental %shape : (!fir.shape<1>) -> hlfir.expr<?xT> {
1304/// ^bb0(%i : index)
1305/// .....
1306/// %value = fir.load %scalarAddress : fir.ref<T>
1307/// %hlfir.yield_element %value : T
1308/// }
1309/// ```
1310hlfir::ElementalOp
1311hlfir::cloneToElementalOp(mlir::Location loc, fir::FirOpBuilder &builder,
1312 hlfir::ElementalAddrOp elementalAddrOp) {
1313 hlfir::Entity scalarAddress =
1314 hlfir::Entity{mlir::cast<hlfir::YieldOp>(
1315 elementalAddrOp.getBody().back().getTerminator())
1316 .getEntity()};
1317 llvm::SmallVector<mlir::Value, 1> typeParams;
1318 hlfir::genLengthParameters(loc, builder, scalarAddress, typeParams);
1319
1320 builder.setInsertionPointAfter(elementalAddrOp);
1321 auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b,
1322 mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
1323 mlir::IRMapping mapper;
1324 mapper.map(elementalAddrOp.getIndices(), oneBasedIndices);
1325 mlir::Operation *newOp = nullptr;
1326 for (auto &op : elementalAddrOp.getBody().back().getOperations())
1327 newOp = b.clone(op, mapper);
1328 auto newYielOp = mlir::dyn_cast_or_null<hlfir::YieldOp>(newOp);
1329 assert(newYielOp && "hlfir.elemental_addr is ill formed");
1330 hlfir::Entity newAddr{newYielOp.getEntity()};
1331 newYielOp->erase();
1332 return hlfir::loadTrivialScalar(l, b, newAddr);
1333 };
1334 mlir::Type elementType = scalarAddress.getFortranElementType();
1335 return hlfir::genElementalOp(
1336 loc, builder, elementType, elementalAddrOp.getShape(), typeParams,
1337 genKernel, !elementalAddrOp.isOrdered(), elementalAddrOp.getMold());
1338}
1339
1340bool hlfir::elementalOpMustProduceTemp(hlfir::ElementalOp elemental) {
1341 for (mlir::Operation *useOp : elemental->getUsers())
1342 if (auto destroy = mlir::dyn_cast<hlfir::DestroyOp>(useOp))
1343 if (destroy.mustFinalizeExpr())
1344 return true;
1345
1346 return false;
1347}
1348
1349std::pair<hlfir::Entity, mlir::Value>
1350hlfir::createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
1351 hlfir::Entity mold) {
1352 assert(!mold.isAssumedRank() &&
1353 "cannot create temporary from assumed-rank mold");
1354 llvm::SmallVector<mlir::Value> lenParams;
1355 hlfir::genLengthParameters(loc, builder, mold, lenParams);
1356 llvm::StringRef tmpName{".tmp"};
1357
1358 mlir::Value shape{};
1359 llvm::SmallVector<mlir::Value> extents;
1360 if (mold.isArray()) {
1361 shape = hlfir::genShape(loc, builder, mold);
1362 extents = hlfir::getExplicitExtentsFromShape(shape, builder);
1363 }
1364
1365 bool useStack = !mold.isArray() && !mold.isPolymorphic();
1366 auto genTempDeclareOp =
1367 [](fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value memref,
1368 llvm::StringRef name, mlir::Value shape,
1369 llvm::ArrayRef<mlir::Value> typeParams,
1370 fir::FortranVariableFlagsAttr attrs) -> mlir::Value {
1371 auto declareOp =
1372 builder.create<hlfir::DeclareOp>(loc, memref, name, shape, typeParams,
1373 /*dummy_scope=*/nullptr, attrs);
1374 return declareOp.getBase();
1375 };
1376
1377 auto [base, isHeapAlloc] = builder.createAndDeclareTemp(
1378 loc, mold.getElementOrSequenceType(), shape, extents, lenParams,
1379 genTempDeclareOp, mold.isPolymorphic() ? mold.getBase() : nullptr,
1380 useStack, tmpName);
1381 return {hlfir::Entity{base}, builder.createBool(loc, isHeapAlloc)};
1382}
1383
1384hlfir::Entity hlfir::createStackTempFromMold(mlir::Location loc,
1385 fir::FirOpBuilder &builder,
1386 hlfir::Entity mold) {
1387 llvm::SmallVector<mlir::Value> lenParams;
1388 hlfir::genLengthParameters(loc, builder, mold, lenParams);
1389 llvm::StringRef tmpName{".tmp"};
1390 mlir::Value alloc;
1391 mlir::Value shape{};
1392 fir::FortranVariableFlagsAttr declAttrs;
1393
1394 if (mold.isPolymorphic()) {
1395 // genAllocatableApplyMold does heap allocation
1396 TODO(loc, "createStackTempFromMold for polymorphic type");
1397 } else if (mold.isArray()) {
1398 mlir::Type sequenceType =
1399 hlfir::getFortranElementOrSequenceType(mold.getType());
1400 shape = hlfir::genShape(loc, builder, mold);
1401 auto extents = hlfir::getIndexExtents(loc, builder, shape);
1402 alloc =
1403 builder.createTemporary(loc, sequenceType, tmpName, extents, lenParams);
1404 } else {
1405 alloc = builder.createTemporary(loc, mold.getFortranElementType(), tmpName,
1406 /*shape=*/std::nullopt, lenParams);
1407 }
1408 auto declareOp =
1409 builder.create<hlfir::DeclareOp>(loc, alloc, tmpName, shape, lenParams,
1410 /*dummy_scope=*/nullptr, declAttrs);
1411 return hlfir::Entity{declareOp.getBase()};
1412}
1413
1414hlfir::EntityWithAttributes
1415hlfir::convertCharacterKind(mlir::Location loc, fir::FirOpBuilder &builder,
1416 hlfir::Entity scalarChar, int toKind) {
1417 auto src = hlfir::convertToAddress(loc, builder, scalarChar,
1418 scalarChar.getFortranElementType());
1419 assert(src.first.getCharBox() && "must be scalar character");
1420 fir::CharBoxValue res = fir::factory::convertCharacterKind(
1421 builder, loc, *src.first.getCharBox(), toKind);
1422 if (src.second.has_value())
1423 src.second.value()();
1424
1425 return hlfir::EntityWithAttributes{builder.create<hlfir::DeclareOp>(
1426 loc, res.getAddr(), ".temp.kindconvert", /*shape=*/nullptr,
1427 /*typeparams=*/mlir::ValueRange{res.getLen()},
1428 /*dummy_scope=*/nullptr, fir::FortranVariableFlagsAttr{})};
1429}
1430
1431std::pair<hlfir::Entity, std::optional<hlfir::CleanupFunction>>
1432hlfir::genTypeAndKindConvert(mlir::Location loc, fir::FirOpBuilder &builder,
1433 hlfir::Entity source, mlir::Type toType,
1434 bool preserveLowerBounds) {
1435 mlir::Type fromType = source.getFortranElementType();
1436 toType = hlfir::getFortranElementType(toType);
1437 if (!toType || fromType == toType ||
1438 !(fir::isa_trivial(toType) || mlir::isa<fir::CharacterType>(toType)))
1439 return {source, std::nullopt};
1440
1441 std::optional<int> toKindCharConvert;
1442 if (auto toCharTy = mlir::dyn_cast<fir::CharacterType>(toType)) {
1443 if (auto fromCharTy = mlir::dyn_cast<fir::CharacterType>(fromType))
1444 if (toCharTy.getFKind() != fromCharTy.getFKind()) {
1445 toKindCharConvert = toCharTy.getFKind();
1446 // Preserve source length (padding/truncation will occur in assignment
1447 // if needed).
1448 toType = fir::CharacterType::get(
1449 fromType.getContext(), toCharTy.getFKind(), fromCharTy.getLen());
1450 }
1451 // Do not convert in case of character length mismatch only, hlfir.assign
1452 // deals with it.
1453 if (!toKindCharConvert)
1454 return {source, std::nullopt};
1455 }
1456
1457 if (source.getRank() == 0) {
1458 mlir::Value cast = toKindCharConvert
1459 ? mlir::Value{hlfir::convertCharacterKind(
1460 loc, builder, source, *toKindCharConvert)}
1461 : builder.convertWithSemantics(loc, toType, source);
1462 return {hlfir::Entity{cast}, std::nullopt};
1463 }
1464
1465 mlir::Value shape = hlfir::genShape(loc, builder, source);
1466 auto genKernel = [source, toType, toKindCharConvert](
1467 mlir::Location loc, fir::FirOpBuilder &builder,
1468 mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
1469 auto elementPtr =
1470 hlfir::getElementAt(loc, builder, source, oneBasedIndices);
1471 auto val = hlfir::loadTrivialScalar(loc, builder, elementPtr);
1472 if (toKindCharConvert)
1473 return hlfir::convertCharacterKind(loc, builder, val, *toKindCharConvert);
1474 return hlfir::EntityWithAttributes{
1475 builder.convertWithSemantics(loc, toType, val)};
1476 };
1477 llvm::SmallVector<mlir::Value, 1> lenParams;
1478 hlfir::genLengthParameters(loc, builder, source, lenParams);
1479 mlir::Value convertedRhs =
1480 hlfir::genElementalOp(loc, builder, toType, shape, lenParams, genKernel,
1481 /*isUnordered=*/true);
1482
1483 if (preserveLowerBounds && source.mayHaveNonDefaultLowerBounds()) {
1484 hlfir::AssociateOp associate =
1485 genAssociateExpr(loc, builder, hlfir::Entity{convertedRhs},
1486 convertedRhs.getType(), ".tmp.keeplbounds");
1487 fir::ShapeOp shapeOp = associate.getShape().getDefiningOp<fir::ShapeOp>();
1488 assert(shapeOp && "associate shape must be a fir.shape");
1489 const unsigned rank = shapeOp.getExtents().size();
1490 llvm::SmallVector<mlir::Value> lbAndExtents;
1491 for (unsigned dim = 0; dim < rank; ++dim) {
1492 lbAndExtents.push_back(hlfir::genLBound(loc, builder, source, dim));
1493 lbAndExtents.push_back(shapeOp.getExtents()[dim]);
1494 }
1495 auto shapeShiftType = fir::ShapeShiftType::get(builder.getContext(), rank);
1496 mlir::Value shapeShift =
1497 builder.create<fir::ShapeShiftOp>(loc, shapeShiftType, lbAndExtents);
1498 auto declareOp = builder.create<hlfir::DeclareOp>(
1499 loc, associate.getFirBase(), *associate.getUniqName(), shapeShift,
1500 associate.getTypeparams(), /*dummy_scope=*/nullptr,
1501 /*flags=*/fir::FortranVariableFlagsAttr{});
1502 hlfir::Entity castWithLbounds =
1503 mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());
1504 fir::FirOpBuilder *bldr = &builder;
1505 auto cleanup = [loc, bldr, convertedRhs, associate]() {
1506 bldr->create<hlfir::EndAssociateOp>(loc, associate);
1507 bldr->create<hlfir::DestroyOp>(loc, convertedRhs);
1508 };
1509 return {castWithLbounds, cleanup};
1510 }
1511
1512 fir::FirOpBuilder *bldr = &builder;
1513 auto cleanup = [loc, bldr, convertedRhs]() {
1514 bldr->create<hlfir::DestroyOp>(loc, convertedRhs);
1515 };
1516 return {hlfir::Entity{convertedRhs}, cleanup};
1517}
1518
1519std::pair<hlfir::Entity, bool> hlfir::computeEvaluateOpInNewTemp(
1520 mlir::Location loc, fir::FirOpBuilder &builder,
1521 hlfir::EvaluateInMemoryOp evalInMem, mlir::Value shape,
1522 mlir::ValueRange typeParams) {
1523 llvm::StringRef tmpName{".tmp.expr_result"};
1524 llvm::SmallVector<mlir::Value> extents =
1525 hlfir::getIndexExtents(loc, builder, shape);
1526 mlir::Type baseType =
1527 hlfir::getFortranElementOrSequenceType(evalInMem.getType());
1528 bool heapAllocated = fir::hasDynamicSize(baseType);
1529 // Note: temporaries are stack allocated here when possible (do not require
1530 // stack save/restore) because flang has always stack allocated function
1531 // results.
1532 mlir::Value temp = heapAllocated
1533 ? builder.createHeapTemporary(loc, baseType, tmpName,
1534 extents, typeParams)
1535 : builder.createTemporary(loc, baseType, tmpName,
1536 extents, typeParams);
1537 mlir::Value innerMemory = evalInMem.getMemory();
1538 temp = builder.createConvert(loc, innerMemory.getType(), temp);
1539 auto declareOp = builder.create<hlfir::DeclareOp>(
1540 loc, temp, tmpName, shape, typeParams,
1541 /*dummy_scope=*/nullptr, fir::FortranVariableFlagsAttr{});
1542 computeEvaluateOpIn(loc, builder, evalInMem, declareOp.getOriginalBase());
1543 return {hlfir::Entity{declareOp.getBase()}, /*heapAllocated=*/heapAllocated};
1544}
1545
1546void hlfir::computeEvaluateOpIn(mlir::Location loc, fir::FirOpBuilder &builder,
1547 hlfir::EvaluateInMemoryOp evalInMem,
1548 mlir::Value storage) {
1549 mlir::Value innerMemory = evalInMem.getMemory();
1550 mlir::Value storageCast =
1551 builder.createConvert(loc, innerMemory.getType(), storage);
1552 mlir::IRMapping mapper;
1553 mapper.map(innerMemory, storageCast);
1554 for (auto &op : evalInMem.getBody().front().without_terminator())
1555 builder.clone(op, mapper);
1556 return;
1557}
1558
1559hlfir::Entity hlfir::loadElementAt(mlir::Location loc,
1560 fir::FirOpBuilder &builder,
1561 hlfir::Entity entity,
1562 mlir::ValueRange oneBasedIndices) {
1563 return loadTrivialScalar(loc, builder,
1564 getElementAt(loc, builder, entity, oneBasedIndices));
1565}
1566
1567llvm::SmallVector<mlir::Value, Fortran::common::maxRank>
1568hlfir::genExtentsVector(mlir::Location loc, fir::FirOpBuilder &builder,
1569 hlfir::Entity entity) {
1570 entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
1571 mlir::Value shape = hlfir::genShape(loc, builder, entity);
1572 llvm::SmallVector<mlir::Value, Fortran::common::maxRank> extents =
1573 hlfir::getExplicitExtentsFromShape(shape, builder);
1574 if (shape.getUses().empty())
1575 shape.getDefiningOp()->erase();
1576 return extents;
1577}
1578
1579hlfir::Entity hlfir::gen1DSection(mlir::Location loc,
1580 fir::FirOpBuilder &builder,
1581 hlfir::Entity array, int64_t dim,
1582 mlir::ArrayRef<mlir::Value> lbounds,
1583 mlir::ArrayRef<mlir::Value> extents,
1584 mlir::ValueRange oneBasedIndices,
1585 mlir::ArrayRef<mlir::Value> typeParams) {
1586 assert(array.isVariable() && "array must be a variable");
1587 assert(dim > 0 && dim <= array.getRank() && "invalid dim number");
1588 mlir::Value one =
1589 builder.createIntegerConstant(loc, builder.getIndexType(), 1);
1590 hlfir::DesignateOp::Subscripts subscripts;
1591 unsigned indexId = 0;
1592 for (int i = 0; i < array.getRank(); ++i) {
1593 if (i == dim - 1) {
1594 mlir::Value ubound = genUBound(loc, builder, lbounds[i], extents[i], one);
1595 subscripts.emplace_back(
1596 hlfir::DesignateOp::Triplet{lbounds[i], ubound, one});
1597 } else {
1598 mlir::Value index =
1599 genUBound(loc, builder, lbounds[i], oneBasedIndices[indexId++], one);
1600 subscripts.emplace_back(index);
1601 }
1602 }
1603 mlir::Value sectionShape =
1604 builder.create<fir::ShapeOp>(loc, extents[dim - 1]);
1605
1606 // The result type is one of:
1607 // !fir.box/class<!fir.array<NxT>>
1608 // !fir.box/class<!fir.array<?xT>>
1609 //
1610 // We could use !fir.ref<!fir.array<NxT>> when the whole dimension's
1611 // size is known and it is the leading dimension, but let it be simple
1612 // for the time being.
1613 auto seqType =
1614 mlir::cast<fir::SequenceType>(array.getElementOrSequenceType());
1615 int64_t dimExtent = seqType.getShape()[dim - 1];
1616 mlir::Type sectionType =
1617 fir::SequenceType::get({dimExtent}, seqType.getEleTy());
1618 sectionType = fir::wrapInClassOrBoxType(sectionType, array.isPolymorphic());
1619
1620 auto designate = builder.create<hlfir::DesignateOp>(
1621 loc, sectionType, array, /*component=*/"", /*componentShape=*/nullptr,
1622 subscripts,
1623 /*substring=*/mlir::ValueRange{}, /*complexPartAttr=*/std::nullopt,
1624 sectionShape, typeParams);
1625 return hlfir::Entity{designate.getResult()};
1626}
1627
1628bool hlfir::designatePreservesContinuity(hlfir::DesignateOp op) {
1629 if (op.getComponent() || op.getComplexPart() || !op.getSubstring().empty())
1630 return false;
1631 auto subscripts = op.getIndices();
1632 unsigned i = 0;
1633 for (auto isTriplet : llvm::enumerate(op.getIsTriplet())) {
1634 // TODO: we should allow any number of leading triplets
1635 // that describe a whole dimension slice, then one optional
1636 // triplet describing potentially partial dimension slice,
1637 // then any number of non-triplet subscripts.
1638 // For the time being just allow a single leading
1639 // triplet and then any number of non-triplet subscripts.
1640 if (isTriplet.value()) {
1641 if (isTriplet.index() != 0) {
1642 return false;
1643 } else {
1644 i += 2;
1645 mlir::Value step = subscripts[i++];
1646 auto constantStep = fir::getIntIfConstant(step);
1647 if (!constantStep || *constantStep != 1)
1648 return false;
1649 }
1650 } else {
1651 ++i;
1652 }
1653 }
1654 return true;
1655}
1656
1657bool hlfir::isSimplyContiguous(mlir::Value base, bool checkWhole) {
1658 hlfir::Entity entity{base};
1659 if (entity.isSimplyContiguous())
1660 return true;
1661
1662 // Look at the definition.
1663 mlir::Operation *def = base.getDefiningOp();
1664 if (!def)
1665 return false;
1666
1667 return mlir::TypeSwitch<mlir::Operation *, bool>(def)
1668 .Case<fir::EmboxOp>(
1669 [&](auto op) { return fir::isContiguousEmbox(op, checkWhole); })
1670 .Case<fir::ReboxOp>([&](auto op) {
1671 hlfir::Entity box{op.getBox()};
1672 return fir::reboxPreservesContinuity(
1673 op, box.mayHaveNonDefaultLowerBounds(), checkWhole) &&
1674 isSimplyContiguous(box, checkWhole);
1675 })
1676 .Case<fir::DeclareOp, hlfir::DeclareOp>([&](auto op) {
1677 return isSimplyContiguous(op.getMemref(), checkWhole);
1678 })
1679 .Case<fir::ConvertOp>(
1680 [&](auto op) { return isSimplyContiguous(op.getValue()); })
1681 .Default([](auto &&) { return false; });
1682}
1683

source code of flang/lib/Optimizer/Builder/HLFIRTools.cpp