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 and attributes are correct.
330 if (baseBoxType.isAssumedRank())
331 return builder.create<fir::ReboxAssumedRankOp>(
332 loc, hlfirBaseType, firBase,
333 fir::LowerBoundModifierAttribute::SetToOnes);
334 if (!fir::extractSequenceType(baseBoxType.getEleTy()) &&
335 baseBoxType == hlfirBaseType)
336 return firBase;
337 return builder.create<fir::ReboxOp>(loc, hlfirBaseType, firBase,
338 declareOp.getShape(),
339 /*slice=*/mlir::Value{});
340 } else {
341 llvm::SmallVector<mlir::Value> typeParams;
342 auto maybeCharType = mlir::dyn_cast<fir::CharacterType>(
343 fir::unwrapSequenceType(fir::unwrapPassByRefType(hlfirBaseType)));
344 if (!maybeCharType || maybeCharType.hasDynamicLen())
345 typeParams.append(declareOp.getTypeparams().begin(),
346 declareOp.getTypeparams().end());
347 return builder.create<fir::EmboxOp>(
348 loc, hlfirBaseType, firBase, declareOp.getShape(),
349 /*slice=*/mlir::Value{}, typeParams);
350 }
351 };
352 if (!mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation())
353 .isOptional()) {
354 hlfirBase = genHlfirBox();
355 // If the original base is a box too, we could as well
356 // use the HLFIR box as the FIR base: otherwise, the two
357 // boxes are "alive" at the same time, and the FIR box
358 // is used for accessing the base_addr and the HLFIR box
359 // is used for accessing the bounds etc. Using the HLFIR box,
360 // that holds the same base_addr at this point, makes
361 // the representation a little bit more clear.
362 if (hlfirBase.getType() == declareOp.getOriginalBase().getType())
363 firBase = hlfirBase;
364 } else {
365 // Need to conditionally rebox/embox the optional: the input fir.box
366 // may be null and the rebox would be illegal. It is also important to
367 // preserve the optional aspect: the hlfir fir.box should be null if
368 // the entity is absent so that later fir.is_present on the hlfir base
369 // are valid.
370 mlir::Value isPresent =
371 builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), firBase);
372 hlfirBase = builder
373 .genIfOp(loc, {hlfirBaseType}, isPresent,
374 /*withElseRegion=*/true)
375 .genThen([&] {
376 builder.create<fir::ResultOp>(loc, genHlfirBox());
377 })
378 .genElse([&]() {
379 mlir::Value absent =
380 builder.create<fir::AbsentOp>(loc, hlfirBaseType);
381 builder.create<fir::ResultOp>(loc, absent);
382 })
383 .getResults()[0];
384 }
385 } else if (mlir::isa<fir::BoxCharType>(hlfirBaseType)) {
386 assert(declareOp.getTypeparams().size() == 1 &&
387 "must contain character length");
388 hlfirBase = rewriter.create<fir::EmboxCharOp>(
389 loc, hlfirBaseType, firBase, declareOp.getTypeparams()[0]);
390 } else {
391 if (hlfirBaseType != firBase.getType()) {
392 declareOp.emitOpError()
393 << "unhandled HLFIR variable type '" << hlfirBaseType << "'\n";
394 return mlir::failure();
395 }
396 hlfirBase = firBase;
397 }
398 rewriter.replaceOp(declareOp, {hlfirBase, firBase});
399 return mlir::success();
400 }
401};
402
403class DesignateOpConversion
404 : public mlir::OpRewritePattern<hlfir::DesignateOp> {
405 // Helper method to generate the coordinate of the first element
406 // of an array section. It is also called for cases of non-section
407 // array element addressing.
408 static mlir::Value genSubscriptBeginAddr(
409 fir::FirOpBuilder &builder, mlir::Location loc,
410 hlfir::DesignateOp designate, mlir::Type baseEleTy, mlir::Value base,
411 mlir::Value shape,
412 const llvm::SmallVector<mlir::Value> &firBaseTypeParameters) {
413 assert(!designate.getIndices().empty());
414 llvm::SmallVector<mlir::Value> firstElementIndices;
415 auto indices = designate.getIndices();
416 int i = 0;
417 auto attrs = designate.getIsTripletAttr();
418 for (auto isTriplet : attrs.asArrayRef()) {
419 // Coordinate of the first element are the index and triplets lower
420 // bounds.
421 firstElementIndices.push_back(indices[i]);
422 i = i + (isTriplet ? 3 : 1);
423 }
424
425 mlir::Type originalDesignateType = designate.getResult().getType();
426 const bool isVolatile = fir::isa_volatile_type(originalDesignateType);
427 mlir::Type arrayCoorType = fir::ReferenceType::get(baseEleTy, isVolatile);
428
429 base = builder.create<fir::ArrayCoorOp>(
430 loc, arrayCoorType, base, shape,
431 /*slice=*/mlir::Value{}, firstElementIndices, firBaseTypeParameters);
432 return base;
433 }
434
435public:
436 explicit DesignateOpConversion(mlir::MLIRContext *ctx)
437 : OpRewritePattern{ctx} {}
438
439 llvm::LogicalResult
440 matchAndRewrite(hlfir::DesignateOp designate,
441 mlir::PatternRewriter &rewriter) const override {
442 mlir::Location loc = designate.getLoc();
443 fir::FirOpBuilder builder(rewriter, designate.getOperation());
444
445 hlfir::Entity baseEntity(designate.getMemref());
446
447 if (baseEntity.isMutableBox())
448 TODO(loc, "hlfir::designate load of pointer or allocatable");
449
450 mlir::Type designateResultType = designate.getResult().getType();
451 llvm::SmallVector<mlir::Value> firBaseTypeParameters;
452 auto [base, shape] = hlfir::genVariableFirBaseShapeAndParams(
453 loc, builder, baseEntity, firBaseTypeParameters);
454 const bool isVolatile = fir::isa_volatile_type(designateResultType) ||
455 fir::isa_volatile_type(base.getType());
456 mlir::Type baseEleTy = hlfir::getFortranElementType(base.getType());
457 mlir::Type resultEleTy = hlfir::getFortranElementType(designateResultType);
458
459 mlir::Value fieldIndex;
460 if (designate.getComponent()) {
461 mlir::Type baseRecordType = baseEntity.getFortranElementType();
462 if (fir::isRecordWithTypeParameters(baseRecordType))
463 TODO(loc, "hlfir.designate with a parametrized derived type base");
464 fieldIndex = builder.create<fir::FieldIndexOp>(
465 loc, fir::FieldType::get(builder.getContext()),
466 designate.getComponent().value(), baseRecordType,
467 /*typeParams=*/mlir::ValueRange{});
468 if (baseEntity.isScalar()) {
469 // Component refs of scalar base right away:
470 // - scalar%scalar_component [substring|complex_part] or
471 // - scalar%static_size_array_comp
472 // - scalar%array(indices) [substring| complex part]
473 mlir::Type componentType =
474 mlir::cast<fir::RecordType>(baseEleTy).getType(
475 designate.getComponent().value());
476 mlir::Type coorTy = fir::ReferenceType::get(componentType, isVolatile);
477
478 base = builder.create<fir::CoordinateOp>(loc, coorTy, base, fieldIndex);
479 if (mlir::isa<fir::BaseBoxType>(componentType)) {
480 auto variableInterface = mlir::cast<fir::FortranVariableOpInterface>(
481 designate.getOperation());
482 if (variableInterface.isAllocatable() ||
483 variableInterface.isPointer()) {
484 rewriter.replaceOp(designate, base);
485 return mlir::success();
486 }
487 TODO(loc,
488 "addressing parametrized derived type automatic components");
489 }
490 baseEleTy = hlfir::getFortranElementType(componentType);
491 shape = designate.getComponentShape();
492 } else {
493 // array%component[(indices) substring|complex part] cases.
494 // Component ref of array bases are dealt with below in embox/rebox.
495 assert(mlir::isa<fir::BaseBoxType>(designateResultType));
496 }
497 }
498
499 if (mlir::isa<fir::BaseBoxType>(designateResultType)) {
500 // Generate embox or rebox.
501 mlir::Type eleTy = fir::unwrapPassByRefType(designateResultType);
502 bool isScalarDesignator = !mlir::isa<fir::SequenceType>(eleTy);
503 mlir::Value sourceBox;
504 if (isScalarDesignator) {
505 // The base box will be used for emboxing the scalar element.
506 sourceBox = base;
507 // Generate the coordinate of the element.
508 base = genSubscriptBeginAddr(builder, loc, designate, baseEleTy, base,
509 shape, firBaseTypeParameters);
510 shape = nullptr;
511 // Type information will be taken from the source box,
512 // so the type parameters are not needed.
513 firBaseTypeParameters.clear();
514 }
515 llvm::SmallVector<mlir::Value> triples;
516 llvm::SmallVector<mlir::Value> sliceFields;
517 mlir::Type idxTy = builder.getIndexType();
518 auto subscripts = designate.getIndices();
519 if (fieldIndex && baseEntity.isArray()) {
520 // array%scalar_comp or array%array_comp(indices)
521 // Generate triples for array(:, :, ...).
522 triples = genFullSliceTriples(builder, loc, baseEntity);
523 sliceFields.push_back(fieldIndex);
524 // Add indices in the field path for "array%array_comp(indices)"
525 // case. The indices of components provided to the sliceOp must
526 // be zero based (fir.slice has no knowledge of the component
527 // lower bounds). The component lower bounds are applied here.
528 if (!subscripts.empty()) {
529 llvm::SmallVector<mlir::Value> lbounds = hlfir::genLowerbounds(
530 loc, builder, designate.getComponentShape(), subscripts.size());
531 for (auto [i, lb] : llvm::zip(subscripts, lbounds)) {
532 mlir::Value iIdx = builder.createConvert(loc, idxTy, i);
533 mlir::Value lbIdx = builder.createConvert(loc, idxTy, lb);
534 sliceFields.emplace_back(
535 builder.create<mlir::arith::SubIOp>(loc, iIdx, lbIdx));
536 }
537 }
538 } else if (!isScalarDesignator) {
539 // Otherwise, this is an array section with triplets.
540 auto undef = builder.create<fir::UndefOp>(loc, idxTy);
541 unsigned i = 0;
542 for (auto isTriplet : designate.getIsTriplet()) {
543 triples.push_back(subscripts[i++]);
544 if (isTriplet) {
545 triples.push_back(subscripts[i++]);
546 triples.push_back(subscripts[i++]);
547 } else {
548 triples.push_back(undef);
549 triples.push_back(undef);
550 }
551 }
552 }
553 llvm::SmallVector<mlir::Value, 2> substring;
554 if (!designate.getSubstring().empty()) {
555 substring.push_back(designate.getSubstring()[0]);
556 mlir::Type idxTy = builder.getIndexType();
557 // fir.slice op substring expects the zero based lower bound.
558 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
559 substring[0] = builder.createConvert(loc, idxTy, substring[0]);
560 substring[0] =
561 builder.create<mlir::arith::SubIOp>(loc, substring[0], one);
562 substring.push_back(designate.getTypeparams()[0]);
563 }
564 if (designate.getComplexPart()) {
565 if (triples.empty())
566 triples = genFullSliceTriples(builder, loc, baseEntity);
567 sliceFields.push_back(builder.createIntegerConstant(
568 loc, idxTy, *designate.getComplexPart()));
569 }
570 mlir::Value slice;
571 if (!triples.empty())
572 slice =
573 builder.create<fir::SliceOp>(loc, triples, sliceFields, substring);
574 else
575 assert(sliceFields.empty() && substring.empty());
576
577 llvm::SmallVector<mlir::Type> resultType{
578 fir::updateTypeWithVolatility(designateResultType, isVolatile)};
579
580 mlir::Value resultBox;
581 if (mlir::isa<fir::BaseBoxType>(base.getType())) {
582 resultBox =
583 builder.create<fir::ReboxOp>(loc, resultType, base, shape, slice);
584 } else {
585 resultBox =
586 builder.create<fir::EmboxOp>(loc, resultType, base, shape, slice,
587 firBaseTypeParameters, sourceBox);
588 }
589 rewriter.replaceOp(designate, resultBox);
590 return mlir::success();
591 }
592
593 // Otherwise, the result is the address of a scalar, or the address of the
594 // first element of a contiguous array section with compile time constant
595 // shape. The base may be an array, or a scalar.
596 mlir::Type resultAddressType = designateResultType;
597 if (auto boxCharType =
598 mlir::dyn_cast<fir::BoxCharType>(designateResultType))
599 resultAddressType =
600 fir::ReferenceType::get(boxCharType.getEleTy(), isVolatile);
601
602 // Array element indexing.
603 if (!designate.getIndices().empty()) {
604 // - array(indices) [substring|complex_part] or
605 // - scalar%array_comp(indices) [substring|complex_part]
606 // This may be a ranked contiguous array section in which case
607 // The first element address is being computed.
608 base = genSubscriptBeginAddr(builder, loc, designate, baseEleTy, base,
609 shape, firBaseTypeParameters);
610 }
611
612 // Scalar substring (potentially on the previously built array element or
613 // component reference).
614 if (!designate.getSubstring().empty())
615 base = fir::factory::CharacterExprHelper{builder, loc}.genSubstringBase(
616 base, designate.getSubstring()[0], resultAddressType);
617
618 // Scalar complex part ref
619 if (designate.getComplexPart()) {
620 // Sequence types should have already been handled by this point
621 assert(!mlir::isa<fir::SequenceType>(designateResultType));
622 auto index = builder.createIntegerConstant(loc, builder.getIndexType(),
623 *designate.getComplexPart());
624 auto coorTy = fir::ReferenceType::get(resultEleTy, isVolatile);
625
626 base = builder.create<fir::CoordinateOp>(loc, coorTy, base, index);
627 }
628
629 // Cast/embox the computed scalar address if needed.
630 if (mlir::isa<fir::BoxCharType>(designateResultType)) {
631 assert(designate.getTypeparams().size() == 1 &&
632 "must have character length");
633 auto emboxChar = builder.create<fir::EmboxCharOp>(
634 loc, designateResultType, base, designate.getTypeparams()[0]);
635
636 rewriter.replaceOp(designate, emboxChar.getResult());
637 } else {
638 base = builder.createConvert(loc, designateResultType, base);
639
640 rewriter.replaceOp(designate, base);
641 }
642 return mlir::success();
643 }
644
645private:
646 // Generates triple for full slice
647 // Used for component and complex part slices when a triple is
648 // not specified
649 static llvm::SmallVector<mlir::Value>
650 genFullSliceTriples(fir::FirOpBuilder &builder, mlir::Location loc,
651 hlfir::Entity baseEntity) {
652 llvm::SmallVector<mlir::Value> triples;
653 mlir::Type idxTy = builder.getIndexType();
654 auto one = builder.createIntegerConstant(loc, idxTy, 1);
655 for (auto [lb, ub] : hlfir::genBounds(loc, builder, baseEntity)) {
656 triples.push_back(builder.createConvert(loc, idxTy, lb));
657 triples.push_back(builder.createConvert(loc, idxTy, ub));
658 triples.push_back(one);
659 }
660 return triples;
661 }
662};
663
664class ParentComponentOpConversion
665 : public mlir::OpRewritePattern<hlfir::ParentComponentOp> {
666public:
667 explicit ParentComponentOpConversion(mlir::MLIRContext *ctx)
668 : OpRewritePattern{ctx} {}
669
670 llvm::LogicalResult
671 matchAndRewrite(hlfir::ParentComponentOp parentComponent,
672 mlir::PatternRewriter &rewriter) const override {
673 mlir::Location loc = parentComponent.getLoc();
674 mlir::Type resultType = parentComponent.getType();
675 if (!mlir::isa<fir::BoxType>(parentComponent.getType())) {
676 mlir::Value baseAddr = parentComponent.getMemref();
677 // Scalar parent component ref without any length type parameters. The
678 // input may be a fir.class if it is polymorphic, since this is a scalar
679 // and the output will be monomorphic, the base address can be extracted
680 // from the fir.class.
681 if (mlir::isa<fir::BaseBoxType>(baseAddr.getType()))
682 baseAddr = rewriter.create<fir::BoxAddrOp>(loc, baseAddr);
683 rewriter.replaceOpWithNewOp<fir::ConvertOp>(parentComponent, resultType,
684 baseAddr);
685 return mlir::success();
686 }
687 // Array parent component ref or PDTs.
688 hlfir::Entity base{parentComponent.getMemref()};
689 mlir::Value baseAddr = base.getBase();
690 if (!mlir::isa<fir::BaseBoxType>(baseAddr.getType())) {
691 // Embox cannot directly be used to address parent components: it expects
692 // the output type to match the input type when there are no slices. When
693 // the types have at least one component, a slice to the first element can
694 // be built, and the result set to the parent component type. Just create
695 // a fir.box with the base for now since this covers all cases.
696 mlir::Type baseBoxType =
697 fir::BoxType::get(base.getElementOrSequenceType());
698 assert(!base.hasLengthParameters() &&
699 "base must be a box if it has any type parameters");
700 baseAddr = rewriter.create<fir::EmboxOp>(
701 loc, baseBoxType, baseAddr, parentComponent.getShape(),
702 /*slice=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{});
703 }
704 rewriter.replaceOpWithNewOp<fir::ReboxOp>(parentComponent, resultType,
705 baseAddr,
706 /*shape=*/mlir::Value{},
707 /*slice=*/mlir::Value{});
708 return mlir::success();
709 }
710};
711
712class NoReassocOpConversion
713 : public mlir::OpRewritePattern<hlfir::NoReassocOp> {
714public:
715 explicit NoReassocOpConversion(mlir::MLIRContext *ctx)
716 : OpRewritePattern{ctx} {}
717
718 llvm::LogicalResult
719 matchAndRewrite(hlfir::NoReassocOp noreassoc,
720 mlir::PatternRewriter &rewriter) const override {
721 rewriter.replaceOpWithNewOp<fir::NoReassocOp>(noreassoc,
722 noreassoc.getVal());
723 return mlir::success();
724 }
725};
726
727class NullOpConversion : public mlir::OpRewritePattern<hlfir::NullOp> {
728public:
729 explicit NullOpConversion(mlir::MLIRContext *ctx) : OpRewritePattern{ctx} {}
730
731 llvm::LogicalResult
732 matchAndRewrite(hlfir::NullOp nullop,
733 mlir::PatternRewriter &rewriter) const override {
734 rewriter.replaceOpWithNewOp<fir::ZeroOp>(nullop, nullop.getType());
735 return mlir::success();
736 }
737};
738
739class GetExtentOpConversion
740 : public mlir::OpRewritePattern<hlfir::GetExtentOp> {
741public:
742 using mlir::OpRewritePattern<hlfir::GetExtentOp>::OpRewritePattern;
743
744 llvm::LogicalResult
745 matchAndRewrite(hlfir::GetExtentOp getExtentOp,
746 mlir::PatternRewriter &rewriter) const override {
747 mlir::Value shape = getExtentOp.getShape();
748 mlir::Operation *shapeOp = shape.getDefiningOp();
749 // the hlfir.shape_of operation which led to the creation of this get_extent
750 // operation should now have been lowered to a fir.shape operation
751 if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
752 fir::ShapeType shapeTy = mlir::cast<fir::ShapeType>(shape.getType());
753 llvm::APInt dim = getExtentOp.getDim();
754 uint64_t dimVal = dim.getLimitedValue(shapeTy.getRank());
755 mlir::Value extent = s.getExtents()[dimVal];
756 fir::FirOpBuilder builder(rewriter, getExtentOp.getOperation());
757 extent = builder.createConvert(getExtentOp.getLoc(),
758 builder.getIndexType(), extent);
759 rewriter.replaceOp(getExtentOp, extent);
760 return mlir::success();
761 }
762 return mlir::failure();
763 }
764};
765
766class ConvertHLFIRtoFIR
767 : public hlfir::impl::ConvertHLFIRtoFIRBase<ConvertHLFIRtoFIR> {
768public:
769 void runOnOperation() override {
770 // TODO: like "bufferize-hlfir" pass, runtime signature may be added
771 // by this pass. This requires the pass to run on the ModuleOp. It would
772 // probably be more optimal to have it run on FuncOp and find a way to
773 // generate the signatures in a thread safe way.
774 auto module = this->getOperation();
775 auto *context = &getContext();
776 mlir::RewritePatternSet patterns(context);
777 patterns.insert<AssignOpConversion, CopyInOpConversion, CopyOutOpConversion,
778 DeclareOpConversion, DesignateOpConversion,
779 GetExtentOpConversion, NoReassocOpConversion,
780 NullOpConversion, ParentComponentOpConversion>(context);
781 mlir::ConversionTarget target(*context);
782 target.addIllegalDialect<hlfir::hlfirDialect>();
783 target.markUnknownOpDynamicallyLegal(
784 [](mlir::Operation *) { return true; });
785 if (mlir::failed(mlir::applyPartialConversion(module, target,
786 std::move(patterns)))) {
787 mlir::emitError(mlir::UnknownLoc::get(context),
788 "failure in HLFIR to FIR conversion pass");
789 signalPassFailure();
790 }
791 }
792};
793
794} // namespace
795

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