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

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