1//===- ConvertToFIR.cpp - Convert HLFIR to FIR ----------------------------===//
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// This file defines a pass to lower HLFIR to FIR
9//===----------------------------------------------------------------------===//
10
11#include "flang/Optimizer/Builder/Character.h"
12#include "flang/Optimizer/Builder/FIRBuilder.h"
13#include "flang/Optimizer/Builder/HLFIRTools.h"
14#include "flang/Optimizer/Builder/MutableBox.h"
15#include "flang/Optimizer/Builder/Runtime/Assign.h"
16#include "flang/Optimizer/Builder/Runtime/Derived.h"
17#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
18#include "flang/Optimizer/Builder/Todo.h"
19#include "flang/Optimizer/Dialect/FIRDialect.h"
20#include "flang/Optimizer/Dialect/FIROps.h"
21#include "flang/Optimizer/Dialect/FIRType.h"
22#include "flang/Optimizer/Dialect/Support/FIRContext.h"
23#include "flang/Optimizer/HLFIR/HLFIROps.h"
24#include "flang/Optimizer/HLFIR/Passes.h"
25#include "mlir/Transforms/DialectConversion.h"
26
27namespace hlfir {
28#define GEN_PASS_DEF_CONVERTHLFIRTOFIR
29#include "flang/Optimizer/HLFIR/Passes.h.inc"
30} // namespace hlfir
31
32using namespace mlir;
33
34namespace {
35/// May \p lhs alias with \p rhs?
36/// TODO: implement HLFIR alias analysis.
37class AssignOpConversion : public mlir::OpRewritePattern<hlfir::AssignOp> {
38public:
39 explicit AssignOpConversion(mlir::MLIRContext *ctx) : OpRewritePattern{ctx} {}
40
41 llvm::LogicalResult
42 matchAndRewrite(hlfir::AssignOp assignOp,
43 mlir::PatternRewriter &rewriter) const override {
44 mlir::Location loc = assignOp->getLoc();
45 hlfir::Entity lhs(assignOp.getLhs());
46 hlfir::Entity rhs(assignOp.getRhs());
47 auto module = assignOp->getParentOfType<mlir::ModuleOp>();
48 fir::FirOpBuilder builder(rewriter, module);
49
50 if (mlir::isa<hlfir::ExprType>(rhs.getType())) {
51 mlir::emitError(loc, "hlfir must be bufferized with --bufferize-hlfir "
52 "pass before being converted to FIR");
53 return mlir::failure();
54 }
55 auto [rhsExv, rhsCleanUp] =
56 hlfir::translateToExtendedValue(loc, builder, rhs);
57 auto [lhsExv, lhsCleanUp] =
58 hlfir::translateToExtendedValue(loc, builder, lhs);
59 assert(!lhsCleanUp && !rhsCleanUp &&
60 "variable to fir::ExtendedValue must not require cleanup");
61
62 auto emboxRHS = [&](fir::ExtendedValue &rhsExv) -> mlir::Value {
63 // There may be overlap between lhs and rhs. The runtime is able to detect
64 // and to make a copy of the rhs before modifying the lhs if needed.
65 // The code below relies on this and does not do any compile time alias
66 // analysis.
67 const bool rhsIsValue = fir::isa_trivial(fir::getBase(rhsExv).getType());
68 if (rhsIsValue) {
69 // createBox can only be called for fir::ExtendedValue that are
70 // already in memory. Place the integer/real/complex/logical scalar
71 // in memory.
72 // The RHS might be i1, which is not supported for emboxing.
73 // If LHS is not polymorphic, we may cast the RHS to the LHS type
74 // before emboxing. If LHS is polymorphic we have to figure out
75 // the data type for RHS emboxing anyway.
76 // It is probably a good idea to make sure that the data type
77 // of the RHS is always a valid Fortran storage data type.
78 // For the time being, just handle i1 explicitly here.
79 mlir::Type rhsType = rhs.getFortranElementType();
80 mlir::Value rhsVal = fir::getBase(rhsExv);
81 if (rhsType == builder.getI1Type()) {
82 rhsType = fir::LogicalType::get(builder.getContext(), 4);
83 rhsVal = builder.createConvert(loc, rhsType, rhsVal);
84 }
85 mlir::Value temp = builder.create<fir::AllocaOp>(loc, rhsType);
86 builder.create<fir::StoreOp>(loc, rhsVal, temp);
87 rhsExv = temp;
88 }
89 return fir::getBase(builder.createBox(loc, rhsExv));
90 };
91
92 if (assignOp.isAllocatableAssignment()) {
93 // Whole allocatable assignment: use the runtime to deal with the
94 // reallocation.
95 mlir::Value from = emboxRHS(rhsExv);
96 mlir::Value to = fir::getBase(lhsExv);
97 if (assignOp.mustKeepLhsLengthInAllocatableAssignment()) {
98 // Indicate the runtime that it should not reallocate in case of length
99 // mismatch, and that it should use the LHS explicit/assumed length if
100 // allocating/reallocation the LHS.
101 // Note that AssignExplicitLengthCharacter() must be used
102 // when isTemporaryLHS() is true here: the LHS is known to be
103 // character allocatable in this case, so finalization will not
104 // happen (as implied by temporary_lhs attribute), and LHS
105 // must keep its length (as implied by keep_lhs_length_if_realloc).
106 fir::runtime::genAssignExplicitLengthCharacter(builder, loc, to, from);
107 } else if (assignOp.isTemporaryLHS()) {
108 // Use AssignTemporary, when the LHS is a compiler generated temporary.
109 // Note that it also works properly for polymorphic LHS (i.e. the LHS
110 // will have the RHS dynamic type after the assignment).
111 fir::runtime::genAssignTemporary(builder, loc, to, from);
112 } else if (lhs.isPolymorphic()) {
113 // Indicate the runtime that the LHS must have the RHS dynamic type
114 // after the assignment.
115 fir::runtime::genAssignPolymorphic(builder, loc, to, from);
116 } else {
117 fir::runtime::genAssign(builder, loc, to, from);
118 }
119 } else if (lhs.isArray() ||
120 // Special case for element-by-element (or scalar) assignments
121 // generated for creating polymorphic expressions.
122 // The LHS of these assignments is a box describing just
123 // a single element, not the whole allocatable temp.
124 // They do not have 'realloc' attribute, because reallocation
125 // must not happen. The only expected effect of such an
126 // assignment is the copy of the contents, because the dynamic
127 // types of the LHS and the RHS must match already. We use the
128 // runtime in this case so that the polymorphic (including
129 // unlimited) content is copied properly.
130 (lhs.isPolymorphic() && assignOp.isTemporaryLHS())) {
131 // Use the runtime for simplicity. An optimization pass will be added to
132 // inline array assignment when profitable.
133 mlir::Value from = emboxRHS(rhsExv);
134 mlir::Value to = fir::getBase(builder.createBox(loc, lhsExv));
135 // This is not a whole allocatable assignment: the runtime will not
136 // reallocate and modify "toMutableBox" even if it is taking it by
137 // reference.
138 auto toMutableBox = builder.createTemporary(loc, to.getType());
139 builder.create<fir::StoreOp>(loc, to, toMutableBox);
140 if (assignOp.isTemporaryLHS())
141 fir::runtime::genAssignTemporary(builder, loc, toMutableBox, from);
142 else
143 fir::runtime::genAssign(builder, loc, toMutableBox, from);
144 } else {
145 // TODO: use the type specification to see if IsFinalizable is set,
146 // or propagate IsFinalizable attribute from lowering.
147 bool needFinalization =
148 !assignOp.isTemporaryLHS() &&
149 mlir::isa<fir::RecordType>(fir::getElementTypeOf(lhsExv));
150
151 // genScalarAssignment() must take care of potential overlap
152 // between LHS and RHS. Note that the overlap is possible
153 // also for components of LHS/RHS, and the Assign() runtime
154 // must take care of it.
155 fir::factory::genScalarAssignment(builder, loc, lhsExv, rhsExv,
156 needFinalization,
157 assignOp.isTemporaryLHS());
158 }
159 rewriter.eraseOp(assignOp);
160 return mlir::success();
161 }
162};
163
164class CopyInOpConversion : public mlir::OpRewritePattern<hlfir::CopyInOp> {
165public:
166 explicit CopyInOpConversion(mlir::MLIRContext *ctx) : OpRewritePattern{ctx} {}
167
168 struct CopyInResult {
169 mlir::Value addr;
170 mlir::Value wasCopied;
171 };
172
173 static CopyInResult genNonOptionalCopyIn(mlir::Location loc,
174 fir::FirOpBuilder &builder,
175 hlfir::CopyInOp copyInOp) {
176 mlir::Value inputVariable = copyInOp.getVar();
177 mlir::Type resultAddrType = copyInOp.getCopiedIn().getType();
178 mlir::Value isContiguous =
179 fir::runtime::genIsContiguous(builder, loc, inputVariable);
180 mlir::Value addr =
181 builder
182 .genIfOp(loc, {resultAddrType}, isContiguous,
183 /*withElseRegion=*/true)
184 .genThen(
185 [&]() { builder.create<fir::ResultOp>(loc, inputVariable); })
186 .genElse([&] {
187 // Create temporary on the heap. Note that the runtime is used and
188 // that is desired: since the data copy happens under a runtime
189 // check (for IsContiguous) the copy loops can hardly provide any
190 // value to optimizations, instead, the optimizer just wastes
191 // compilation time on these loops.
192 mlir::Value temp = copyInOp.getTempBox();
193 fir::runtime::genCopyInAssign(builder, loc, temp, inputVariable);
194 mlir::Value copy = builder.create<fir::LoadOp>(loc, temp);
195 // Get rid of allocatable flag in the fir.box.
196 if (mlir::cast<fir::BaseBoxType>(resultAddrType).isAssumedRank())
197 copy = builder.create<fir::ReboxAssumedRankOp>(
198 loc, resultAddrType, copy,
199 fir::LowerBoundModifierAttribute::Preserve);
200 else
201 copy = builder.create<fir::ReboxOp>(loc, resultAddrType, copy,
202 /*shape=*/mlir::Value{},
203 /*slice=*/mlir::Value{});
204 builder.create<fir::ResultOp>(loc, copy);
205 })
206 .getResults()[0];
207 return {addr, builder.genNot(loc, isContiguous)};
208 }
209
210 static CopyInResult genOptionalCopyIn(mlir::Location loc,
211 fir::FirOpBuilder &builder,
212 hlfir::CopyInOp copyInOp) {
213 mlir::Type resultAddrType = copyInOp.getCopiedIn().getType();
214 mlir::Value isPresent = copyInOp.getVarIsPresent();
215 auto res =
216 builder
217 .genIfOp(loc, {resultAddrType, builder.getI1Type()}, isPresent,
218 /*withElseRegion=*/true)
219 .genThen([&]() {
220 CopyInResult res = genNonOptionalCopyIn(loc, builder, copyInOp);
221 builder.create<fir::ResultOp>(
222 loc, mlir::ValueRange{res.addr, res.wasCopied});
223 })
224 .genElse([&] {
225 mlir::Value absent =
226 builder.create<fir::AbsentOp>(loc, resultAddrType);
227 builder.create<fir::ResultOp>(
228 loc, mlir::ValueRange{absent, isPresent});
229 })
230 .getResults();
231 return {res[0], res[1]};
232 }
233
234 llvm::LogicalResult
235 matchAndRewrite(hlfir::CopyInOp copyInOp,
236 mlir::PatternRewriter &rewriter) const override {
237 mlir::Location loc = copyInOp.getLoc();
238 fir::FirOpBuilder builder(rewriter, copyInOp.getOperation());
239 CopyInResult result = copyInOp.getVarIsPresent()
240 ? genOptionalCopyIn(loc, builder, copyInOp)
241 : genNonOptionalCopyIn(loc, builder, copyInOp);
242 rewriter.replaceOp(copyInOp, {result.addr, result.wasCopied});
243 return mlir::success();
244 }
245};
246
247class CopyOutOpConversion : public mlir::OpRewritePattern<hlfir::CopyOutOp> {
248public:
249 explicit CopyOutOpConversion(mlir::MLIRContext *ctx)
250 : OpRewritePattern{ctx} {}
251
252 llvm::LogicalResult
253 matchAndRewrite(hlfir::CopyOutOp copyOutOp,
254 mlir::PatternRewriter &rewriter) const override {
255 mlir::Location loc = copyOutOp.getLoc();
256 fir::FirOpBuilder builder(rewriter, copyOutOp.getOperation());
257
258 builder.genIfThen(loc, copyOutOp.getWasCopied())
259 .genThen([&]() {
260 mlir::Value temp = copyOutOp.getTemp();
261 mlir::Value varMutableBox;
262 // Generate CopyOutAssign runtime call.
263 if (mlir::Value var = copyOutOp.getVar()) {
264 // Set the variable descriptor pointer in order to copy data from
265 // the temporary to the actualArg. Note that in case the actual
266 // argument is ALLOCATABLE/POINTER the CopyOutAssign()
267 // implementation should not engage its reallocation, because the
268 // temporary is rank, shape and type compatible with it. Moreover,
269 // CopyOutAssign() guarantees that there will be no finalization for
270 // the LHS even if it is of a derived type with finalization.
271 varMutableBox = builder.createTemporary(loc, var.getType());
272 builder.create<fir::StoreOp>(loc, var, varMutableBox);
273 } else {
274 // Even when there is no need to copy back the data (e.g., the dummy
275 // argument was intent(in), CopyOutAssign is called to
276 // destroy/deallocate the temporary.
277 varMutableBox = builder.create<fir::ZeroOp>(loc, temp.getType());
278 }
279 fir::runtime::genCopyOutAssign(builder, loc, varMutableBox,
280 copyOutOp.getTemp());
281 })
282 .end();
283 rewriter.eraseOp(copyOutOp);
284 return mlir::success();
285 }
286};
287
288class DeclareOpConversion : public mlir::OpRewritePattern<hlfir::DeclareOp> {
289public:
290 explicit DeclareOpConversion(mlir::MLIRContext *ctx)
291 : OpRewritePattern{ctx} {}
292
293 llvm::LogicalResult
294 matchAndRewrite(hlfir::DeclareOp declareOp,
295 mlir::PatternRewriter &rewriter) const override {
296 mlir::Location loc = declareOp->getLoc();
297 mlir::Value memref = declareOp.getMemref();
298 fir::FortranVariableFlagsAttr fortranAttrs;
299 cuf::DataAttributeAttr dataAttr;
300 if (auto attrs = declareOp.getFortranAttrs())
301 fortranAttrs =
302 fir::FortranVariableFlagsAttr::get(rewriter.getContext(), *attrs);
303 if (auto attr = declareOp.getDataAttr())
304 dataAttr = cuf::DataAttributeAttr::get(rewriter.getContext(), *attr);
305 auto firDeclareOp = rewriter.create<fir::DeclareOp>(
306 loc, memref.getType(), memref, declareOp.getShape(),
307 declareOp.getTypeparams(), declareOp.getDummyScope(),
308 declareOp.getUniqName(), fortranAttrs, dataAttr);
309
310 // Propagate other attributes from hlfir.declare to fir.declare.
311 // OpenACC's acc.declare is one example. Right now, the propagation
312 // is verbatim.
313 mlir::NamedAttrList elidedAttrs =
314 mlir::NamedAttrList{firDeclareOp->getAttrs()};
315 for (const mlir::NamedAttribute &attr : declareOp->getAttrs())
316 if (!elidedAttrs.get(attr.getName()))
317 firDeclareOp->setAttr(attr.getName(), attr.getValue());
318
319 auto firBase = firDeclareOp.getResult();
320 mlir::Value hlfirBase;
321 mlir::Type hlfirBaseType = declareOp.getBase().getType();
322 if (mlir::isa<fir::BaseBoxType>(hlfirBaseType)) {
323 fir::FirOpBuilder builder(rewriter, declareOp.getOperation());
324 // Helper to generate the hlfir fir.box with the local lower bounds and
325 // type parameters.
326 auto genHlfirBox = [&]() -> mlir::Value {
327 if (auto baseBoxType =
328 mlir::dyn_cast<fir::BaseBoxType>(firBase.getType())) {
329 // Rebox so that lower bounds are correct.
330 if (baseBoxType.isAssumedRank())
331 return builder.create<fir::ReboxAssumedRankOp>(
332 loc, hlfirBaseType, firBase,
333 fir::LowerBoundModifierAttribute::SetToOnes);
334 return builder.create<fir::ReboxOp>(loc, hlfirBaseType, firBase,
335 declareOp.getShape(),
336 /*slice=*/mlir::Value{});
337 } else {
338 llvm::SmallVector<mlir::Value> typeParams;
339 auto maybeCharType = mlir::dyn_cast<fir::CharacterType>(
340 fir::unwrapSequenceType(fir::unwrapPassByRefType(hlfirBaseType)));
341 if (!maybeCharType || maybeCharType.hasDynamicLen())
342 typeParams.append(declareOp.getTypeparams().begin(),
343 declareOp.getTypeparams().end());
344 return builder.create<fir::EmboxOp>(
345 loc, hlfirBaseType, firBase, declareOp.getShape(),
346 /*slice=*/mlir::Value{}, typeParams);
347 }
348 };
349 if (!mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation())
350 .isOptional()) {
351 hlfirBase = genHlfirBox();
352 // If the original base is a box too, we could as well
353 // use the HLFIR box as the FIR base: otherwise, the two
354 // boxes are "alive" at the same time, and the FIR box
355 // is used for accessing the base_addr and the HLFIR box
356 // is used for accessing the bounds etc. Using the HLFIR box,
357 // that holds the same base_addr at this point, makes
358 // the representation a little bit more clear.
359 if (hlfirBase.getType() == declareOp.getOriginalBase().getType())
360 firBase = hlfirBase;
361 } else {
362 // Need to conditionally rebox/embox the optional: the input fir.box
363 // may be null and the rebox would be illegal. It is also important to
364 // preserve the optional aspect: the hlfir fir.box should be null if
365 // the entity is absent so that later fir.is_present on the hlfir base
366 // are valid.
367 mlir::Value isPresent =
368 builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), firBase);
369 hlfirBase = builder
370 .genIfOp(loc, {hlfirBaseType}, isPresent,
371 /*withElseRegion=*/true)
372 .genThen([&] {
373 builder.create<fir::ResultOp>(loc, genHlfirBox());
374 })
375 .genElse([&]() {
376 mlir::Value absent =
377 builder.create<fir::AbsentOp>(loc, hlfirBaseType);
378 builder.create<fir::ResultOp>(loc, absent);
379 })
380 .getResults()[0];
381 }
382 } else if (mlir::isa<fir::BoxCharType>(hlfirBaseType)) {
383 assert(declareOp.getTypeparams().size() == 1 &&
384 "must contain character length");
385 hlfirBase = rewriter.create<fir::EmboxCharOp>(
386 loc, hlfirBaseType, firBase, declareOp.getTypeparams()[0]);
387 } else {
388 if (hlfirBaseType != firBase.getType()) {
389 declareOp.emitOpError()
390 << "unhandled HLFIR variable type '" << hlfirBaseType << "'\n";
391 return mlir::failure();
392 }
393 hlfirBase = firBase;
394 }
395 rewriter.replaceOp(declareOp, {hlfirBase, firBase});
396 return mlir::success();
397 }
398};
399
400class DesignateOpConversion
401 : public mlir::OpRewritePattern<hlfir::DesignateOp> {
402 // Helper method to generate the coordinate of the first element
403 // of an array section. It is also called for cases of non-section
404 // array element addressing.
405 static mlir::Value genSubscriptBeginAddr(
406 fir::FirOpBuilder &builder, mlir::Location loc,
407 hlfir::DesignateOp designate, mlir::Type baseEleTy, mlir::Value base,
408 mlir::Value shape,
409 const llvm::SmallVector<mlir::Value> &firBaseTypeParameters) {
410 assert(!designate.getIndices().empty());
411 llvm::SmallVector<mlir::Value> firstElementIndices;
412 auto indices = designate.getIndices();
413 int i = 0;
414 auto attrs = designate.getIsTripletAttr();
415 for (auto isTriplet : attrs.asArrayRef()) {
416 // Coordinate of the first element are the index and triplets lower
417 // bounds.
418 firstElementIndices.push_back(indices[i]);
419 i = i + (isTriplet ? 3 : 1);
420 }
421
422 mlir::Type originalDesignateType = designate.getResult().getType();
423 const bool isVolatile = fir::isa_volatile_type(originalDesignateType);
424 mlir::Type arrayCoorType = fir::ReferenceType::get(baseEleTy, isVolatile);
425
426 base = builder.create<fir::ArrayCoorOp>(
427 loc, arrayCoorType, base, shape,
428 /*slice=*/mlir::Value{}, firstElementIndices, firBaseTypeParameters);
429 return base;
430 }
431
432public:
433 explicit DesignateOpConversion(mlir::MLIRContext *ctx)
434 : OpRewritePattern{ctx} {}
435
436 llvm::LogicalResult
437 matchAndRewrite(hlfir::DesignateOp designate,
438 mlir::PatternRewriter &rewriter) const override {
439 mlir::Location loc = designate.getLoc();
440 fir::FirOpBuilder builder(rewriter, designate.getOperation());
441
442 hlfir::Entity baseEntity(designate.getMemref());
443
444 if (baseEntity.isMutableBox())
445 TODO(loc, "hlfir::designate load of pointer or allocatable");
446
447 mlir::Type designateResultType = designate.getResult().getType();
448 llvm::SmallVector<mlir::Value> firBaseTypeParameters;
449 auto [base, shape] = hlfir::genVariableFirBaseShapeAndParams(
450 loc, builder, baseEntity, firBaseTypeParameters);
451 const bool isVolatile = fir::isa_volatile_type(designateResultType) ||
452 fir::isa_volatile_type(base.getType());
453 mlir::Type baseEleTy = hlfir::getFortranElementType(base.getType());
454 mlir::Type resultEleTy = hlfir::getFortranElementType(designateResultType);
455
456 mlir::Value fieldIndex;
457 if (designate.getComponent()) {
458 mlir::Type baseRecordType = baseEntity.getFortranElementType();
459 if (fir::isRecordWithTypeParameters(baseRecordType))
460 TODO(loc, "hlfir.designate with a parametrized derived type base");
461 fieldIndex = builder.create<fir::FieldIndexOp>(
462 loc, fir::FieldType::get(builder.getContext()),
463 designate.getComponent().value(), baseRecordType,
464 /*typeParams=*/mlir::ValueRange{});
465 if (baseEntity.isScalar()) {
466 // Component refs of scalar base right away:
467 // - scalar%scalar_component [substring|complex_part] or
468 // - scalar%static_size_array_comp
469 // - scalar%array(indices) [substring| complex part]
470 mlir::Type componentType =
471 mlir::cast<fir::RecordType>(baseEleTy).getType(
472 designate.getComponent().value());
473 mlir::Type coorTy = fir::ReferenceType::get(componentType, isVolatile);
474
475 base = builder.create<fir::CoordinateOp>(loc, coorTy, base, fieldIndex);
476 if (mlir::isa<fir::BaseBoxType>(componentType)) {
477 auto variableInterface = mlir::cast<fir::FortranVariableOpInterface>(
478 designate.getOperation());
479 if (variableInterface.isAllocatable() ||
480 variableInterface.isPointer()) {
481 rewriter.replaceOp(designate, base);
482 return mlir::success();
483 }
484 TODO(loc,
485 "addressing parametrized derived type automatic components");
486 }
487 baseEleTy = hlfir::getFortranElementType(componentType);
488 shape = designate.getComponentShape();
489 } else {
490 // array%component[(indices) substring|complex part] cases.
491 // Component ref of array bases are dealt with below in embox/rebox.
492 assert(mlir::isa<fir::BaseBoxType>(designateResultType));
493 }
494 }
495
496 if (mlir::isa<fir::BaseBoxType>(designateResultType)) {
497 // Generate embox or rebox.
498 mlir::Type eleTy = fir::unwrapPassByRefType(designateResultType);
499 bool isScalarDesignator = !mlir::isa<fir::SequenceType>(eleTy);
500 mlir::Value sourceBox;
501 if (isScalarDesignator) {
502 // The base box will be used for emboxing the scalar element.
503 sourceBox = base;
504 // Generate the coordinate of the element.
505 base = genSubscriptBeginAddr(builder, loc, designate, baseEleTy, base,
506 shape, firBaseTypeParameters);
507 shape = nullptr;
508 // Type information will be taken from the source box,
509 // so the type parameters are not needed.
510 firBaseTypeParameters.clear();
511 }
512 llvm::SmallVector<mlir::Value> triples;
513 llvm::SmallVector<mlir::Value> sliceFields;
514 mlir::Type idxTy = builder.getIndexType();
515 auto subscripts = designate.getIndices();
516 if (fieldIndex && baseEntity.isArray()) {
517 // array%scalar_comp or array%array_comp(indices)
518 // Generate triples for array(:, :, ...).
519 triples = genFullSliceTriples(builder, loc, baseEntity);
520 sliceFields.push_back(fieldIndex);
521 // Add indices in the field path for "array%array_comp(indices)"
522 // case. The indices of components provided to the sliceOp must
523 // be zero based (fir.slice has no knowledge of the component
524 // lower bounds). The component lower bounds are applied here.
525 if (!subscripts.empty()) {
526 llvm::SmallVector<mlir::Value> lbounds = hlfir::genLowerbounds(
527 loc, builder, designate.getComponentShape(), subscripts.size());
528 for (auto [i, lb] : llvm::zip(subscripts, lbounds)) {
529 mlir::Value iIdx = builder.createConvert(loc, idxTy, i);
530 mlir::Value lbIdx = builder.createConvert(loc, idxTy, lb);
531 sliceFields.emplace_back(
532 builder.create<mlir::arith::SubIOp>(loc, iIdx, lbIdx));
533 }
534 }
535 } else if (!isScalarDesignator) {
536 // Otherwise, this is an array section with triplets.
537 auto undef = builder.create<fir::UndefOp>(loc, idxTy);
538 unsigned i = 0;
539 for (auto isTriplet : designate.getIsTriplet()) {
540 triples.push_back(subscripts[i++]);
541 if (isTriplet) {
542 triples.push_back(subscripts[i++]);
543 triples.push_back(subscripts[i++]);
544 } else {
545 triples.push_back(undef);
546 triples.push_back(undef);
547 }
548 }
549 }
550 llvm::SmallVector<mlir::Value, 2> substring;
551 if (!designate.getSubstring().empty()) {
552 substring.push_back(designate.getSubstring()[0]);
553 mlir::Type idxTy = builder.getIndexType();
554 // fir.slice op substring expects the zero based lower bound.
555 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
556 substring[0] = builder.createConvert(loc, idxTy, substring[0]);
557 substring[0] =
558 builder.create<mlir::arith::SubIOp>(loc, substring[0], one);
559 substring.push_back(designate.getTypeparams()[0]);
560 }
561 if (designate.getComplexPart()) {
562 if (triples.empty())
563 triples = genFullSliceTriples(builder, loc, baseEntity);
564 sliceFields.push_back(builder.createIntegerConstant(
565 loc, idxTy, *designate.getComplexPart()));
566 }
567 mlir::Value slice;
568 if (!triples.empty())
569 slice =
570 builder.create<fir::SliceOp>(loc, triples, sliceFields, substring);
571 else
572 assert(sliceFields.empty() && substring.empty());
573
574 llvm::SmallVector<mlir::Type> resultType{
575 fir::updateTypeWithVolatility(designateResultType, isVolatile)};
576
577 mlir::Value resultBox;
578 if (mlir::isa<fir::BaseBoxType>(base.getType())) {
579 resultBox =
580 builder.create<fir::ReboxOp>(loc, resultType, base, shape, slice);
581 } else {
582 resultBox =
583 builder.create<fir::EmboxOp>(loc, resultType, base, shape, slice,
584 firBaseTypeParameters, sourceBox);
585 }
586 rewriter.replaceOp(designate, resultBox);
587 return mlir::success();
588 }
589
590 // Otherwise, the result is the address of a scalar, or the address of the
591 // first element of a contiguous array section with compile time constant
592 // shape. The base may be an array, or a scalar.
593 mlir::Type resultAddressType = designateResultType;
594 if (auto boxCharType =
595 mlir::dyn_cast<fir::BoxCharType>(designateResultType))
596 resultAddressType =
597 fir::ReferenceType::get(boxCharType.getEleTy(), isVolatile);
598
599 // Array element indexing.
600 if (!designate.getIndices().empty()) {
601 // - array(indices) [substring|complex_part] or
602 // - scalar%array_comp(indices) [substring|complex_part]
603 // This may be a ranked contiguous array section in which case
604 // The first element address is being computed.
605 base = genSubscriptBeginAddr(builder, loc, designate, baseEleTy, base,
606 shape, firBaseTypeParameters);
607 }
608
609 // Scalar substring (potentially on the previously built array element or
610 // component reference).
611 if (!designate.getSubstring().empty())
612 base = fir::factory::CharacterExprHelper{builder, loc}.genSubstringBase(
613 base, designate.getSubstring()[0], resultAddressType);
614
615 // Scalar complex part ref
616 if (designate.getComplexPart()) {
617 // Sequence types should have already been handled by this point
618 assert(!mlir::isa<fir::SequenceType>(designateResultType));
619 auto index = builder.createIntegerConstant(loc, builder.getIndexType(),
620 *designate.getComplexPart());
621 auto coorTy = fir::ReferenceType::get(resultEleTy, isVolatile);
622
623 base = builder.create<fir::CoordinateOp>(loc, coorTy, base, index);
624 }
625
626 // Cast/embox the computed scalar address if needed.
627 if (mlir::isa<fir::BoxCharType>(designateResultType)) {
628 assert(designate.getTypeparams().size() == 1 &&
629 "must have character length");
630 auto emboxChar = builder.create<fir::EmboxCharOp>(
631 loc, designateResultType, base, designate.getTypeparams()[0]);
632
633 rewriter.replaceOp(designate, emboxChar.getResult());
634 } else {
635 base = builder.createConvert(loc, designateResultType, base);
636
637 rewriter.replaceOp(designate, base);
638 }
639 return mlir::success();
640 }
641
642private:
643 // Generates triple for full slice
644 // Used for component and complex part slices when a triple is
645 // not specified
646 static llvm::SmallVector<mlir::Value>
647 genFullSliceTriples(fir::FirOpBuilder &builder, mlir::Location loc,
648 hlfir::Entity baseEntity) {
649 llvm::SmallVector<mlir::Value> triples;
650 mlir::Type idxTy = builder.getIndexType();
651 auto one = builder.createIntegerConstant(loc, idxTy, 1);
652 for (auto [lb, ub] : hlfir::genBounds(loc, builder, baseEntity)) {
653 triples.push_back(builder.createConvert(loc, idxTy, lb));
654 triples.push_back(builder.createConvert(loc, idxTy, ub));
655 triples.push_back(one);
656 }
657 return triples;
658 }
659};
660
661class ParentComponentOpConversion
662 : public mlir::OpRewritePattern<hlfir::ParentComponentOp> {
663public:
664 explicit ParentComponentOpConversion(mlir::MLIRContext *ctx)
665 : OpRewritePattern{ctx} {}
666
667 llvm::LogicalResult
668 matchAndRewrite(hlfir::ParentComponentOp parentComponent,
669 mlir::PatternRewriter &rewriter) const override {
670 mlir::Location loc = parentComponent.getLoc();
671 mlir::Type resultType = parentComponent.getType();
672 if (!mlir::isa<fir::BoxType>(parentComponent.getType())) {
673 mlir::Value baseAddr = parentComponent.getMemref();
674 // Scalar parent component ref without any length type parameters. The
675 // input may be a fir.class if it is polymorphic, since this is a scalar
676 // and the output will be monomorphic, the base address can be extracted
677 // from the fir.class.
678 if (mlir::isa<fir::BaseBoxType>(baseAddr.getType()))
679 baseAddr = rewriter.create<fir::BoxAddrOp>(loc, baseAddr);
680 rewriter.replaceOpWithNewOp<fir::ConvertOp>(parentComponent, resultType,
681 baseAddr);
682 return mlir::success();
683 }
684 // Array parent component ref or PDTs.
685 hlfir::Entity base{parentComponent.getMemref()};
686 mlir::Value baseAddr = base.getBase();
687 if (!mlir::isa<fir::BaseBoxType>(baseAddr.getType())) {
688 // Embox cannot directly be used to address parent components: it expects
689 // the output type to match the input type when there are no slices. When
690 // the types have at least one component, a slice to the first element can
691 // be built, and the result set to the parent component type. Just create
692 // a fir.box with the base for now since this covers all cases.
693 mlir::Type baseBoxType =
694 fir::BoxType::get(base.getElementOrSequenceType());
695 assert(!base.hasLengthParameters() &&
696 "base must be a box if it has any type parameters");
697 baseAddr = rewriter.create<fir::EmboxOp>(
698 loc, baseBoxType, baseAddr, parentComponent.getShape(),
699 /*slice=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{});
700 }
701 rewriter.replaceOpWithNewOp<fir::ReboxOp>(parentComponent, resultType,
702 baseAddr,
703 /*shape=*/mlir::Value{},
704 /*slice=*/mlir::Value{});
705 return mlir::success();
706 }
707};
708
709class NoReassocOpConversion
710 : public mlir::OpRewritePattern<hlfir::NoReassocOp> {
711public:
712 explicit NoReassocOpConversion(mlir::MLIRContext *ctx)
713 : OpRewritePattern{ctx} {}
714
715 llvm::LogicalResult
716 matchAndRewrite(hlfir::NoReassocOp noreassoc,
717 mlir::PatternRewriter &rewriter) const override {
718 rewriter.replaceOpWithNewOp<fir::NoReassocOp>(noreassoc,
719 noreassoc.getVal());
720 return mlir::success();
721 }
722};
723
724class NullOpConversion : public mlir::OpRewritePattern<hlfir::NullOp> {
725public:
726 explicit NullOpConversion(mlir::MLIRContext *ctx) : OpRewritePattern{ctx} {}
727
728 llvm::LogicalResult
729 matchAndRewrite(hlfir::NullOp nullop,
730 mlir::PatternRewriter &rewriter) const override {
731 rewriter.replaceOpWithNewOp<fir::ZeroOp>(nullop, nullop.getType());
732 return mlir::success();
733 }
734};
735
736class GetExtentOpConversion
737 : public mlir::OpRewritePattern<hlfir::GetExtentOp> {
738public:
739 using mlir::OpRewritePattern<hlfir::GetExtentOp>::OpRewritePattern;
740
741 llvm::LogicalResult
742 matchAndRewrite(hlfir::GetExtentOp getExtentOp,
743 mlir::PatternRewriter &rewriter) const override {
744 mlir::Value shape = getExtentOp.getShape();
745 mlir::Operation *shapeOp = shape.getDefiningOp();
746 // the hlfir.shape_of operation which led to the creation of this get_extent
747 // operation should now have been lowered to a fir.shape operation
748 if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
749 fir::ShapeType shapeTy = mlir::cast<fir::ShapeType>(shape.getType());
750 llvm::APInt dim = getExtentOp.getDim();
751 uint64_t dimVal = dim.getLimitedValue(shapeTy.getRank());
752 mlir::Value extent = s.getExtents()[dimVal];
753 fir::FirOpBuilder builder(rewriter, getExtentOp.getOperation());
754 extent = builder.createConvert(getExtentOp.getLoc(),
755 builder.getIndexType(), extent);
756 rewriter.replaceOp(getExtentOp, extent);
757 return mlir::success();
758 }
759 return mlir::failure();
760 }
761};
762
763class ConvertHLFIRtoFIR
764 : public hlfir::impl::ConvertHLFIRtoFIRBase<ConvertHLFIRtoFIR> {
765public:
766 void runOnOperation() override {
767 // TODO: like "bufferize-hlfir" pass, runtime signature may be added
768 // by this pass. This requires the pass to run on the ModuleOp. It would
769 // probably be more optimal to have it run on FuncOp and find a way to
770 // generate the signatures in a thread safe way.
771 auto module = this->getOperation();
772 auto *context = &getContext();
773 mlir::RewritePatternSet patterns(context);
774 patterns.insert<AssignOpConversion, CopyInOpConversion, CopyOutOpConversion,
775 DeclareOpConversion, DesignateOpConversion,
776 GetExtentOpConversion, NoReassocOpConversion,
777 NullOpConversion, ParentComponentOpConversion>(context);
778 mlir::ConversionTarget target(*context);
779 target.addIllegalDialect<hlfir::hlfirDialect>();
780 target.markUnknownOpDynamicallyLegal(
781 [](mlir::Operation *) { return true; });
782 if (mlir::failed(mlir::applyPartialConversion(module, target,
783 std::move(patterns)))) {
784 mlir::emitError(mlir::UnknownLoc::get(context),
785 "failure in HLFIR to FIR conversion pass");
786 signalPassFailure();
787 }
788 }
789};
790
791} // namespace
792

source code of flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp