xref: /llvm-project/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp (revision 2f077dfbdf769d2e568ccdcda0e1937af046f81f)
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 
27 namespace hlfir {
28 #define GEN_PASS_DEF_CONVERTHLFIRTOFIR
29 #include "flang/Optimizer/HLFIR/Passes.h.inc"
30 } // namespace hlfir
31 
32 using namespace mlir;
33 
34 namespace {
35 /// May \p lhs alias with \p rhs?
36 /// TODO: implement HLFIR alias analysis.
37 class AssignOpConversion : public mlir::OpRewritePattern<hlfir::AssignOp> {
38 public:
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 
164 class CopyInOpConversion : public mlir::OpRewritePattern<hlfir::CopyInOp> {
165 public:
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 
247 class CopyOutOpConversion : public mlir::OpRewritePattern<hlfir::CopyOutOp> {
248 public:
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 
288 class DeclareOpConversion : public mlir::OpRewritePattern<hlfir::DeclareOp> {
289 public:
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() == firBase.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 
400 class 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     mlir::Type arrayCoorType = fir::ReferenceType::get(baseEleTy);
422     base = builder.create<fir::ArrayCoorOp>(
423         loc, arrayCoorType, base, shape,
424         /*slice=*/mlir::Value{}, firstElementIndices, firBaseTypeParameters);
425     return base;
426   }
427 
428 public:
429   explicit DesignateOpConversion(mlir::MLIRContext *ctx)
430       : OpRewritePattern{ctx} {}
431 
432   llvm::LogicalResult
433   matchAndRewrite(hlfir::DesignateOp designate,
434                   mlir::PatternRewriter &rewriter) const override {
435     mlir::Location loc = designate.getLoc();
436     fir::FirOpBuilder builder(rewriter, designate.getOperation());
437 
438     hlfir::Entity baseEntity(designate.getMemref());
439 
440     if (baseEntity.isMutableBox())
441       TODO(loc, "hlfir::designate load of pointer or allocatable");
442 
443     mlir::Type designateResultType = designate.getResult().getType();
444     llvm::SmallVector<mlir::Value> firBaseTypeParameters;
445     auto [base, shape] = hlfir::genVariableFirBaseShapeAndParams(
446         loc, builder, baseEntity, firBaseTypeParameters);
447     mlir::Type baseEleTy = hlfir::getFortranElementType(base.getType());
448     mlir::Type resultEleTy = hlfir::getFortranElementType(designateResultType);
449 
450     mlir::Value fieldIndex;
451     if (designate.getComponent()) {
452       mlir::Type baseRecordType = baseEntity.getFortranElementType();
453       if (fir::isRecordWithTypeParameters(baseRecordType))
454         TODO(loc, "hlfir.designate with a parametrized derived type base");
455       fieldIndex = builder.create<fir::FieldIndexOp>(
456           loc, fir::FieldType::get(builder.getContext()),
457           designate.getComponent().value(), baseRecordType,
458           /*typeParams=*/mlir::ValueRange{});
459       if (baseEntity.isScalar()) {
460         // Component refs of scalar base right away:
461         // - scalar%scalar_component [substring|complex_part] or
462         // - scalar%static_size_array_comp
463         // - scalar%array(indices) [substring| complex part]
464         mlir::Type componentType =
465             mlir::cast<fir::RecordType>(baseEleTy).getType(
466                 designate.getComponent().value());
467         mlir::Type coorTy = fir::ReferenceType::get(componentType);
468         base = builder.create<fir::CoordinateOp>(loc, coorTy, base, fieldIndex);
469         if (mlir::isa<fir::BaseBoxType>(componentType)) {
470           auto variableInterface = mlir::cast<fir::FortranVariableOpInterface>(
471               designate.getOperation());
472           if (variableInterface.isAllocatable() ||
473               variableInterface.isPointer()) {
474             rewriter.replaceOp(designate, base);
475             return mlir::success();
476           }
477           TODO(loc,
478                "addressing parametrized derived type automatic components");
479         }
480         baseEleTy = hlfir::getFortranElementType(componentType);
481         shape = designate.getComponentShape();
482       } else {
483         // array%component[(indices) substring|complex part] cases.
484         // Component ref of array bases are dealt with below in embox/rebox.
485         assert(mlir::isa<fir::BaseBoxType>(designateResultType));
486       }
487     }
488 
489     if (mlir::isa<fir::BaseBoxType>(designateResultType)) {
490       // Generate embox or rebox.
491       mlir::Type eleTy = fir::unwrapPassByRefType(designateResultType);
492       bool isScalarDesignator = !mlir::isa<fir::SequenceType>(eleTy);
493       mlir::Value sourceBox;
494       if (isScalarDesignator) {
495         // The base box will be used for emboxing the scalar element.
496         sourceBox = base;
497         // Generate the coordinate of the element.
498         base = genSubscriptBeginAddr(builder, loc, designate, baseEleTy, base,
499                                      shape, firBaseTypeParameters);
500         shape = nullptr;
501         // Type information will be taken from the source box,
502         // so the type parameters are not needed.
503         firBaseTypeParameters.clear();
504       }
505       llvm::SmallVector<mlir::Value> triples;
506       llvm::SmallVector<mlir::Value> sliceFields;
507       mlir::Type idxTy = builder.getIndexType();
508       auto subscripts = designate.getIndices();
509       if (fieldIndex && baseEntity.isArray()) {
510         // array%scalar_comp or array%array_comp(indices)
511         // Generate triples for array(:, :, ...).
512         triples = genFullSliceTriples(builder, loc, baseEntity);
513         sliceFields.push_back(fieldIndex);
514         // Add indices in the field path for "array%array_comp(indices)"
515         // case. The indices of components provided to the sliceOp must
516         // be zero based (fir.slice has no knowledge of the component
517         // lower bounds). The component lower bounds are applied here.
518         if (!subscripts.empty()) {
519           llvm::SmallVector<mlir::Value> lbounds = hlfir::genLowerbounds(
520               loc, builder, designate.getComponentShape(), subscripts.size());
521           for (auto [i, lb] : llvm::zip(subscripts, lbounds)) {
522             mlir::Value iIdx = builder.createConvert(loc, idxTy, i);
523             mlir::Value lbIdx = builder.createConvert(loc, idxTy, lb);
524             sliceFields.emplace_back(
525                 builder.create<mlir::arith::SubIOp>(loc, iIdx, lbIdx));
526           }
527         }
528       } else if (!isScalarDesignator) {
529         // Otherwise, this is an array section with triplets.
530         auto undef = builder.create<fir::UndefOp>(loc, idxTy);
531         unsigned i = 0;
532         for (auto isTriplet : designate.getIsTriplet()) {
533           triples.push_back(subscripts[i++]);
534           if (isTriplet) {
535             triples.push_back(subscripts[i++]);
536             triples.push_back(subscripts[i++]);
537           } else {
538             triples.push_back(undef);
539             triples.push_back(undef);
540           }
541         }
542       }
543       llvm::SmallVector<mlir::Value, 2> substring;
544       if (!designate.getSubstring().empty()) {
545         substring.push_back(designate.getSubstring()[0]);
546         mlir::Type idxTy = builder.getIndexType();
547         // fir.slice op substring expects the zero based lower bound.
548         mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
549         substring[0] = builder.createConvert(loc, idxTy, substring[0]);
550         substring[0] =
551             builder.create<mlir::arith::SubIOp>(loc, substring[0], one);
552         substring.push_back(designate.getTypeparams()[0]);
553       }
554       if (designate.getComplexPart()) {
555         if (triples.empty())
556           triples = genFullSliceTriples(builder, loc, baseEntity);
557         sliceFields.push_back(builder.createIntegerConstant(
558             loc, idxTy, *designate.getComplexPart()));
559       }
560       mlir::Value slice;
561       if (!triples.empty())
562         slice =
563             builder.create<fir::SliceOp>(loc, triples, sliceFields, substring);
564       else
565         assert(sliceFields.empty() && substring.empty());
566       llvm::SmallVector<mlir::Type> resultType{designateResultType};
567       mlir::Value resultBox;
568       if (mlir::isa<fir::BaseBoxType>(base.getType()))
569         resultBox =
570             builder.create<fir::ReboxOp>(loc, resultType, base, shape, slice);
571       else
572         resultBox =
573             builder.create<fir::EmboxOp>(loc, resultType, base, shape, slice,
574                                          firBaseTypeParameters, sourceBox);
575       rewriter.replaceOp(designate, resultBox);
576       return mlir::success();
577     }
578 
579     // Otherwise, the result is the address of a scalar, or the address of the
580     // first element of a contiguous array section with compile time constant
581     // shape. The base may be an array, or a scalar.
582     mlir::Type resultAddressType = designateResultType;
583     if (auto boxCharType =
584             mlir::dyn_cast<fir::BoxCharType>(designateResultType))
585       resultAddressType = fir::ReferenceType::get(boxCharType.getEleTy());
586 
587     // Array element indexing.
588     if (!designate.getIndices().empty()) {
589       // - array(indices) [substring|complex_part] or
590       // - scalar%array_comp(indices) [substring|complex_part]
591       // This may be a ranked contiguous array section in which case
592       // The first element address is being computed.
593       base = genSubscriptBeginAddr(builder, loc, designate, baseEleTy, base,
594                                    shape, firBaseTypeParameters);
595     }
596 
597     // Scalar substring (potentially on the previously built array element or
598     // component reference).
599     if (!designate.getSubstring().empty())
600       base = fir::factory::CharacterExprHelper{builder, loc}.genSubstringBase(
601           base, designate.getSubstring()[0], resultAddressType);
602 
603     // Scalar complex part ref
604     if (designate.getComplexPart()) {
605       // Sequence types should have already been handled by this point
606       assert(!mlir::isa<fir::SequenceType>(designateResultType));
607       auto index = builder.createIntegerConstant(loc, builder.getIndexType(),
608                                                  *designate.getComplexPart());
609       auto coorTy = fir::ReferenceType::get(resultEleTy);
610       base = builder.create<fir::CoordinateOp>(loc, coorTy, base, index);
611     }
612 
613     // Cast/embox the computed scalar address if needed.
614     if (mlir::isa<fir::BoxCharType>(designateResultType)) {
615       assert(designate.getTypeparams().size() == 1 &&
616              "must have character length");
617       auto emboxChar = builder.create<fir::EmboxCharOp>(
618           loc, designateResultType, base, designate.getTypeparams()[0]);
619       rewriter.replaceOp(designate, emboxChar.getResult());
620     } else {
621       base = builder.createConvert(loc, designateResultType, base);
622       rewriter.replaceOp(designate, base);
623     }
624     return mlir::success();
625   }
626 
627 private:
628   // Generates triple for full slice
629   // Used for component and complex part slices when a triple is
630   // not specified
631   static llvm::SmallVector<mlir::Value>
632   genFullSliceTriples(fir::FirOpBuilder &builder, mlir::Location loc,
633                       hlfir::Entity baseEntity) {
634     llvm::SmallVector<mlir::Value> triples;
635     mlir::Type idxTy = builder.getIndexType();
636     auto one = builder.createIntegerConstant(loc, idxTy, 1);
637     for (auto [lb, ub] : hlfir::genBounds(loc, builder, baseEntity)) {
638       triples.push_back(builder.createConvert(loc, idxTy, lb));
639       triples.push_back(builder.createConvert(loc, idxTy, ub));
640       triples.push_back(one);
641     }
642     return triples;
643   }
644 };
645 
646 class ParentComponentOpConversion
647     : public mlir::OpRewritePattern<hlfir::ParentComponentOp> {
648 public:
649   explicit ParentComponentOpConversion(mlir::MLIRContext *ctx)
650       : OpRewritePattern{ctx} {}
651 
652   llvm::LogicalResult
653   matchAndRewrite(hlfir::ParentComponentOp parentComponent,
654                   mlir::PatternRewriter &rewriter) const override {
655     mlir::Location loc = parentComponent.getLoc();
656     mlir::Type resultType = parentComponent.getType();
657     if (!mlir::isa<fir::BoxType>(parentComponent.getType())) {
658       mlir::Value baseAddr = parentComponent.getMemref();
659       // Scalar parent component ref without any length type parameters. The
660       // input may be a fir.class if it is polymorphic, since this is a scalar
661       // and the output will be monomorphic, the base address can be extracted
662       // from the fir.class.
663       if (mlir::isa<fir::BaseBoxType>(baseAddr.getType()))
664         baseAddr = rewriter.create<fir::BoxAddrOp>(loc, baseAddr);
665       rewriter.replaceOpWithNewOp<fir::ConvertOp>(parentComponent, resultType,
666                                                   baseAddr);
667       return mlir::success();
668     }
669     // Array parent component ref or PDTs.
670     hlfir::Entity base{parentComponent.getMemref()};
671     mlir::Value baseAddr = base.getBase();
672     if (!mlir::isa<fir::BaseBoxType>(baseAddr.getType())) {
673       // Embox cannot directly be used to address parent components: it expects
674       // the output type to match the input type when there are no slices. When
675       // the types have at least one component, a slice to the first element can
676       // be built, and the result set to the parent component type. Just create
677       // a fir.box with the base for now since this covers all cases.
678       mlir::Type baseBoxType =
679           fir::BoxType::get(base.getElementOrSequenceType());
680       assert(!base.hasLengthParameters() &&
681              "base must be a box if it has any type parameters");
682       baseAddr = rewriter.create<fir::EmboxOp>(
683           loc, baseBoxType, baseAddr, parentComponent.getShape(),
684           /*slice=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{});
685     }
686     rewriter.replaceOpWithNewOp<fir::ReboxOp>(parentComponent, resultType,
687                                               baseAddr,
688                                               /*shape=*/mlir::Value{},
689                                               /*slice=*/mlir::Value{});
690     return mlir::success();
691   }
692 };
693 
694 class NoReassocOpConversion
695     : public mlir::OpRewritePattern<hlfir::NoReassocOp> {
696 public:
697   explicit NoReassocOpConversion(mlir::MLIRContext *ctx)
698       : OpRewritePattern{ctx} {}
699 
700   llvm::LogicalResult
701   matchAndRewrite(hlfir::NoReassocOp noreassoc,
702                   mlir::PatternRewriter &rewriter) const override {
703     rewriter.replaceOpWithNewOp<fir::NoReassocOp>(noreassoc,
704                                                   noreassoc.getVal());
705     return mlir::success();
706   }
707 };
708 
709 class NullOpConversion : public mlir::OpRewritePattern<hlfir::NullOp> {
710 public:
711   explicit NullOpConversion(mlir::MLIRContext *ctx) : OpRewritePattern{ctx} {}
712 
713   llvm::LogicalResult
714   matchAndRewrite(hlfir::NullOp nullop,
715                   mlir::PatternRewriter &rewriter) const override {
716     rewriter.replaceOpWithNewOp<fir::ZeroOp>(nullop, nullop.getType());
717     return mlir::success();
718   }
719 };
720 
721 class GetExtentOpConversion
722     : public mlir::OpRewritePattern<hlfir::GetExtentOp> {
723 public:
724   using mlir::OpRewritePattern<hlfir::GetExtentOp>::OpRewritePattern;
725 
726   llvm::LogicalResult
727   matchAndRewrite(hlfir::GetExtentOp getExtentOp,
728                   mlir::PatternRewriter &rewriter) const override {
729     mlir::Value shape = getExtentOp.getShape();
730     mlir::Operation *shapeOp = shape.getDefiningOp();
731     // the hlfir.shape_of operation which led to the creation of this get_extent
732     // operation should now have been lowered to a fir.shape operation
733     if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
734       fir::ShapeType shapeTy = mlir::cast<fir::ShapeType>(shape.getType());
735       llvm::APInt dim = getExtentOp.getDim();
736       uint64_t dimVal = dim.getLimitedValue(shapeTy.getRank());
737       mlir::Value extent = s.getExtents()[dimVal];
738       fir::FirOpBuilder builder(rewriter, getExtentOp.getOperation());
739       extent = builder.createConvert(getExtentOp.getLoc(),
740                                      builder.getIndexType(), extent);
741       rewriter.replaceOp(getExtentOp, extent);
742       return mlir::success();
743     }
744     return mlir::failure();
745   }
746 };
747 
748 class ConvertHLFIRtoFIR
749     : public hlfir::impl::ConvertHLFIRtoFIRBase<ConvertHLFIRtoFIR> {
750 public:
751   void runOnOperation() override {
752     // TODO: like "bufferize-hlfir" pass, runtime signature may be added
753     // by this pass. This requires the pass to run on the ModuleOp. It would
754     // probably be more optimal to have it run on FuncOp and find a way to
755     // generate the signatures in a thread safe way.
756     auto module = this->getOperation();
757     auto *context = &getContext();
758     mlir::RewritePatternSet patterns(context);
759     patterns.insert<AssignOpConversion, CopyInOpConversion, CopyOutOpConversion,
760                     DeclareOpConversion, DesignateOpConversion,
761                     GetExtentOpConversion, NoReassocOpConversion,
762                     NullOpConversion, ParentComponentOpConversion>(context);
763     mlir::ConversionTarget target(*context);
764     target.addIllegalDialect<hlfir::hlfirDialect>();
765     target.markUnknownOpDynamicallyLegal(
766         [](mlir::Operation *) { return true; });
767     if (mlir::failed(mlir::applyPartialConversion(module, target,
768                                                   std::move(patterns)))) {
769       mlir::emitError(mlir::UnknownLoc::get(context),
770                       "failure in HLFIR to FIR conversion pass");
771       signalPassFailure();
772     }
773   }
774 };
775 
776 } // namespace
777