xref: /llvm-project/flang/lib/Lower/ConvertExprToHLFIR.cpp (revision fc97d2e68b03bc2979395e84b645e5b3ba35aecd)
1 //===-- ConvertExprToHLFIR.cpp --------------------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 //
9 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
10 //
11 //===----------------------------------------------------------------------===//
12 
13 #include "flang/Lower/ConvertExprToHLFIR.h"
14 #include "flang/Evaluate/shape.h"
15 #include "flang/Lower/AbstractConverter.h"
16 #include "flang/Lower/Allocatable.h"
17 #include "flang/Lower/CallInterface.h"
18 #include "flang/Lower/ConvertArrayConstructor.h"
19 #include "flang/Lower/ConvertCall.h"
20 #include "flang/Lower/ConvertConstant.h"
21 #include "flang/Lower/ConvertProcedureDesignator.h"
22 #include "flang/Lower/ConvertType.h"
23 #include "flang/Lower/ConvertVariable.h"
24 #include "flang/Lower/StatementContext.h"
25 #include "flang/Lower/SymbolMap.h"
26 #include "flang/Optimizer/Builder/Complex.h"
27 #include "flang/Optimizer/Builder/IntrinsicCall.h"
28 #include "flang/Optimizer/Builder/MutableBox.h"
29 #include "flang/Optimizer/Builder/Runtime/Character.h"
30 #include "flang/Optimizer/Builder/Runtime/Derived.h"
31 #include "flang/Optimizer/Builder/Runtime/Pointer.h"
32 #include "flang/Optimizer/Builder/Todo.h"
33 #include "flang/Optimizer/HLFIR/HLFIROps.h"
34 #include "llvm/ADT/TypeSwitch.h"
35 #include <optional>
36 
37 namespace {
38 
39 /// Lower Designators to HLFIR.
40 class HlfirDesignatorBuilder {
41 private:
42   /// Internal entry point on the rightest part of a evaluate::Designator.
43   template <typename T>
44   hlfir::EntityWithAttributes
45   genLeafPartRef(const T &designatorNode,
46                  bool vectorSubscriptDesignatorToValue) {
47     hlfir::EntityWithAttributes result = gen(designatorNode);
48     if (vectorSubscriptDesignatorToValue)
49       return turnVectorSubscriptedDesignatorIntoValue(result);
50     return result;
51   }
52 
53   hlfir::EntityWithAttributes
54   genDesignatorExpr(const Fortran::lower::SomeExpr &designatorExpr,
55                     bool vectorSubscriptDesignatorToValue = true);
56 
57 public:
58   HlfirDesignatorBuilder(mlir::Location loc,
59                          Fortran::lower::AbstractConverter &converter,
60                          Fortran::lower::SymMap &symMap,
61                          Fortran::lower::StatementContext &stmtCtx)
62       : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {}
63 
64   /// Public entry points to lower a Designator<T> (given its .u member, to
65   /// avoid the template arguments which does not matter here).
66   /// This lowers a designator to an hlfir variable SSA value (that can be
67   /// assigned to), except for vector subscripted designators that are
68   /// lowered by default to hlfir.expr value since they cannot be
69   /// represented as HLFIR variable SSA values.
70 
71   // Character designators variant contains substrings
72   using CharacterDesignators =
73       decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
74                    Fortran::evaluate::TypeCategory::Character, 1>>::u);
75   hlfir::EntityWithAttributes
76   gen(const CharacterDesignators &designatorVariant,
77       bool vectorSubscriptDesignatorToValue = true) {
78     return Fortran::common::visit(
79         [&](const auto &x) -> hlfir::EntityWithAttributes {
80           return genLeafPartRef(x, vectorSubscriptDesignatorToValue);
81         },
82         designatorVariant);
83   }
84   // Character designators variant contains complex parts
85   using RealDesignators =
86       decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
87                    Fortran::evaluate::TypeCategory::Real, 4>>::u);
88   hlfir::EntityWithAttributes
89   gen(const RealDesignators &designatorVariant,
90       bool vectorSubscriptDesignatorToValue = true) {
91     return Fortran::common::visit(
92         [&](const auto &x) -> hlfir::EntityWithAttributes {
93           return genLeafPartRef(x, vectorSubscriptDesignatorToValue);
94         },
95         designatorVariant);
96   }
97   // All other designators are similar
98   using OtherDesignators =
99       decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
100                    Fortran::evaluate::TypeCategory::Integer, 4>>::u);
101   hlfir::EntityWithAttributes
102   gen(const OtherDesignators &designatorVariant,
103       bool vectorSubscriptDesignatorToValue = true) {
104     return Fortran::common::visit(
105         [&](const auto &x) -> hlfir::EntityWithAttributes {
106           return genLeafPartRef(x, vectorSubscriptDesignatorToValue);
107         },
108         designatorVariant);
109   }
110 
111   hlfir::EntityWithAttributes
112   genNamedEntity(const Fortran::evaluate::NamedEntity &namedEntity,
113                  bool vectorSubscriptDesignatorToValue = true) {
114     if (namedEntity.IsSymbol())
115       return genLeafPartRef(
116           Fortran::evaluate::SymbolRef{namedEntity.GetLastSymbol()},
117           vectorSubscriptDesignatorToValue);
118     return genLeafPartRef(namedEntity.GetComponent(),
119                           vectorSubscriptDesignatorToValue);
120   }
121 
122   /// Public entry point to lower a vector subscripted designator to
123   /// an hlfir::ElementalAddrOp.
124   hlfir::ElementalAddrOp convertVectorSubscriptedExprToElementalAddr(
125       const Fortran::lower::SomeExpr &designatorExpr);
126 
127   mlir::Value genComponentShape(const Fortran::semantics::Symbol &componentSym,
128                                 mlir::Type fieldType) {
129     // For pointers and allocatable components, the
130     // shape is deferred and should not be loaded now to preserve
131     // pointer/allocatable aspects.
132     if (componentSym.Rank() == 0 ||
133         Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym) ||
134         Fortran::semantics::IsProcedurePointer(&componentSym))
135       return mlir::Value{};
136 
137     fir::FirOpBuilder &builder = getBuilder();
138     mlir::Location loc = getLoc();
139     mlir::Type idxTy = builder.getIndexType();
140     llvm::SmallVector<mlir::Value> extents;
141     auto seqTy = mlir::cast<fir::SequenceType>(
142         hlfir::getFortranElementOrSequenceType(fieldType));
143     for (auto extent : seqTy.getShape()) {
144       if (extent == fir::SequenceType::getUnknownExtent()) {
145         // We have already generated invalid hlfir.declare
146         // without the type parameters and probably invalid storage
147         // for the variable (e.g. fir.alloca without type parameters).
148         // So this TODO here is a little bit late, but it matches
149         // the non-HLFIR path.
150         TODO(loc, "array component shape depending on length parameters");
151       }
152       extents.push_back(builder.createIntegerConstant(loc, idxTy, extent));
153     }
154     if (!mayHaveNonDefaultLowerBounds(componentSym))
155       return builder.create<fir::ShapeOp>(loc, extents);
156 
157     llvm::SmallVector<mlir::Value> lbounds;
158     if (const auto *objDetails =
159             componentSym.detailsIf<Fortran::semantics::ObjectEntityDetails>())
160       for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
161         if (auto lb = bounds.lbound().GetExplicit())
162           if (auto constant = Fortran::evaluate::ToInt64(*lb))
163             lbounds.push_back(
164                 builder.createIntegerConstant(loc, idxTy, *constant));
165     assert(extents.size() == lbounds.size() &&
166            "extents and lower bounds must match");
167     return builder.genShape(loc, lbounds, extents);
168   }
169 
170   fir::FortranVariableOpInterface
171   gen(const Fortran::evaluate::DataRef &dataRef) {
172     return Fortran::common::visit(
173         Fortran::common::visitors{[&](const auto &x) { return gen(x); }},
174         dataRef.u);
175   }
176 
177 private:
178   /// Struct that is filled while visiting a part-ref (in the "visit" member
179   /// function) before the top level "gen" generates an hlfir.declare for the
180   /// part ref. It contains the lowered pieces of the part-ref that will
181   /// become the operands of an hlfir.declare.
182   struct PartInfo {
183     std::optional<hlfir::Entity> base;
184     std::string componentName{};
185     mlir::Value componentShape;
186     hlfir::DesignateOp::Subscripts subscripts;
187     std::optional<bool> complexPart;
188     mlir::Value resultShape;
189     llvm::SmallVector<mlir::Value> typeParams;
190     llvm::SmallVector<mlir::Value, 2> substring;
191   };
192 
193   // Given the value type of a designator (T or fir.array<T>) and the front-end
194   // node for the designator, compute the memory type (fir.class, fir.ref, or
195   // fir.box)...
196   template <typename T>
197   mlir::Type computeDesignatorType(mlir::Type resultValueType,
198                                    PartInfo &partInfo,
199                                    const T &designatorNode) {
200     // Get base's shape if its a sequence type with no previously computed
201     // result shape
202     if (partInfo.base && mlir::isa<fir::SequenceType>(resultValueType) &&
203         !partInfo.resultShape)
204       partInfo.resultShape =
205           hlfir::genShape(getLoc(), getBuilder(), *partInfo.base);
206     // Dynamic type of polymorphic base must be kept if the designator is
207     // polymorphic.
208     if (isPolymorphic(designatorNode))
209       return fir::ClassType::get(resultValueType);
210     // Character scalar with dynamic length needs a fir.boxchar to hold the
211     // designator length.
212     auto charType = mlir::dyn_cast<fir::CharacterType>(resultValueType);
213     if (charType && charType.hasDynamicLen())
214       return fir::BoxCharType::get(charType.getContext(), charType.getFKind());
215     // Arrays with non default lower bounds or dynamic length or dynamic extent
216     // need a fir.box to hold the dynamic or lower bound information.
217     if (fir::hasDynamicSize(resultValueType) ||
218         mayHaveNonDefaultLowerBounds(partInfo))
219       return fir::BoxType::get(resultValueType);
220     // Non simply contiguous ref require a fir.box to carry the byte stride.
221     if (mlir::isa<fir::SequenceType>(resultValueType) &&
222         !Fortran::evaluate::IsSimplyContiguous(
223             designatorNode, getConverter().getFoldingContext()))
224       return fir::BoxType::get(resultValueType);
225     // Other designators can be handled as raw addresses.
226     return fir::ReferenceType::get(resultValueType);
227   }
228 
229   template <typename T>
230   static bool isPolymorphic(const T &designatorNode) {
231     if constexpr (!std::is_same_v<T, Fortran::evaluate::Substring>) {
232       return Fortran::semantics::IsPolymorphic(designatorNode.GetLastSymbol());
233     }
234     return false;
235   }
236 
237   template <typename T>
238   /// Generate an hlfir.designate for a part-ref given a filled PartInfo and the
239   /// FIR type for this part-ref.
240   fir::FortranVariableOpInterface genDesignate(mlir::Type resultValueType,
241                                                PartInfo &partInfo,
242                                                const T &designatorNode) {
243     mlir::Type designatorType =
244         computeDesignatorType(resultValueType, partInfo, designatorNode);
245     return genDesignate(designatorType, partInfo, /*attributes=*/{});
246   }
247   fir::FortranVariableOpInterface
248   genDesignate(mlir::Type designatorType, PartInfo &partInfo,
249                fir::FortranVariableFlagsAttr attributes) {
250     fir::FirOpBuilder &builder = getBuilder();
251     // Once a part with vector subscripts has been lowered, the following
252     // hlfir.designator (for the parts on the right of the designator) must
253     // be lowered inside the hlfir.elemental_addr because they depend on the
254     // hlfir.elemental_addr indices.
255     // All the subsequent Fortran indices however, should be lowered before
256     // the hlfir.elemental_addr because they should only be evaluated once,
257     // hence, the insertion point is restored outside of the
258     // hlfir.elemental_addr after generating the hlfir.designate. Example: in
259     // "X(VECTOR)%COMP(FOO(), BAR())", the calls to bar() and foo() must be
260     // generated outside of the hlfir.elemental, but the related hlfir.designate
261     // that depends on the scalar hlfir.designate of X(VECTOR) that was
262     // generated inside the hlfir.elemental_addr should be generated in the
263     // hlfir.elemental_addr.
264     if (auto elementalAddrOp = getVectorSubscriptElementAddrOp())
265       builder.setInsertionPointToEnd(&elementalAddrOp->getBody().front());
266     auto designate = builder.create<hlfir::DesignateOp>(
267         getLoc(), designatorType, partInfo.base.value().getBase(),
268         partInfo.componentName, partInfo.componentShape, partInfo.subscripts,
269         partInfo.substring, partInfo.complexPart, partInfo.resultShape,
270         partInfo.typeParams, attributes);
271     if (auto elementalAddrOp = getVectorSubscriptElementAddrOp())
272       builder.setInsertionPoint(*elementalAddrOp);
273     return mlir::cast<fir::FortranVariableOpInterface>(
274         designate.getOperation());
275   }
276 
277   fir::FortranVariableOpInterface
278   gen(const Fortran::evaluate::SymbolRef &symbolRef) {
279     if (std::optional<fir::FortranVariableOpInterface> varDef =
280             getSymMap().lookupVariableDefinition(symbolRef)) {
281       if (symbolRef->test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
282         // The pointee is represented with a descriptor inheriting
283         // the shape and type parameters of the pointee.
284         // We have to update the base_addr to point to the current
285         // value of the Cray pointer variable.
286         fir::FirOpBuilder &builder = getBuilder();
287         fir::FortranVariableOpInterface ptrVar =
288             gen(Fortran::semantics::GetCrayPointer(symbolRef));
289         mlir::Value ptrAddr = ptrVar.getBase();
290 
291         // Reinterpret the reference to a Cray pointer so that
292         // we have a pointer-compatible value after loading
293         // the Cray pointer value.
294         mlir::Type refPtrType = builder.getRefType(
295             fir::PointerType::get(fir::dyn_cast_ptrEleTy(ptrAddr.getType())));
296         mlir::Value cast = builder.createConvert(loc, refPtrType, ptrAddr);
297         mlir::Value ptrVal = builder.create<fir::LoadOp>(loc, cast);
298 
299         // Update the base_addr to the value of the Cray pointer.
300         // This is a hacky way to do the update, and it may harm
301         // performance around Cray pointer references.
302         // TODO: we should introduce an operation that updates
303         // just the base_addr of the given box. The CodeGen
304         // will just convert it into a single store.
305         fir::runtime::genPointerAssociateScalar(builder, loc, varDef->getBase(),
306                                                 ptrVal);
307       }
308       return *varDef;
309     }
310     llvm::errs() << *symbolRef << "\n";
311     TODO(getLoc(), "lowering symbol to HLFIR");
312   }
313 
314   fir::FortranVariableOpInterface
315   gen(const Fortran::semantics::Symbol &symbol) {
316     Fortran::evaluate::SymbolRef symref{symbol};
317     return gen(symref);
318   }
319 
320   fir::FortranVariableOpInterface
321   gen(const Fortran::evaluate::Component &component) {
322     if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol()))
323       return genWholeAllocatableOrPointerComponent(component);
324     PartInfo partInfo;
325     mlir::Type resultType = visit(component, partInfo);
326     return genDesignate(resultType, partInfo, component);
327   }
328 
329   fir::FortranVariableOpInterface
330   gen(const Fortran::evaluate::ArrayRef &arrayRef) {
331     PartInfo partInfo;
332     mlir::Type resultType = visit(arrayRef, partInfo);
333     return genDesignate(resultType, partInfo, arrayRef);
334   }
335 
336   fir::FortranVariableOpInterface
337   gen(const Fortran::evaluate::CoarrayRef &coarrayRef) {
338     TODO(getLoc(), "coarray: lowering a reference to a coarray object");
339   }
340 
341   mlir::Type visit(const Fortran::evaluate::CoarrayRef &, PartInfo &) {
342     TODO(getLoc(), "coarray: lowering a reference to a coarray object");
343   }
344 
345   fir::FortranVariableOpInterface
346   gen(const Fortran::evaluate::ComplexPart &complexPart) {
347     PartInfo partInfo;
348     fir::factory::Complex cmplxHelper(getBuilder(), getLoc());
349 
350     bool complexBit =
351         complexPart.part() == Fortran::evaluate::ComplexPart::Part::IM;
352     partInfo.complexPart = {complexBit};
353 
354     mlir::Type resultType = visit(complexPart.complex(), partInfo);
355 
356     // Determine complex part type
357     mlir::Type base = hlfir::getFortranElementType(resultType);
358     mlir::Type cmplxValueType = cmplxHelper.getComplexPartType(base);
359     mlir::Type designatorType = changeElementType(resultType, cmplxValueType);
360 
361     return genDesignate(designatorType, partInfo, complexPart);
362   }
363 
364   fir::FortranVariableOpInterface
365   gen(const Fortran::evaluate::Substring &substring) {
366     PartInfo partInfo;
367     mlir::Type baseStringType = Fortran::common::visit(
368         [&](const auto &x) { return visit(x, partInfo); }, substring.parent());
369     assert(partInfo.typeParams.size() == 1 && "expect base string length");
370     // Compute the substring lower and upper bound.
371     partInfo.substring.push_back(genSubscript(substring.lower()));
372     if (Fortran::evaluate::MaybeExtentExpr upperBound = substring.upper())
373       partInfo.substring.push_back(genSubscript(*upperBound));
374     else
375       partInfo.substring.push_back(partInfo.typeParams[0]);
376     fir::FirOpBuilder &builder = getBuilder();
377     mlir::Location loc = getLoc();
378     mlir::Type idxTy = builder.getIndexType();
379     partInfo.substring[0] =
380         builder.createConvert(loc, idxTy, partInfo.substring[0]);
381     partInfo.substring[1] =
382         builder.createConvert(loc, idxTy, partInfo.substring[1]);
383     // Try using constant length if available. mlir::arith folding would
384     // most likely be able to fold "max(ub-lb+1,0)" too, but getting
385     // the constant length in the FIR types would be harder.
386     std::optional<int64_t> cstLen =
387         Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
388             getConverter().getFoldingContext(), substring.LEN()));
389     if (cstLen) {
390       partInfo.typeParams[0] =
391           builder.createIntegerConstant(loc, idxTy, *cstLen);
392     } else {
393       // Compute "len = max(ub-lb+1,0)" (Fortran 2018 9.4.1).
394       mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
395       auto boundsDiff = builder.create<mlir::arith::SubIOp>(
396           loc, partInfo.substring[1], partInfo.substring[0]);
397       auto rawLen = builder.create<mlir::arith::AddIOp>(loc, boundsDiff, one);
398       partInfo.typeParams[0] =
399           fir::factory::genMaxWithZero(builder, loc, rawLen);
400     }
401     auto kind = mlir::cast<fir::CharacterType>(
402                     hlfir::getFortranElementType(baseStringType))
403                     .getFKind();
404     auto newCharTy = fir::CharacterType::get(
405         baseStringType.getContext(), kind,
406         cstLen ? *cstLen : fir::CharacterType::unknownLen());
407     mlir::Type resultType = changeElementType(baseStringType, newCharTy);
408     return genDesignate(resultType, partInfo, substring);
409   }
410 
411   static mlir::Type changeElementType(mlir::Type type, mlir::Type newEleTy) {
412     return llvm::TypeSwitch<mlir::Type, mlir::Type>(type)
413         .Case<fir::SequenceType>([&](fir::SequenceType seqTy) -> mlir::Type {
414           return fir::SequenceType::get(seqTy.getShape(), newEleTy);
415         })
416         .Case<fir::PointerType, fir::HeapType, fir::ReferenceType, fir::BoxType,
417               fir::ClassType>([&](auto t) -> mlir::Type {
418           using FIRT = decltype(t);
419           return FIRT::get(changeElementType(t.getEleTy(), newEleTy));
420         })
421         .Default([newEleTy](mlir::Type t) -> mlir::Type { return newEleTy; });
422   }
423 
424   fir::FortranVariableOpInterface genWholeAllocatableOrPointerComponent(
425       const Fortran::evaluate::Component &component) {
426     // Generate whole allocatable or pointer component reference. The
427     // hlfir.designate result will be a pointer/allocatable.
428     PartInfo partInfo;
429     mlir::Type componentType = visitComponentImpl(component, partInfo).second;
430     mlir::Type designatorType = fir::ReferenceType::get(componentType);
431     fir::FortranVariableFlagsAttr attributes =
432         Fortran::lower::translateSymbolAttributes(getBuilder().getContext(),
433                                                   component.GetLastSymbol());
434     return genDesignate(designatorType, partInfo, attributes);
435   }
436 
437   mlir::Type visit(const Fortran::evaluate::DataRef &dataRef,
438                    PartInfo &partInfo) {
439     return Fortran::common::visit(
440         [&](const auto &x) { return visit(x, partInfo); }, dataRef.u);
441   }
442 
443   mlir::Type
444   visit(const Fortran::evaluate::StaticDataObject::Pointer &staticObject,
445         PartInfo &partInfo) {
446     fir::FirOpBuilder &builder = getBuilder();
447     mlir::Location loc = getLoc();
448     std::optional<std::string> string = staticObject->AsString();
449     // TODO: see if StaticDataObject can be replaced by something based on
450     // Constant<T> to avoid dealing with endianness here for KIND>1.
451     // This will also avoid making string copies here.
452     if (!string)
453       TODO(loc, "StaticDataObject::Pointer substring with kind > 1");
454     fir::ExtendedValue exv =
455         fir::factory::createStringLiteral(builder, getLoc(), *string);
456     auto flags = fir::FortranVariableFlagsAttr::get(
457         builder.getContext(), fir::FortranVariableFlagsEnum::parameter);
458     partInfo.base = hlfir::genDeclare(loc, builder, exv, ".stringlit", flags);
459     partInfo.typeParams.push_back(fir::getLen(exv));
460     return partInfo.base->getElementOrSequenceType();
461   }
462 
463   mlir::Type visit(const Fortran::evaluate::SymbolRef &symbolRef,
464                    PartInfo &partInfo) {
465     // A symbol is only visited if there is a following array, substring, or
466     // complex reference. If the entity is a pointer or allocatable, this
467     // reference designates the target, so the pointer, allocatable must be
468     // dereferenced here.
469     partInfo.base =
470         hlfir::derefPointersAndAllocatables(loc, getBuilder(), gen(symbolRef));
471     hlfir::genLengthParameters(loc, getBuilder(), *partInfo.base,
472                                partInfo.typeParams);
473     return partInfo.base->getElementOrSequenceType();
474   }
475 
476   mlir::Type visit(const Fortran::evaluate::ArrayRef &arrayRef,
477                    PartInfo &partInfo) {
478     mlir::Type baseType;
479     if (const auto *component = arrayRef.base().UnwrapComponent()) {
480       // Pointers and allocatable components must be dereferenced since the
481       // array ref designates the target (this is done in "visit"). Other
482       // components need special care to deal with the array%array_comp(indices)
483       // case.
484       if (Fortran::semantics::IsAllocatableOrObjectPointer(
485               &component->GetLastSymbol()))
486         baseType = visit(*component, partInfo);
487       else
488         baseType = hlfir::getFortranElementOrSequenceType(
489             visitComponentImpl(*component, partInfo).second);
490     } else {
491       baseType = visit(arrayRef.base().GetLastSymbol(), partInfo);
492     }
493 
494     fir::FirOpBuilder &builder = getBuilder();
495     mlir::Location loc = getLoc();
496     mlir::Type idxTy = builder.getIndexType();
497     llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> bounds;
498     auto getBaseBounds = [&](unsigned i) {
499       if (bounds.empty()) {
500         if (partInfo.componentName.empty()) {
501           bounds = hlfir::genBounds(loc, builder, partInfo.base.value());
502         } else {
503           assert(
504               partInfo.componentShape &&
505               "implicit array section bounds must come from component shape");
506           bounds = hlfir::genBounds(loc, builder, partInfo.componentShape);
507         }
508         assert(!bounds.empty() &&
509                "failed to compute implicit array section bounds");
510       }
511       return bounds[i];
512     };
513     auto frontEndResultShape =
514         Fortran::evaluate::GetShape(converter.getFoldingContext(), arrayRef);
515     auto tryGettingExtentFromFrontEnd =
516         [&](unsigned dim) -> std::pair<mlir::Value, fir::SequenceType::Extent> {
517       // Use constant extent if possible. The main advantage to do this now
518       // is to get the best FIR array types as possible while lowering.
519       if (frontEndResultShape)
520         if (auto maybeI64 =
521                 Fortran::evaluate::ToInt64(frontEndResultShape->at(dim)))
522           return {builder.createIntegerConstant(loc, idxTy, *maybeI64),
523                   *maybeI64};
524       return {mlir::Value{}, fir::SequenceType::getUnknownExtent()};
525     };
526     llvm::SmallVector<mlir::Value> resultExtents;
527     fir::SequenceType::Shape resultTypeShape;
528     bool sawVectorSubscripts = false;
529     for (auto subscript : llvm::enumerate(arrayRef.subscript())) {
530       if (const auto *triplet =
531               std::get_if<Fortran::evaluate::Triplet>(&subscript.value().u)) {
532         mlir::Value lb, ub;
533         if (const auto &lbExpr = triplet->lower())
534           lb = genSubscript(*lbExpr);
535         else
536           lb = getBaseBounds(subscript.index()).first;
537         if (const auto &ubExpr = triplet->upper())
538           ub = genSubscript(*ubExpr);
539         else
540           ub = getBaseBounds(subscript.index()).second;
541         lb = builder.createConvert(loc, idxTy, lb);
542         ub = builder.createConvert(loc, idxTy, ub);
543         mlir::Value stride = genSubscript(triplet->stride());
544         stride = builder.createConvert(loc, idxTy, stride);
545         auto [extentValue, shapeExtent] =
546             tryGettingExtentFromFrontEnd(resultExtents.size());
547         resultTypeShape.push_back(shapeExtent);
548         if (!extentValue)
549           extentValue =
550               builder.genExtentFromTriplet(loc, lb, ub, stride, idxTy);
551         resultExtents.push_back(extentValue);
552         partInfo.subscripts.emplace_back(
553             hlfir::DesignateOp::Triplet{lb, ub, stride});
554       } else {
555         const auto &expr =
556             std::get<Fortran::evaluate::IndirectSubscriptIntegerExpr>(
557                 subscript.value().u)
558                 .value();
559         hlfir::Entity subscript = genSubscript(expr);
560         partInfo.subscripts.push_back(subscript);
561         if (expr.Rank() > 0) {
562           sawVectorSubscripts = true;
563           auto [extentValue, shapeExtent] =
564               tryGettingExtentFromFrontEnd(resultExtents.size());
565           resultTypeShape.push_back(shapeExtent);
566           if (!extentValue)
567             extentValue = hlfir::genExtent(loc, builder, subscript, /*dim=*/0);
568           resultExtents.push_back(extentValue);
569         }
570       }
571     }
572     assert(resultExtents.size() == resultTypeShape.size() &&
573            "inconsistent hlfir.designate shape");
574 
575     // For vector subscripts, create an hlfir.elemental_addr and continue
576     // lowering the designator inside it as if it was addressing an element of
577     // the vector subscripts.
578     if (sawVectorSubscripts)
579       return createVectorSubscriptElementAddrOp(partInfo, baseType,
580                                                 resultExtents);
581 
582     mlir::Type resultType =
583         mlir::cast<fir::SequenceType>(baseType).getElementType();
584     if (!resultTypeShape.empty()) {
585       // Ranked array section. The result shape comes from the array section
586       // subscripts.
587       resultType = fir::SequenceType::get(resultTypeShape, resultType);
588       assert(!partInfo.resultShape &&
589              "Fortran designator can only have one ranked part");
590       partInfo.resultShape = builder.genShape(loc, resultExtents);
591     } else if (!partInfo.componentName.empty() &&
592                partInfo.base.value().isArray()) {
593       // This is an array%array_comp(indices) reference. Keep the
594       // shape of the base array and not the array_comp.
595       auto compBaseTy = partInfo.base->getElementOrSequenceType();
596       resultType = changeElementType(compBaseTy, resultType);
597       assert(!partInfo.resultShape && "should not have been computed already");
598       partInfo.resultShape = hlfir::genShape(loc, builder, *partInfo.base);
599     }
600     return resultType;
601   }
602 
603   static bool
604   mayHaveNonDefaultLowerBounds(const Fortran::semantics::Symbol &componentSym) {
605     if (const auto *objDetails =
606             componentSym.detailsIf<Fortran::semantics::ObjectEntityDetails>())
607       for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
608         if (auto lb = bounds.lbound().GetExplicit())
609           if (auto constant = Fortran::evaluate::ToInt64(*lb))
610             if (!constant || *constant != 1)
611               return true;
612     return false;
613   }
614   static bool mayHaveNonDefaultLowerBounds(const PartInfo &partInfo) {
615     return partInfo.resultShape &&
616            mlir::isa<fir::ShiftType, fir::ShapeShiftType>(
617                partInfo.resultShape.getType());
618   }
619 
620   mlir::Type visit(const Fortran::evaluate::Component &component,
621                    PartInfo &partInfo) {
622     if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol())) {
623       // In a visit, the following reference will address the target. Insert
624       // the dereference here.
625       partInfo.base = genWholeAllocatableOrPointerComponent(component);
626       partInfo.base = hlfir::derefPointersAndAllocatables(loc, getBuilder(),
627                                                           *partInfo.base);
628       hlfir::genLengthParameters(loc, getBuilder(), *partInfo.base,
629                                  partInfo.typeParams);
630       return partInfo.base->getElementOrSequenceType();
631     }
632     // This function must be called from contexts where the component is not the
633     // base of an ArrayRef. In these cases, the component cannot be an array
634     // if the base is an array. The code below determines the shape of the
635     // component reference if any.
636     auto [baseType, componentType] = visitComponentImpl(component, partInfo);
637     mlir::Type componentBaseType =
638         hlfir::getFortranElementOrSequenceType(componentType);
639     if (partInfo.base.value().isArray()) {
640       // For array%scalar_comp, the result shape is
641       // the one of the base. Compute it here. Note that the lower bounds of the
642       // base are not the ones of the resulting reference (that are default
643       // ones).
644       partInfo.resultShape = hlfir::genShape(loc, getBuilder(), *partInfo.base);
645       assert(!partInfo.componentShape &&
646              "Fortran designators can only have one ranked part");
647       return changeElementType(baseType, componentBaseType);
648     }
649 
650     if (partInfo.complexPart && partInfo.componentShape) {
651       // Treat ...array_comp%im/re as ...array_comp(:,:,...)%im/re
652       // so that the codegen has the full slice triples for the component
653       // readily available.
654       fir::FirOpBuilder &builder = getBuilder();
655       mlir::Type idxTy = builder.getIndexType();
656       mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
657 
658       llvm::SmallVector<mlir::Value> resultExtents;
659       // Collect <lb, ub> pairs from the component shape.
660       auto bounds = hlfir::genBounds(loc, builder, partInfo.componentShape);
661       for (auto &boundPair : bounds) {
662         // The default subscripts are <lb, ub, 1>:
663         partInfo.subscripts.emplace_back(hlfir::DesignateOp::Triplet{
664             boundPair.first, boundPair.second, one});
665         auto extentValue = builder.genExtentFromTriplet(
666             loc, boundPair.first, boundPair.second, one, idxTy);
667         resultExtents.push_back(extentValue);
668       }
669       // The result shape is: <max((ub - lb + 1) / 1, 0), ...>.
670       partInfo.resultShape = builder.genShape(loc, resultExtents);
671       return componentBaseType;
672     }
673 
674     // scalar%array_comp or scalar%scalar. In any case the shape of this
675     // part-ref is coming from the component.
676     partInfo.resultShape = partInfo.componentShape;
677     partInfo.componentShape = {};
678     return componentBaseType;
679   }
680 
681   // Returns the <BaseType, ComponentType> pair, computes partInfo.base,
682   // partInfo.componentShape and partInfo.typeParams, but does not set the
683   // partInfo.resultShape yet. The result shape will be computed after
684   // processing a following ArrayRef, if any, and in "visit" otherwise.
685   std::pair<mlir::Type, mlir::Type>
686   visitComponentImpl(const Fortran::evaluate::Component &component,
687                      PartInfo &partInfo) {
688     fir::FirOpBuilder &builder = getBuilder();
689     // Break the Designator visit here: if the base is an array-ref, a
690     // coarray-ref, or another component, this creates another hlfir.designate
691     // for it.  hlfir.designate is not meant to represent more than one
692     // part-ref.
693     partInfo.base = gen(component.base());
694     // If the base is an allocatable/pointer, dereference it here since the
695     // component ref designates its target.
696     partInfo.base =
697         hlfir::derefPointersAndAllocatables(loc, builder, *partInfo.base);
698     assert(partInfo.typeParams.empty() && "should not have been computed yet");
699 
700     hlfir::genLengthParameters(getLoc(), getBuilder(), *partInfo.base,
701                                partInfo.typeParams);
702     mlir::Type baseType = partInfo.base->getElementOrSequenceType();
703 
704     // Lower the information about the component (type, length parameters and
705     // shape).
706     const Fortran::semantics::Symbol &componentSym = component.GetLastSymbol();
707     partInfo.componentName = converter.getRecordTypeFieldName(componentSym);
708     auto recordType =
709         mlir::cast<fir::RecordType>(hlfir::getFortranElementType(baseType));
710     if (recordType.isDependentType())
711       TODO(getLoc(), "Designate derived type with length parameters in HLFIR");
712     mlir::Type fieldType = recordType.getType(partInfo.componentName);
713     assert(fieldType && "component name is not known");
714     mlir::Type fieldBaseType =
715         hlfir::getFortranElementOrSequenceType(fieldType);
716     partInfo.componentShape = genComponentShape(componentSym, fieldBaseType);
717 
718     mlir::Type fieldEleType = hlfir::getFortranElementType(fieldBaseType);
719     if (fir::isRecordWithTypeParameters(fieldEleType))
720       TODO(loc,
721            "lower a component that is a parameterized derived type to HLFIR");
722     if (auto charTy = mlir::dyn_cast<fir::CharacterType>(fieldEleType)) {
723       mlir::Location loc = getLoc();
724       mlir::Type idxTy = builder.getIndexType();
725       if (charTy.hasConstantLen())
726         partInfo.typeParams.push_back(
727             builder.createIntegerConstant(loc, idxTy, charTy.getLen()));
728       else if (!Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym))
729         TODO(loc, "compute character length of automatic character component "
730                   "in a PDT");
731       // Otherwise, the length of the component is deferred and will only
732       // be read when the component is dereferenced.
733     }
734     return {baseType, fieldType};
735   }
736 
737   // Compute: "lb + (i-1)*step".
738   mlir::Value computeTripletPosition(mlir::Location loc,
739                                      fir::FirOpBuilder &builder,
740                                      hlfir::DesignateOp::Triplet &triplet,
741                                      mlir::Value oneBasedIndex) {
742     mlir::Type idxTy = builder.getIndexType();
743     mlir::Value lb = builder.createConvert(loc, idxTy, std::get<0>(triplet));
744     mlir::Value step = builder.createConvert(loc, idxTy, std::get<2>(triplet));
745     mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
746     oneBasedIndex = builder.createConvert(loc, idxTy, oneBasedIndex);
747     mlir::Value zeroBased =
748         builder.create<mlir::arith::SubIOp>(loc, oneBasedIndex, one);
749     mlir::Value offset =
750         builder.create<mlir::arith::MulIOp>(loc, zeroBased, step);
751     return builder.create<mlir::arith::AddIOp>(loc, lb, offset);
752   }
753 
754   /// Create an hlfir.element_addr operation to deal with vector subscripted
755   /// entities. This transforms the current vector subscripted array-ref into a
756   /// a scalar array-ref that is addressing the vector subscripted part given
757   /// the one based indices of the hlfir.element_addr.
758   /// The rest of the designator lowering will continue lowering any further
759   /// parts inside the hlfir.elemental as a scalar reference.
760   /// At the end of the designator lowering, the hlfir.elemental_addr will
761   /// be turned into an hlfir.elemental value, unless the caller of this
762   /// utility requested to get the hlfir.elemental_addr instead of lowering
763   /// the designator to an mlir::Value.
764   mlir::Type createVectorSubscriptElementAddrOp(
765       PartInfo &partInfo, mlir::Type baseType,
766       llvm::ArrayRef<mlir::Value> resultExtents) {
767     fir::FirOpBuilder &builder = getBuilder();
768     mlir::Value shape = builder.genShape(loc, resultExtents);
769     // The type parameters to be added on the hlfir.elemental_addr are the ones
770     // of the whole designator (not the ones of the vector subscripted part).
771     // These are not yet known and will be added when finalizing the designator
772     // lowering.
773     // The resulting designator may be polymorphic, in which case the resulting
774     // type is the base of the vector subscripted part because
775     // allocatable/pointer components cannot be referenced after a vector
776     // subscripted part. Set the mold to the current base. It will be erased if
777     // the resulting designator is not polymorphic.
778     assert(partInfo.base.has_value() &&
779            "vector subscripted part must have a base");
780     mlir::Value mold = *partInfo.base;
781     auto elementalAddrOp = builder.create<hlfir::ElementalAddrOp>(
782         loc, shape, mold, mlir::ValueRange{},
783         /*isUnordered=*/true);
784     setVectorSubscriptElementAddrOp(elementalAddrOp);
785     builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front());
786     mlir::Region::BlockArgListType indices = elementalAddrOp.getIndices();
787     auto indicesIterator = indices.begin();
788     auto getNextOneBasedIndex = [&]() -> mlir::Value {
789       assert(indicesIterator != indices.end() && "ill formed ElementalAddrOp");
790       return *(indicesIterator++);
791     };
792     // Transform the designator into a scalar designator computing the vector
793     // subscripted entity element address given one based indices (for the shape
794     // of the vector subscripted designator).
795     for (hlfir::DesignateOp::Subscript &subscript : partInfo.subscripts) {
796       if (auto *triplet =
797               std::get_if<hlfir::DesignateOp::Triplet>(&subscript)) {
798         // subscript = (lb + (i-1)*step)
799         mlir::Value scalarSubscript = computeTripletPosition(
800             loc, builder, *triplet, getNextOneBasedIndex());
801         subscript = scalarSubscript;
802       } else {
803         hlfir::Entity valueSubscript{std::get<mlir::Value>(subscript)};
804         if (valueSubscript.isScalar())
805           continue;
806         // subscript = vector(i + (vector_lb-1))
807         hlfir::Entity scalarSubscript = hlfir::getElementAt(
808             loc, builder, valueSubscript, {getNextOneBasedIndex()});
809         scalarSubscript =
810             hlfir::loadTrivialScalar(loc, builder, scalarSubscript);
811         subscript = scalarSubscript;
812       }
813     }
814     builder.setInsertionPoint(elementalAddrOp);
815     return mlir::cast<fir::SequenceType>(baseType).getElementType();
816   }
817 
818   /// Yield the designator for the final part-ref inside the
819   /// hlfir.elemental_addr.
820   void finalizeElementAddrOp(hlfir::ElementalAddrOp elementalAddrOp,
821                              hlfir::EntityWithAttributes elementAddr) {
822     fir::FirOpBuilder &builder = getBuilder();
823     builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front());
824     if (!elementAddr.isPolymorphic())
825       elementalAddrOp.getMoldMutable().clear();
826     builder.create<hlfir::YieldOp>(loc, elementAddr);
827     builder.setInsertionPointAfter(elementalAddrOp);
828   }
829 
830   /// If the lowered designator has vector subscripts turn it into an
831   /// ElementalOp, otherwise, return the lowered designator. This should
832   /// only be called if the user did not request to get the
833   /// hlfir.elemental_addr. In Fortran, vector subscripted designators are only
834   /// writable on the left-hand side of an assignment and in input IO
835   /// statements. Otherwise, they are not variables (cannot be modified, their
836   /// value is taken at the place they appear).
837   hlfir::EntityWithAttributes turnVectorSubscriptedDesignatorIntoValue(
838       hlfir::EntityWithAttributes loweredDesignator) {
839     std::optional<hlfir::ElementalAddrOp> elementalAddrOp =
840         getVectorSubscriptElementAddrOp();
841     if (!elementalAddrOp)
842       return loweredDesignator;
843     finalizeElementAddrOp(*elementalAddrOp, loweredDesignator);
844     // This vector subscript designator is only being read, transform the
845     // hlfir.elemental_addr into an hlfir.elemental.  The content of the
846     // hlfir.elemental_addr is cloned, and the resulting address is loaded to
847     // get the new element value.
848     fir::FirOpBuilder &builder = getBuilder();
849     mlir::Location loc = getLoc();
850     mlir::Value elemental =
851         hlfir::cloneToElementalOp(loc, builder, *elementalAddrOp);
852     (*elementalAddrOp)->erase();
853     setVectorSubscriptElementAddrOp(std::nullopt);
854     fir::FirOpBuilder *bldr = &builder;
855     getStmtCtx().attachCleanup(
856         [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
857     return hlfir::EntityWithAttributes{elemental};
858   }
859 
860   /// Lower a subscript expression. If it is a scalar subscript that is a
861   /// variable, it is loaded into an integer value. If it is an array (for
862   /// vector subscripts) it is dereferenced if this is an allocatable or
863   /// pointer.
864   template <typename T>
865   hlfir::Entity genSubscript(const Fortran::evaluate::Expr<T> &expr);
866 
867   const std::optional<hlfir::ElementalAddrOp> &
868   getVectorSubscriptElementAddrOp() const {
869     return vectorSubscriptElementAddrOp;
870   }
871   void setVectorSubscriptElementAddrOp(
872       std::optional<hlfir::ElementalAddrOp> elementalAddrOp) {
873     vectorSubscriptElementAddrOp = elementalAddrOp;
874   }
875 
876   mlir::Location getLoc() const { return loc; }
877   Fortran::lower::AbstractConverter &getConverter() { return converter; }
878   fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); }
879   Fortran::lower::SymMap &getSymMap() { return symMap; }
880   Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; }
881 
882   Fortran::lower::AbstractConverter &converter;
883   Fortran::lower::SymMap &symMap;
884   Fortran::lower::StatementContext &stmtCtx;
885   // If there is a vector subscript, an elementalAddrOp is created
886   // to compute the address of the designator elements.
887   std::optional<hlfir::ElementalAddrOp> vectorSubscriptElementAddrOp{};
888   mlir::Location loc;
889 };
890 
891 hlfir::EntityWithAttributes HlfirDesignatorBuilder::genDesignatorExpr(
892     const Fortran::lower::SomeExpr &designatorExpr,
893     bool vectorSubscriptDesignatorToValue) {
894   // Expr<SomeType> plumbing to unwrap Designator<T> and call
895   // gen(Designator<T>.u).
896   return Fortran::common::visit(
897       [&](const auto &x) -> hlfir::EntityWithAttributes {
898         using T = std::decay_t<decltype(x)>;
899         if constexpr (Fortran::common::HasMember<
900                           T, Fortran::lower::CategoryExpression>) {
901           if constexpr (T::Result::category ==
902                         Fortran::common::TypeCategory::Derived) {
903             return gen(std::get<Fortran::evaluate::Designator<
904                            Fortran::evaluate::SomeDerived>>(x.u)
905                            .u,
906                        vectorSubscriptDesignatorToValue);
907           } else {
908             return Fortran::common::visit(
909                 [&](const auto &preciseKind) {
910                   using TK =
911                       typename std::decay_t<decltype(preciseKind)>::Result;
912                   return gen(
913                       std::get<Fortran::evaluate::Designator<TK>>(preciseKind.u)
914                           .u,
915                       vectorSubscriptDesignatorToValue);
916                 },
917                 x.u);
918           }
919         } else {
920           fir::emitFatalError(loc, "unexpected typeless Designator");
921         }
922       },
923       designatorExpr.u);
924 }
925 
926 hlfir::ElementalAddrOp
927 HlfirDesignatorBuilder::convertVectorSubscriptedExprToElementalAddr(
928     const Fortran::lower::SomeExpr &designatorExpr) {
929 
930   hlfir::EntityWithAttributes elementAddrEntity = genDesignatorExpr(
931       designatorExpr, /*vectorSubscriptDesignatorToValue=*/false);
932   assert(getVectorSubscriptElementAddrOp().has_value() &&
933          "expected vector subscripts");
934   hlfir::ElementalAddrOp elementalAddrOp = *getVectorSubscriptElementAddrOp();
935   // Now that the type parameters have been computed, add then to the
936   // hlfir.elemental_addr.
937   fir::FirOpBuilder &builder = getBuilder();
938   llvm::SmallVector<mlir::Value, 1> lengths;
939   hlfir::genLengthParameters(loc, builder, elementAddrEntity, lengths);
940   if (!lengths.empty())
941     elementalAddrOp.getTypeparamsMutable().assign(lengths);
942   if (!elementAddrEntity.isPolymorphic())
943     elementalAddrOp.getMoldMutable().clear();
944   // Create the hlfir.yield terminator inside the hlfir.elemental_body.
945   builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front());
946   builder.create<hlfir::YieldOp>(loc, elementAddrEntity);
947   builder.setInsertionPointAfter(elementalAddrOp);
948   // Reset the HlfirDesignatorBuilder state, in case it is used on a new
949   // designator.
950   setVectorSubscriptElementAddrOp(std::nullopt);
951   return elementalAddrOp;
952 }
953 
954 //===--------------------------------------------------------------------===//
955 // Binary Operation implementation
956 //===--------------------------------------------------------------------===//
957 
958 template <typename T>
959 struct BinaryOp {};
960 
961 #undef GENBIN
962 #define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
963   template <int KIND>                                                          \
964   struct BinaryOp<Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type<       \
965       Fortran::common::TypeCategory::GenBinTyCat, KIND>>> {                    \
966     using Op = Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type<          \
967         Fortran::common::TypeCategory::GenBinTyCat, KIND>>;                    \
968     static hlfir::EntityWithAttributes gen(mlir::Location loc,                 \
969                                            fir::FirOpBuilder &builder,         \
970                                            const Op &, hlfir::Entity lhs,      \
971                                            hlfir::Entity rhs) {                \
972       if constexpr (Fortran::common::TypeCategory::GenBinTyCat ==              \
973                     Fortran::common::TypeCategory::Unsigned) {                 \
974         return hlfir::EntityWithAttributes{                                    \
975             builder.createUnsigned<GenBinFirOp>(loc, lhs.getType(), lhs,       \
976                                                 rhs)};                         \
977       } else {                                                                 \
978         return hlfir::EntityWithAttributes{                                    \
979             builder.create<GenBinFirOp>(loc, lhs, rhs)};                       \
980       }                                                                        \
981     }                                                                          \
982   };
983 
984 GENBIN(Add, Integer, mlir::arith::AddIOp)
985 GENBIN(Add, Unsigned, mlir::arith::AddIOp)
986 GENBIN(Add, Real, mlir::arith::AddFOp)
987 GENBIN(Add, Complex, fir::AddcOp)
988 GENBIN(Subtract, Integer, mlir::arith::SubIOp)
989 GENBIN(Subtract, Unsigned, mlir::arith::SubIOp)
990 GENBIN(Subtract, Real, mlir::arith::SubFOp)
991 GENBIN(Subtract, Complex, fir::SubcOp)
992 GENBIN(Multiply, Integer, mlir::arith::MulIOp)
993 GENBIN(Multiply, Unsigned, mlir::arith::MulIOp)
994 GENBIN(Multiply, Real, mlir::arith::MulFOp)
995 GENBIN(Multiply, Complex, fir::MulcOp)
996 GENBIN(Divide, Integer, mlir::arith::DivSIOp)
997 GENBIN(Divide, Unsigned, mlir::arith::DivUIOp)
998 GENBIN(Divide, Real, mlir::arith::DivFOp)
999 
1000 template <int KIND>
1001 struct BinaryOp<Fortran::evaluate::Divide<
1002     Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
1003   using Op = Fortran::evaluate::Divide<
1004       Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
1005   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1006                                          fir::FirOpBuilder &builder, const Op &,
1007                                          hlfir::Entity lhs, hlfir::Entity rhs) {
1008     mlir::Type ty = Fortran::lower::getFIRType(
1009         builder.getContext(), Fortran::common::TypeCategory::Complex, KIND,
1010         /*params=*/std::nullopt);
1011     return hlfir::EntityWithAttributes{
1012         fir::genDivC(builder, loc, ty, lhs, rhs)};
1013   }
1014 };
1015 
1016 template <Fortran::common::TypeCategory TC, int KIND>
1017 struct BinaryOp<Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>> {
1018   using Op = Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>;
1019   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1020                                          fir::FirOpBuilder &builder, const Op &,
1021                                          hlfir::Entity lhs, hlfir::Entity rhs) {
1022     mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
1023                                                /*params=*/std::nullopt);
1024     return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
1025   }
1026 };
1027 
1028 template <Fortran::common::TypeCategory TC, int KIND>
1029 struct BinaryOp<
1030     Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>> {
1031   using Op =
1032       Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>;
1033   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1034                                          fir::FirOpBuilder &builder, const Op &,
1035                                          hlfir::Entity lhs, hlfir::Entity rhs) {
1036     mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
1037                                                /*params=*/std::nullopt);
1038     return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
1039   }
1040 };
1041 
1042 template <Fortran::common::TypeCategory TC, int KIND>
1043 struct BinaryOp<
1044     Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>> {
1045   using Op = Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>;
1046   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1047                                          fir::FirOpBuilder &builder,
1048                                          const Op &op, hlfir::Entity lhs,
1049                                          hlfir::Entity rhs) {
1050     llvm::SmallVector<mlir::Value, 2> args{lhs, rhs};
1051     fir::ExtendedValue res = op.ordering == Fortran::evaluate::Ordering::Greater
1052                                  ? fir::genMax(builder, loc, args)
1053                                  : fir::genMin(builder, loc, args);
1054     return hlfir::EntityWithAttributes{fir::getBase(res)};
1055   }
1056 };
1057 
1058 // evaluate::Extremum is only created by the front-end when building compiler
1059 // generated expressions (like when folding LEN() or shape/bounds inquiries).
1060 // MIN and MAX are represented as evaluate::ProcedureRef and are not going
1061 // through here. So far the frontend does not generate character Extremum so
1062 // there is no way to test it.
1063 template <int KIND>
1064 struct BinaryOp<Fortran::evaluate::Extremum<
1065     Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> {
1066   using Op = Fortran::evaluate::Extremum<
1067       Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>;
1068   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1069                                          fir::FirOpBuilder &, const Op &,
1070                                          hlfir::Entity, hlfir::Entity) {
1071     fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected");
1072   }
1073   static void genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &,
1074                                   hlfir::Entity, hlfir::Entity,
1075                                   llvm::SmallVectorImpl<mlir::Value> &) {
1076     fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected");
1077   }
1078 };
1079 
1080 /// Convert parser's INTEGER relational operators to MLIR.
1081 static mlir::arith::CmpIPredicate
1082 translateSignedRelational(Fortran::common::RelationalOperator rop) {
1083   switch (rop) {
1084   case Fortran::common::RelationalOperator::LT:
1085     return mlir::arith::CmpIPredicate::slt;
1086   case Fortran::common::RelationalOperator::LE:
1087     return mlir::arith::CmpIPredicate::sle;
1088   case Fortran::common::RelationalOperator::EQ:
1089     return mlir::arith::CmpIPredicate::eq;
1090   case Fortran::common::RelationalOperator::NE:
1091     return mlir::arith::CmpIPredicate::ne;
1092   case Fortran::common::RelationalOperator::GT:
1093     return mlir::arith::CmpIPredicate::sgt;
1094   case Fortran::common::RelationalOperator::GE:
1095     return mlir::arith::CmpIPredicate::sge;
1096   }
1097   llvm_unreachable("unhandled INTEGER relational operator");
1098 }
1099 
1100 static mlir::arith::CmpIPredicate
1101 translateUnsignedRelational(Fortran::common::RelationalOperator rop) {
1102   switch (rop) {
1103   case Fortran::common::RelationalOperator::LT:
1104     return mlir::arith::CmpIPredicate::ult;
1105   case Fortran::common::RelationalOperator::LE:
1106     return mlir::arith::CmpIPredicate::ule;
1107   case Fortran::common::RelationalOperator::EQ:
1108     return mlir::arith::CmpIPredicate::eq;
1109   case Fortran::common::RelationalOperator::NE:
1110     return mlir::arith::CmpIPredicate::ne;
1111   case Fortran::common::RelationalOperator::GT:
1112     return mlir::arith::CmpIPredicate::ugt;
1113   case Fortran::common::RelationalOperator::GE:
1114     return mlir::arith::CmpIPredicate::uge;
1115   }
1116   llvm_unreachable("unhandled UNSIGNED relational operator");
1117 }
1118 
1119 /// Convert parser's REAL relational operators to MLIR.
1120 /// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018
1121 /// requirements in the IEEE context (table 17.1 of F2018). This choice is
1122 /// also applied in other contexts because it is easier and in line with
1123 /// other Fortran compilers.
1124 /// FIXME: The signaling/quiet aspect of the table 17.1 requirement is not
1125 /// fully enforced. FIR and LLVM `fcmp` instructions do not give any guarantee
1126 /// whether the comparison will signal or not in case of quiet NaN argument.
1127 static mlir::arith::CmpFPredicate
1128 translateFloatRelational(Fortran::common::RelationalOperator rop) {
1129   switch (rop) {
1130   case Fortran::common::RelationalOperator::LT:
1131     return mlir::arith::CmpFPredicate::OLT;
1132   case Fortran::common::RelationalOperator::LE:
1133     return mlir::arith::CmpFPredicate::OLE;
1134   case Fortran::common::RelationalOperator::EQ:
1135     return mlir::arith::CmpFPredicate::OEQ;
1136   case Fortran::common::RelationalOperator::NE:
1137     return mlir::arith::CmpFPredicate::UNE;
1138   case Fortran::common::RelationalOperator::GT:
1139     return mlir::arith::CmpFPredicate::OGT;
1140   case Fortran::common::RelationalOperator::GE:
1141     return mlir::arith::CmpFPredicate::OGE;
1142   }
1143   llvm_unreachable("unhandled REAL relational operator");
1144 }
1145 
1146 template <int KIND>
1147 struct BinaryOp<Fortran::evaluate::Relational<
1148     Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> {
1149   using Op = Fortran::evaluate::Relational<
1150       Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>;
1151   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1152                                          fir::FirOpBuilder &builder,
1153                                          const Op &op, hlfir::Entity lhs,
1154                                          hlfir::Entity rhs) {
1155     auto cmp = builder.create<mlir::arith::CmpIOp>(
1156         loc, translateSignedRelational(op.opr), lhs, rhs);
1157     return hlfir::EntityWithAttributes{cmp};
1158   }
1159 };
1160 
1161 template <int KIND>
1162 struct BinaryOp<Fortran::evaluate::Relational<
1163     Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
1164   using Op = Fortran::evaluate::Relational<
1165       Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
1166   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1167                                          fir::FirOpBuilder &builder,
1168                                          const Op &op, hlfir::Entity lhs,
1169                                          hlfir::Entity rhs) {
1170     int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
1171                                        KIND>::Scalar::bits;
1172     auto signlessType = mlir::IntegerType::get(
1173         builder.getContext(), bits,
1174         mlir::IntegerType::SignednessSemantics::Signless);
1175     mlir::Value lhsSL = builder.createConvert(loc, signlessType, lhs);
1176     mlir::Value rhsSL = builder.createConvert(loc, signlessType, rhs);
1177     auto cmp = builder.create<mlir::arith::CmpIOp>(
1178         loc, translateUnsignedRelational(op.opr), lhsSL, rhsSL);
1179     return hlfir::EntityWithAttributes{cmp};
1180   }
1181 };
1182 
1183 template <int KIND>
1184 struct BinaryOp<Fortran::evaluate::Relational<
1185     Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
1186   using Op = Fortran::evaluate::Relational<
1187       Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>;
1188   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1189                                          fir::FirOpBuilder &builder,
1190                                          const Op &op, hlfir::Entity lhs,
1191                                          hlfir::Entity rhs) {
1192     auto cmp = builder.create<mlir::arith::CmpFOp>(
1193         loc, translateFloatRelational(op.opr), lhs, rhs);
1194     return hlfir::EntityWithAttributes{cmp};
1195   }
1196 };
1197 
1198 template <int KIND>
1199 struct BinaryOp<Fortran::evaluate::Relational<
1200     Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
1201   using Op = Fortran::evaluate::Relational<
1202       Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
1203   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1204                                          fir::FirOpBuilder &builder,
1205                                          const Op &op, hlfir::Entity lhs,
1206                                          hlfir::Entity rhs) {
1207     auto cmp = builder.create<fir::CmpcOp>(
1208         loc, translateFloatRelational(op.opr), lhs, rhs);
1209     return hlfir::EntityWithAttributes{cmp};
1210   }
1211 };
1212 
1213 template <int KIND>
1214 struct BinaryOp<Fortran::evaluate::Relational<
1215     Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> {
1216   using Op = Fortran::evaluate::Relational<
1217       Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>;
1218   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1219                                          fir::FirOpBuilder &builder,
1220                                          const Op &op, hlfir::Entity lhs,
1221                                          hlfir::Entity rhs) {
1222     auto [lhsExv, lhsCleanUp] =
1223         hlfir::translateToExtendedValue(loc, builder, lhs);
1224     auto [rhsExv, rhsCleanUp] =
1225         hlfir::translateToExtendedValue(loc, builder, rhs);
1226     auto cmp = fir::runtime::genCharCompare(
1227         builder, loc, translateSignedRelational(op.opr), lhsExv, rhsExv);
1228     if (lhsCleanUp)
1229       (*lhsCleanUp)();
1230     if (rhsCleanUp)
1231       (*rhsCleanUp)();
1232     return hlfir::EntityWithAttributes{cmp};
1233   }
1234 };
1235 
1236 template <int KIND>
1237 struct BinaryOp<Fortran::evaluate::LogicalOperation<KIND>> {
1238   using Op = Fortran::evaluate::LogicalOperation<KIND>;
1239   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1240                                          fir::FirOpBuilder &builder,
1241                                          const Op &op, hlfir::Entity lhs,
1242                                          hlfir::Entity rhs) {
1243     mlir::Type i1Type = builder.getI1Type();
1244     mlir::Value i1Lhs = builder.createConvert(loc, i1Type, lhs);
1245     mlir::Value i1Rhs = builder.createConvert(loc, i1Type, rhs);
1246     switch (op.logicalOperator) {
1247     case Fortran::evaluate::LogicalOperator::And:
1248       return hlfir::EntityWithAttributes{
1249           builder.create<mlir::arith::AndIOp>(loc, i1Lhs, i1Rhs)};
1250     case Fortran::evaluate::LogicalOperator::Or:
1251       return hlfir::EntityWithAttributes{
1252           builder.create<mlir::arith::OrIOp>(loc, i1Lhs, i1Rhs)};
1253     case Fortran::evaluate::LogicalOperator::Eqv:
1254       return hlfir::EntityWithAttributes{builder.create<mlir::arith::CmpIOp>(
1255           loc, mlir::arith::CmpIPredicate::eq, i1Lhs, i1Rhs)};
1256     case Fortran::evaluate::LogicalOperator::Neqv:
1257       return hlfir::EntityWithAttributes{builder.create<mlir::arith::CmpIOp>(
1258           loc, mlir::arith::CmpIPredicate::ne, i1Lhs, i1Rhs)};
1259     case Fortran::evaluate::LogicalOperator::Not:
1260       // lib/evaluate expression for .NOT. is Fortran::evaluate::Not<KIND>.
1261       llvm_unreachable(".NOT. is not a binary operator");
1262     }
1263     llvm_unreachable("unhandled logical operation");
1264   }
1265 };
1266 
1267 template <int KIND>
1268 struct BinaryOp<Fortran::evaluate::ComplexConstructor<KIND>> {
1269   using Op = Fortran::evaluate::ComplexConstructor<KIND>;
1270   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1271                                          fir::FirOpBuilder &builder, const Op &,
1272                                          hlfir::Entity lhs, hlfir::Entity rhs) {
1273     mlir::Value res =
1274         fir::factory::Complex{builder, loc}.createComplex(lhs, rhs);
1275     return hlfir::EntityWithAttributes{res};
1276   }
1277 };
1278 
1279 template <int KIND>
1280 struct BinaryOp<Fortran::evaluate::SetLength<KIND>> {
1281   using Op = Fortran::evaluate::SetLength<KIND>;
1282   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1283                                          fir::FirOpBuilder &builder, const Op &,
1284                                          hlfir::Entity string,
1285                                          hlfir::Entity length) {
1286     // The input length may be a user input and needs to be sanitized as per
1287     // Fortran 2018 7.4.4.2 point 5.
1288     mlir::Value safeLength = fir::factory::genMaxWithZero(builder, loc, length);
1289     return hlfir::EntityWithAttributes{
1290         builder.create<hlfir::SetLengthOp>(loc, string, safeLength)};
1291   }
1292   static void
1293   genResultTypeParams(mlir::Location, fir::FirOpBuilder &, hlfir::Entity,
1294                       hlfir::Entity rhs,
1295                       llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
1296     resultTypeParams.push_back(rhs);
1297   }
1298 };
1299 
1300 template <int KIND>
1301 struct BinaryOp<Fortran::evaluate::Concat<KIND>> {
1302   using Op = Fortran::evaluate::Concat<KIND>;
1303   hlfir::EntityWithAttributes gen(mlir::Location loc,
1304                                   fir::FirOpBuilder &builder, const Op &,
1305                                   hlfir::Entity lhs, hlfir::Entity rhs) {
1306     assert(len && "genResultTypeParams must have been called");
1307     auto concat =
1308         builder.create<hlfir::ConcatOp>(loc, mlir::ValueRange{lhs, rhs}, len);
1309     return hlfir::EntityWithAttributes{concat.getResult()};
1310   }
1311   void
1312   genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
1313                       hlfir::Entity lhs, hlfir::Entity rhs,
1314                       llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
1315     llvm::SmallVector<mlir::Value> lengths;
1316     hlfir::genLengthParameters(loc, builder, lhs, lengths);
1317     hlfir::genLengthParameters(loc, builder, rhs, lengths);
1318     assert(lengths.size() == 2 && "lacks rhs or lhs length");
1319     mlir::Type idxType = builder.getIndexType();
1320     mlir::Value lhsLen = builder.createConvert(loc, idxType, lengths[0]);
1321     mlir::Value rhsLen = builder.createConvert(loc, idxType, lengths[1]);
1322     len = builder.create<mlir::arith::AddIOp>(loc, lhsLen, rhsLen);
1323     resultTypeParams.push_back(len);
1324   }
1325 
1326 private:
1327   mlir::Value len{};
1328 };
1329 
1330 //===--------------------------------------------------------------------===//
1331 // Unary Operation implementation
1332 //===--------------------------------------------------------------------===//
1333 
1334 template <typename T>
1335 struct UnaryOp {};
1336 
1337 template <int KIND>
1338 struct UnaryOp<Fortran::evaluate::Not<KIND>> {
1339   using Op = Fortran::evaluate::Not<KIND>;
1340   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1341                                          fir::FirOpBuilder &builder, const Op &,
1342                                          hlfir::Entity lhs) {
1343     mlir::Value one = builder.createBool(loc, true);
1344     mlir::Value val = builder.createConvert(loc, builder.getI1Type(), lhs);
1345     return hlfir::EntityWithAttributes{
1346         builder.create<mlir::arith::XOrIOp>(loc, val, one)};
1347   }
1348 };
1349 
1350 template <int KIND>
1351 struct UnaryOp<Fortran::evaluate::Negate<
1352     Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> {
1353   using Op = Fortran::evaluate::Negate<
1354       Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>;
1355   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1356                                          fir::FirOpBuilder &builder, const Op &,
1357                                          hlfir::Entity lhs) {
1358     // Like LLVM, integer negation is the binary op "0 - value"
1359     mlir::Type type = Fortran::lower::getFIRType(
1360         builder.getContext(), Fortran::common::TypeCategory::Integer, KIND,
1361         /*params=*/std::nullopt);
1362     mlir::Value zero = builder.createIntegerConstant(loc, type, 0);
1363     return hlfir::EntityWithAttributes{
1364         builder.create<mlir::arith::SubIOp>(loc, zero, lhs)};
1365   }
1366 };
1367 
1368 template <int KIND>
1369 struct UnaryOp<Fortran::evaluate::Negate<
1370     Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
1371   using Op = Fortran::evaluate::Negate<
1372       Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
1373   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1374                                          fir::FirOpBuilder &builder, const Op &,
1375                                          hlfir::Entity lhs) {
1376     int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
1377                                        KIND>::Scalar::bits;
1378     mlir::Type signlessType = mlir::IntegerType::get(
1379         builder.getContext(), bits,
1380         mlir::IntegerType::SignednessSemantics::Signless);
1381     mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
1382     mlir::Value signless = builder.createConvert(loc, signlessType, lhs);
1383     mlir::Value negated =
1384         builder.create<mlir::arith::SubIOp>(loc, zero, signless);
1385     return hlfir::EntityWithAttributes(
1386         builder.createConvert(loc, lhs.getType(), negated));
1387   }
1388 };
1389 
1390 template <int KIND>
1391 struct UnaryOp<Fortran::evaluate::Negate<
1392     Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
1393   using Op = Fortran::evaluate::Negate<
1394       Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>;
1395   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1396                                          fir::FirOpBuilder &builder, const Op &,
1397                                          hlfir::Entity lhs) {
1398     return hlfir::EntityWithAttributes{
1399         builder.create<mlir::arith::NegFOp>(loc, lhs)};
1400   }
1401 };
1402 
1403 template <int KIND>
1404 struct UnaryOp<Fortran::evaluate::Negate<
1405     Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
1406   using Op = Fortran::evaluate::Negate<
1407       Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
1408   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1409                                          fir::FirOpBuilder &builder, const Op &,
1410                                          hlfir::Entity lhs) {
1411     return hlfir::EntityWithAttributes{builder.create<fir::NegcOp>(loc, lhs)};
1412   }
1413 };
1414 
1415 template <int KIND>
1416 struct UnaryOp<Fortran::evaluate::ComplexComponent<KIND>> {
1417   using Op = Fortran::evaluate::ComplexComponent<KIND>;
1418   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1419                                          fir::FirOpBuilder &builder,
1420                                          const Op &op, hlfir::Entity lhs) {
1421     mlir::Value res = fir::factory::Complex{builder, loc}.extractComplexPart(
1422         lhs, op.isImaginaryPart);
1423     return hlfir::EntityWithAttributes{res};
1424   }
1425 };
1426 
1427 template <typename T>
1428 struct UnaryOp<Fortran::evaluate::Parentheses<T>> {
1429   using Op = Fortran::evaluate::Parentheses<T>;
1430   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1431                                          fir::FirOpBuilder &builder,
1432                                          const Op &op, hlfir::Entity lhs) {
1433     if (lhs.isVariable())
1434       return hlfir::EntityWithAttributes{
1435           builder.create<hlfir::AsExprOp>(loc, lhs)};
1436     return hlfir::EntityWithAttributes{
1437         builder.create<hlfir::NoReassocOp>(loc, lhs.getType(), lhs)};
1438   }
1439 
1440   static void
1441   genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
1442                       hlfir::Entity lhs,
1443                       llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
1444     hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams);
1445   }
1446 };
1447 
1448 template <Fortran::common::TypeCategory TC1, int KIND,
1449           Fortran::common::TypeCategory TC2>
1450 struct UnaryOp<
1451     Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>> {
1452   using Op =
1453       Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>;
1454   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1455                                          fir::FirOpBuilder &builder, const Op &,
1456                                          hlfir::Entity lhs) {
1457     if constexpr (TC1 == Fortran::common::TypeCategory::Character &&
1458                   TC2 == TC1) {
1459       return hlfir::convertCharacterKind(loc, builder, lhs, KIND);
1460     }
1461     mlir::Type type = Fortran::lower::getFIRType(builder.getContext(), TC1,
1462                                                  KIND, /*params=*/std::nullopt);
1463     mlir::Value res = builder.convertWithSemantics(loc, type, lhs);
1464     return hlfir::EntityWithAttributes{res};
1465   }
1466 
1467   static void
1468   genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
1469                       hlfir::Entity lhs,
1470                       llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
1471     hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams);
1472   }
1473 };
1474 
1475 static bool hasDeferredCharacterLength(const Fortran::semantics::Symbol &sym) {
1476   const Fortran::semantics::DeclTypeSpec *type = sym.GetType();
1477   return type &&
1478          type->category() ==
1479              Fortran::semantics::DeclTypeSpec::Category::Character &&
1480          type->characterTypeSpec().length().isDeferred();
1481 }
1482 
1483 /// Lower Expr to HLFIR.
1484 class HlfirBuilder {
1485 public:
1486   HlfirBuilder(mlir::Location loc, Fortran::lower::AbstractConverter &converter,
1487                Fortran::lower::SymMap &symMap,
1488                Fortran::lower::StatementContext &stmtCtx)
1489       : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {}
1490 
1491   template <typename T>
1492   hlfir::EntityWithAttributes gen(const Fortran::evaluate::Expr<T> &expr) {
1493     if (const Fortran::lower::ExprToValueMap *map =
1494             getConverter().getExprOverrides()) {
1495       if constexpr (std::is_same_v<T, Fortran::evaluate::SomeType>) {
1496         if (auto match = map->find(&expr); match != map->end())
1497           return hlfir::EntityWithAttributes{match->second};
1498       } else {
1499         Fortran::lower::SomeExpr someExpr = toEvExpr(expr);
1500         if (auto match = map->find(&someExpr); match != map->end())
1501           return hlfir::EntityWithAttributes{match->second};
1502       }
1503     }
1504     return Fortran::common::visit([&](const auto &x) { return gen(x); },
1505                                   expr.u);
1506   }
1507 
1508 private:
1509   hlfir::EntityWithAttributes
1510   gen(const Fortran::evaluate::BOZLiteralConstant &expr) {
1511     TODO(getLoc(), "BOZ");
1512   }
1513 
1514   hlfir::EntityWithAttributes gen(const Fortran::evaluate::NullPointer &expr) {
1515     auto nullop = getBuilder().create<hlfir::NullOp>(getLoc());
1516     return mlir::cast<fir::FortranVariableOpInterface>(nullop.getOperation());
1517   }
1518 
1519   hlfir::EntityWithAttributes
1520   gen(const Fortran::evaluate::ProcedureDesignator &proc) {
1521     return Fortran::lower::convertProcedureDesignatorToHLFIR(
1522         getLoc(), getConverter(), proc, getSymMap(), getStmtCtx());
1523   }
1524 
1525   hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) {
1526     Fortran::evaluate::ProcedureDesignator proc{expr.proc()};
1527     auto procTy{Fortran::lower::translateSignature(proc, getConverter())};
1528     auto result = Fortran::lower::convertCallToHLFIR(getLoc(), getConverter(),
1529                                                      expr, procTy.getResult(0),
1530                                                      getSymMap(), getStmtCtx());
1531     assert(result.has_value());
1532     return *result;
1533   }
1534 
1535   template <typename T>
1536   hlfir::EntityWithAttributes
1537   gen(const Fortran::evaluate::Designator<T> &designator) {
1538     return HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(),
1539                                   getStmtCtx())
1540         .gen(designator.u);
1541   }
1542 
1543   template <typename T>
1544   hlfir::EntityWithAttributes
1545   gen(const Fortran::evaluate::FunctionRef<T> &expr) {
1546     mlir::Type resType =
1547         Fortran::lower::TypeBuilder<T>::genType(getConverter(), expr);
1548     auto result = Fortran::lower::convertCallToHLFIR(
1549         getLoc(), getConverter(), expr, resType, getSymMap(), getStmtCtx());
1550     assert(result.has_value());
1551     return *result;
1552   }
1553 
1554   template <typename T>
1555   hlfir::EntityWithAttributes gen(const Fortran::evaluate::Constant<T> &expr) {
1556     mlir::Location loc = getLoc();
1557     fir::FirOpBuilder &builder = getBuilder();
1558     fir::ExtendedValue exv = Fortran::lower::convertConstant(
1559         converter, loc, expr, /*outlineBigConstantInReadOnlyMemory=*/true);
1560     if (const auto *scalarBox = exv.getUnboxed())
1561       if (fir::isa_trivial(scalarBox->getType()))
1562         return hlfir::EntityWithAttributes(*scalarBox);
1563     if (auto addressOf = fir::getBase(exv).getDefiningOp<fir::AddrOfOp>()) {
1564       auto flags = fir::FortranVariableFlagsAttr::get(
1565           builder.getContext(), fir::FortranVariableFlagsEnum::parameter);
1566       return hlfir::genDeclare(
1567           loc, builder, exv,
1568           addressOf.getSymbol().getRootReference().getValue(), flags);
1569     }
1570     fir::emitFatalError(loc, "Constant<T> was lowered to unexpected format");
1571   }
1572 
1573   template <typename T>
1574   hlfir::EntityWithAttributes
1575   gen(const Fortran::evaluate::ArrayConstructor<T> &arrayCtor) {
1576     return Fortran::lower::ArrayConstructorBuilder<T>::gen(
1577         getLoc(), getConverter(), arrayCtor, getSymMap(), getStmtCtx());
1578   }
1579 
1580   template <typename D, typename R, typename O>
1581   hlfir::EntityWithAttributes
1582   gen(const Fortran::evaluate::Operation<D, R, O> &op) {
1583     auto &builder = getBuilder();
1584     mlir::Location loc = getLoc();
1585     const int rank = op.Rank();
1586     UnaryOp<D> unaryOp;
1587     auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left()));
1588     llvm::SmallVector<mlir::Value, 1> typeParams;
1589     if constexpr (R::category == Fortran::common::TypeCategory::Character) {
1590       unaryOp.genResultTypeParams(loc, builder, left, typeParams);
1591     }
1592     if (rank == 0)
1593       return unaryOp.gen(loc, builder, op.derived(), left);
1594 
1595     // Elemental expression.
1596     mlir::Type elementType;
1597     if constexpr (R::category == Fortran::common::TypeCategory::Derived) {
1598       if (op.derived().GetType().IsUnlimitedPolymorphic())
1599         elementType = mlir::NoneType::get(builder.getContext());
1600       else
1601         elementType = Fortran::lower::translateDerivedTypeToFIRType(
1602             getConverter(), op.derived().GetType().GetDerivedTypeSpec());
1603     } else {
1604       elementType =
1605           Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind,
1606                                      /*params=*/std::nullopt);
1607     }
1608     mlir::Value shape = hlfir::genShape(loc, builder, left);
1609     auto genKernel = [&op, &left, &unaryOp](
1610                          mlir::Location l, fir::FirOpBuilder &b,
1611                          mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
1612       auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices);
1613       auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement);
1614       return unaryOp.gen(l, b, op.derived(), leftVal);
1615     };
1616     mlir::Value elemental = hlfir::genElementalOp(
1617         loc, builder, elementType, shape, typeParams, genKernel,
1618         /*isUnordered=*/true, left.isPolymorphic() ? left : mlir::Value{});
1619     fir::FirOpBuilder *bldr = &builder;
1620     getStmtCtx().attachCleanup(
1621         [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
1622     return hlfir::EntityWithAttributes{elemental};
1623   }
1624 
1625   template <typename D, typename R, typename LO, typename RO>
1626   hlfir::EntityWithAttributes
1627   gen(const Fortran::evaluate::Operation<D, R, LO, RO> &op) {
1628     auto &builder = getBuilder();
1629     mlir::Location loc = getLoc();
1630     const int rank = op.Rank();
1631     BinaryOp<D> binaryOp;
1632     auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left()));
1633     auto right = hlfir::loadTrivialScalar(loc, builder, gen(op.right()));
1634     llvm::SmallVector<mlir::Value, 1> typeParams;
1635     if constexpr (R::category == Fortran::common::TypeCategory::Character) {
1636       binaryOp.genResultTypeParams(loc, builder, left, right, typeParams);
1637     }
1638     if (rank == 0)
1639       return binaryOp.gen(loc, builder, op.derived(), left, right);
1640 
1641     // Elemental expression.
1642     mlir::Type elementType =
1643         Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind,
1644                                    /*params=*/std::nullopt);
1645     // TODO: "merge" shape, get cst shape from front-end if possible.
1646     mlir::Value shape;
1647     if (left.isArray()) {
1648       shape = hlfir::genShape(loc, builder, left);
1649     } else {
1650       assert(right.isArray() && "must have at least one array operand");
1651       shape = hlfir::genShape(loc, builder, right);
1652     }
1653     auto genKernel = [&op, &left, &right, &binaryOp](
1654                          mlir::Location l, fir::FirOpBuilder &b,
1655                          mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
1656       auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices);
1657       auto rightElement = hlfir::getElementAt(l, b, right, oneBasedIndices);
1658       auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement);
1659       auto rightVal = hlfir::loadTrivialScalar(l, b, rightElement);
1660       return binaryOp.gen(l, b, op.derived(), leftVal, rightVal);
1661     };
1662     auto iofBackup = builder.getIntegerOverflowFlags();
1663     // nsw is never added to operations on vector subscripts
1664     // even if -fno-wrapv is enabled.
1665     builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::none);
1666     mlir::Value elemental = hlfir::genElementalOp(loc, builder, elementType,
1667                                                   shape, typeParams, genKernel,
1668                                                   /*isUnordered=*/true);
1669     builder.setIntegerOverflowFlags(iofBackup);
1670     fir::FirOpBuilder *bldr = &builder;
1671     getStmtCtx().attachCleanup(
1672         [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
1673     return hlfir::EntityWithAttributes{elemental};
1674   }
1675 
1676   hlfir::EntityWithAttributes
1677   gen(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &op) {
1678     return Fortran::common::visit([&](const auto &x) { return gen(x); }, op.u);
1679   }
1680 
1681   hlfir::EntityWithAttributes gen(const Fortran::evaluate::TypeParamInquiry &) {
1682     TODO(getLoc(), "lowering type parameter inquiry to HLFIR");
1683   }
1684 
1685   hlfir::EntityWithAttributes
1686   gen(const Fortran::evaluate::DescriptorInquiry &desc) {
1687     mlir::Location loc = getLoc();
1688     auto &builder = getBuilder();
1689     hlfir::EntityWithAttributes entity =
1690         HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(),
1691                                getStmtCtx())
1692             .genNamedEntity(desc.base());
1693     using ResTy = Fortran::evaluate::DescriptorInquiry::Result;
1694     mlir::Type resultType =
1695         getConverter().genType(ResTy::category, ResTy::kind);
1696     auto castResult = [&](mlir::Value v) {
1697       return hlfir::EntityWithAttributes{
1698           builder.createConvert(loc, resultType, v)};
1699     };
1700     switch (desc.field()) {
1701     case Fortran::evaluate::DescriptorInquiry::Field::Len:
1702       return castResult(hlfir::genCharLength(loc, builder, entity));
1703     case Fortran::evaluate::DescriptorInquiry::Field::LowerBound:
1704       return castResult(
1705           hlfir::genLBound(loc, builder, entity, desc.dimension()));
1706     case Fortran::evaluate::DescriptorInquiry::Field::Extent:
1707       return castResult(
1708           hlfir::genExtent(loc, builder, entity, desc.dimension()));
1709     case Fortran::evaluate::DescriptorInquiry::Field::Rank:
1710       return castResult(hlfir::genRank(loc, builder, entity, resultType));
1711     case Fortran::evaluate::DescriptorInquiry::Field::Stride:
1712       // So far the front end does not generate this inquiry.
1713       TODO(loc, "stride inquiry");
1714     }
1715     llvm_unreachable("unknown descriptor inquiry");
1716   }
1717 
1718   hlfir::EntityWithAttributes
1719   gen(const Fortran::evaluate::ImpliedDoIndex &var) {
1720     mlir::Value value = symMap.lookupImpliedDo(toStringRef(var.name));
1721     if (!value)
1722       fir::emitFatalError(getLoc(), "ac-do-variable has no binding");
1723     // The index value generated by the implied-do has Index type,
1724     // while computations based on it inside the loop body are using
1725     // the original data type. So we need to cast it appropriately.
1726     mlir::Type varTy = getConverter().genType(toEvExpr(var));
1727     value = getBuilder().createConvert(getLoc(), varTy, value);
1728     return hlfir::EntityWithAttributes{value};
1729   }
1730 
1731   static bool
1732   isDerivedTypeWithLenParameters(const Fortran::semantics::Symbol &sym) {
1733     if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType())
1734       if (const Fortran::semantics::DerivedTypeSpec *derived =
1735               declTy->AsDerived())
1736         return Fortran::semantics::CountLenParameters(*derived) > 0;
1737     return false;
1738   }
1739 
1740   // Construct an entity holding the value specified by the
1741   // StructureConstructor. The initialization of the temporary entity
1742   // is done component by component with the help of HLFIR operations
1743   // DesignateOp and AssignOp.
1744   hlfir::EntityWithAttributes
1745   gen(const Fortran::evaluate::StructureConstructor &ctor) {
1746     mlir::Location loc = getLoc();
1747     fir::FirOpBuilder &builder = getBuilder();
1748     mlir::Type ty = translateSomeExprToFIRType(converter, toEvExpr(ctor));
1749     auto recTy = mlir::cast<fir::RecordType>(ty);
1750 
1751     if (recTy.isDependentType())
1752       TODO(loc, "structure constructor for derived type with length parameters "
1753                 "in HLFIR");
1754 
1755     // Allocate scalar temporary that will be initialized
1756     // with the values specified by the constructor.
1757     mlir::Value storagePtr = builder.createTemporary(loc, recTy);
1758     auto varOp = hlfir::EntityWithAttributes{builder.create<hlfir::DeclareOp>(
1759         loc, storagePtr, "ctor.temp", /*shape=*/nullptr,
1760         /*typeparams=*/mlir::ValueRange{}, /*dummy_scope=*/nullptr,
1761         fir::FortranVariableFlagsAttr{})};
1762 
1763     // Initialize any components that need initialization.
1764     mlir::Value box = builder.createBox(loc, fir::ExtendedValue{varOp});
1765     fir::runtime::genDerivedTypeInitialize(builder, loc, box);
1766 
1767     // StructureConstructor values may relate to name of components in parent
1768     // types. These components cannot be addressed directly, the parent
1769     // components must be addressed first. The loop below creates all the
1770     // required chains of hlfir.designate to address the parent components so
1771     // that the StructureConstructor can later be lowered by addressing these
1772     // parent components if needed. Note: the front-end orders the components in
1773     // structure constructors.
1774     using ValueAndParent = std::tuple<const Fortran::lower::SomeExpr &,
1775                                       const Fortran::semantics::Symbol &,
1776                                       hlfir::EntityWithAttributes>;
1777     llvm::SmallVector<ValueAndParent> valuesAndParents;
1778     for (const auto &value : llvm::reverse(ctor.values())) {
1779       const Fortran::semantics::Symbol &compSym = *value.first;
1780       hlfir::EntityWithAttributes currentParent = varOp;
1781       for (Fortran::lower::ComponentReverseIterator compIterator(
1782                ctor.result().derivedTypeSpec());
1783            !compIterator.lookup(compSym.name());) {
1784         const auto &parentType = compIterator.advanceToParentType();
1785         llvm::StringRef parentName = toStringRef(parentType.name());
1786         auto baseRecTy = mlir::cast<fir::RecordType>(
1787             hlfir::getFortranElementType(currentParent.getType()));
1788         auto parentCompType = baseRecTy.getType(parentName);
1789         assert(parentCompType && "failed to retrieve parent component type");
1790         mlir::Type designatorType = builder.getRefType(parentCompType);
1791         mlir::Value newParent = builder.create<hlfir::DesignateOp>(
1792             loc, designatorType, currentParent, parentName,
1793             /*compShape=*/mlir::Value{}, hlfir::DesignateOp::Subscripts{},
1794             /*substring=*/mlir::ValueRange{},
1795             /*complexPart=*/std::nullopt,
1796             /*shape=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{},
1797             fir::FortranVariableFlagsAttr{});
1798         currentParent = hlfir::EntityWithAttributes{newParent};
1799       }
1800       valuesAndParents.emplace_back(
1801           ValueAndParent{value.second.value(), compSym, currentParent});
1802     }
1803 
1804     HlfirDesignatorBuilder designatorBuilder(loc, converter, symMap, stmtCtx);
1805     for (const auto &iter : llvm::reverse(valuesAndParents)) {
1806       auto &sym = std::get<const Fortran::semantics::Symbol &>(iter);
1807       auto &expr = std::get<const Fortran::lower::SomeExpr &>(iter);
1808       auto &baseOp = std::get<hlfir::EntityWithAttributes>(iter);
1809       std::string name = converter.getRecordTypeFieldName(sym);
1810 
1811       // Generate DesignateOp for the component.
1812       // The designator's result type is just a reference to the component type,
1813       // because the whole component is being designated.
1814       auto baseRecTy = mlir::cast<fir::RecordType>(
1815           hlfir::getFortranElementType(baseOp.getType()));
1816       auto compType = baseRecTy.getType(name);
1817       assert(compType && "failed to retrieve component type");
1818       mlir::Value compShape =
1819           designatorBuilder.genComponentShape(sym, compType);
1820       mlir::Type designatorType = builder.getRefType(compType);
1821 
1822       mlir::Type fieldElemType = hlfir::getFortranElementType(compType);
1823       llvm::SmallVector<mlir::Value, 1> typeParams;
1824       if (auto charType = mlir::dyn_cast<fir::CharacterType>(fieldElemType)) {
1825         if (charType.hasConstantLen()) {
1826           mlir::Type idxType = builder.getIndexType();
1827           typeParams.push_back(
1828               builder.createIntegerConstant(loc, idxType, charType.getLen()));
1829         } else if (!hasDeferredCharacterLength(sym)) {
1830           // If the length is not deferred, this is a parametrized derived type
1831           // where the character length depends on the derived type length
1832           // parameters. Otherwise, this is a pointer/allocatable component and
1833           // the length will be set during the assignment.
1834           TODO(loc, "automatic character component in structure constructor");
1835         }
1836       }
1837 
1838       // Convert component symbol attributes to variable attributes.
1839       fir::FortranVariableFlagsAttr attrs =
1840           Fortran::lower::translateSymbolAttributes(builder.getContext(), sym);
1841 
1842       // Get the component designator.
1843       auto lhs = builder.create<hlfir::DesignateOp>(
1844           loc, designatorType, baseOp, name, compShape,
1845           hlfir::DesignateOp::Subscripts{},
1846           /*substring=*/mlir::ValueRange{},
1847           /*complexPart=*/std::nullopt,
1848           /*shape=*/compShape, typeParams, attrs);
1849 
1850       if (attrs && bitEnumContainsAny(attrs.getFlags(),
1851                                       fir::FortranVariableFlagsEnum::pointer)) {
1852         if (Fortran::semantics::IsProcedure(sym)) {
1853           // Procedure pointer components.
1854           if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
1855                   expr)) {
1856             auto boxTy{
1857                 Fortran::lower::getUntypedBoxProcType(builder.getContext())};
1858             hlfir::Entity rhs(
1859                 fir::factory::createNullBoxProc(builder, loc, boxTy));
1860             builder.createStoreWithConvert(loc, rhs, lhs);
1861             continue;
1862           }
1863           hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress(
1864               loc, converter, expr, symMap, stmtCtx)));
1865           builder.createStoreWithConvert(loc, rhs, lhs);
1866           continue;
1867         }
1868         // Pointer component construction is just a copy of the box contents.
1869         fir::ExtendedValue lhsExv =
1870             hlfir::translateToExtendedValue(loc, builder, lhs);
1871         auto *toBox = lhsExv.getBoxOf<fir::MutableBoxValue>();
1872         if (!toBox)
1873           fir::emitFatalError(loc, "pointer component designator could not be "
1874                                    "lowered to mutable box");
1875         Fortran::lower::associateMutableBox(converter, loc, *toBox, expr,
1876                                             /*lbounds=*/std::nullopt, stmtCtx);
1877         continue;
1878       }
1879 
1880       // Use generic assignment for all the other cases.
1881       bool allowRealloc =
1882           attrs &&
1883           bitEnumContainsAny(attrs.getFlags(),
1884                              fir::FortranVariableFlagsEnum::allocatable);
1885       // If the component is allocatable, then we have to check
1886       // whether the RHS value is allocatable or not.
1887       // If it is not allocatable, then AssignOp can be used directly.
1888       // If it is allocatable, then using AssignOp for unallocated RHS
1889       // will cause illegal dereference. When an unallocated allocatable
1890       // value is used to construct an allocatable component, the component
1891       // must just stay unallocated (see Fortran 2018 7.5.10 point 7).
1892 
1893       // If the component is allocatable and RHS is NULL() expression, then
1894       // we can just skip it: the LHS must remain unallocated with its
1895       // defined rank.
1896       if (allowRealloc &&
1897           Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr))
1898         continue;
1899 
1900       bool keepLhsLength = false;
1901       if (allowRealloc)
1902         if (const Fortran::semantics::DeclTypeSpec *declType = sym.GetType())
1903           keepLhsLength =
1904               declType->category() ==
1905                   Fortran::semantics::DeclTypeSpec::Category::Character &&
1906               !declType->characterTypeSpec().length().isDeferred();
1907       // Handle special case when the initializer expression is
1908       // '{%SET_LENGTH(x,const_kind)}'. In structure constructor,
1909       // SET_LENGTH is used for initializers of non-allocatable character
1910       // components so that the front-end can better
1911       // fold and work with these structure constructors.
1912       // Here, they are just noise since the assignment semantics will deal
1913       // with any length mismatch, and creating an extra temp with the lhs
1914       // length is useless.
1915       // TODO: should this be moved into an hlfir.assign + hlfir.set_length
1916       // pattern rewrite?
1917       hlfir::Entity rhs = gen(expr);
1918       if (auto set_length = rhs.getDefiningOp<hlfir::SetLengthOp>())
1919         rhs = hlfir::Entity{set_length.getString()};
1920 
1921       // lambda to generate `lhs = rhs` and deal with potential rhs implicit
1922       // cast
1923       auto genAssign = [&] {
1924         rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
1925         auto rhsCastAndCleanup =
1926             hlfir::genTypeAndKindConvert(loc, builder, rhs, lhs.getType(),
1927                                          /*preserveLowerBounds=*/allowRealloc);
1928         builder.create<hlfir::AssignOp>(loc, rhsCastAndCleanup.first, lhs,
1929                                         allowRealloc,
1930                                         allowRealloc ? keepLhsLength : false,
1931                                         /*temporary_lhs=*/true);
1932         if (rhsCastAndCleanup.second)
1933           (*rhsCastAndCleanup.second)();
1934       };
1935 
1936       if (!allowRealloc || !rhs.isMutableBox()) {
1937         genAssign();
1938         continue;
1939       }
1940 
1941       auto [rhsExv, cleanup] =
1942           hlfir::translateToExtendedValue(loc, builder, rhs);
1943       assert(!cleanup && "unexpected cleanup");
1944       auto *fromBox = rhsExv.getBoxOf<fir::MutableBoxValue>();
1945       if (!fromBox)
1946         fir::emitFatalError(loc, "allocatable entity could not be lowered "
1947                                  "to mutable box");
1948       mlir::Value isAlloc =
1949           fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *fromBox);
1950       builder.genIfThen(loc, isAlloc).genThen(genAssign).end();
1951     }
1952 
1953     if (fir::isRecordWithAllocatableMember(recTy)) {
1954       // Deallocate allocatable components without calling final subroutines.
1955       // The Fortran 2018 section 9.7.3.2 about deallocation is not ruling
1956       // about the fate of allocatable components of structure constructors,
1957       // and there is no behavior consensus in other compilers.
1958       fir::FirOpBuilder *bldr = &builder;
1959       getStmtCtx().attachCleanup([=]() {
1960         fir::runtime::genDerivedTypeDestroyWithoutFinalization(*bldr, loc, box);
1961       });
1962     }
1963     return varOp;
1964   }
1965 
1966   mlir::Location getLoc() const { return loc; }
1967   Fortran::lower::AbstractConverter &getConverter() { return converter; }
1968   fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); }
1969   Fortran::lower::SymMap &getSymMap() { return symMap; }
1970   Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; }
1971 
1972   Fortran::lower::AbstractConverter &converter;
1973   Fortran::lower::SymMap &symMap;
1974   Fortran::lower::StatementContext &stmtCtx;
1975   mlir::Location loc;
1976 };
1977 
1978 template <typename T>
1979 hlfir::Entity
1980 HlfirDesignatorBuilder::genSubscript(const Fortran::evaluate::Expr<T> &expr) {
1981   fir::FirOpBuilder &builder = getBuilder();
1982   mlir::arith::IntegerOverflowFlags iofBackup{};
1983   if (!getConverter().getLoweringOptions().getIntegerWrapAround()) {
1984     iofBackup = builder.getIntegerOverflowFlags();
1985     builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::nsw);
1986   }
1987   auto loweredExpr =
1988       HlfirBuilder(getLoc(), getConverter(), getSymMap(), getStmtCtx())
1989           .gen(expr);
1990   if (!getConverter().getLoweringOptions().getIntegerWrapAround())
1991     builder.setIntegerOverflowFlags(iofBackup);
1992   // Skip constant conversions that litters designators and makes generated
1993   // IR harder to read: directly use index constants for constant subscripts.
1994   mlir::Type idxTy = builder.getIndexType();
1995   if (!loweredExpr.isArray() && loweredExpr.getType() != idxTy)
1996     if (auto cstIndex = fir::getIntIfConstant(loweredExpr))
1997       return hlfir::EntityWithAttributes{
1998           builder.createIntegerConstant(getLoc(), idxTy, *cstIndex)};
1999   return hlfir::loadTrivialScalar(loc, builder, loweredExpr);
2000 }
2001 
2002 } // namespace
2003 
2004 hlfir::EntityWithAttributes Fortran::lower::convertExprToHLFIR(
2005     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2006     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2007     Fortran::lower::StatementContext &stmtCtx) {
2008   return HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2009 }
2010 
2011 fir::ExtendedValue Fortran::lower::convertToBox(
2012     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2013     hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx,
2014     mlir::Type fortranType) {
2015   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
2016   auto [exv, cleanup] = hlfir::convertToBox(loc, builder, entity, fortranType);
2017   if (cleanup)
2018     stmtCtx.attachCleanup(*cleanup);
2019   return exv;
2020 }
2021 
2022 fir::ExtendedValue Fortran::lower::convertExprToBox(
2023     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2024     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2025     Fortran::lower::StatementContext &stmtCtx) {
2026   hlfir::EntityWithAttributes loweredExpr =
2027       HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2028   return convertToBox(loc, converter, loweredExpr, stmtCtx,
2029                       converter.genType(expr));
2030 }
2031 
2032 fir::ExtendedValue Fortran::lower::convertToAddress(
2033     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2034     hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx,
2035     mlir::Type fortranType) {
2036   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
2037   auto [exv, cleanup] =
2038       hlfir::convertToAddress(loc, builder, entity, fortranType);
2039   if (cleanup)
2040     stmtCtx.attachCleanup(*cleanup);
2041   return exv;
2042 }
2043 
2044 fir::ExtendedValue Fortran::lower::convertExprToAddress(
2045     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2046     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2047     Fortran::lower::StatementContext &stmtCtx) {
2048   hlfir::EntityWithAttributes loweredExpr =
2049       HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2050   return convertToAddress(loc, converter, loweredExpr, stmtCtx,
2051                           converter.genType(expr));
2052 }
2053 
2054 fir::ExtendedValue Fortran::lower::convertToValue(
2055     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2056     hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx) {
2057   auto &builder = converter.getFirOpBuilder();
2058   auto [exv, cleanup] = hlfir::convertToValue(loc, builder, entity);
2059   if (cleanup)
2060     stmtCtx.attachCleanup(*cleanup);
2061   return exv;
2062 }
2063 
2064 fir::ExtendedValue Fortran::lower::convertExprToValue(
2065     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2066     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2067     Fortran::lower::StatementContext &stmtCtx) {
2068   hlfir::EntityWithAttributes loweredExpr =
2069       HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2070   return convertToValue(loc, converter, loweredExpr, stmtCtx);
2071 }
2072 
2073 fir::ExtendedValue Fortran::lower::convertDataRefToValue(
2074     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2075     const Fortran::evaluate::DataRef &dataRef, Fortran::lower::SymMap &symMap,
2076     Fortran::lower::StatementContext &stmtCtx) {
2077   fir::FortranVariableOpInterface loweredExpr =
2078       HlfirDesignatorBuilder(loc, converter, symMap, stmtCtx).gen(dataRef);
2079   return convertToValue(loc, converter, loweredExpr, stmtCtx);
2080 }
2081 
2082 fir::MutableBoxValue Fortran::lower::convertExprToMutableBox(
2083     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2084     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
2085   // Pointers and Allocatable cannot be temporary expressions. Temporaries may
2086   // be created while lowering it (e.g. if any indices expression of a
2087   // designator create temporaries), but they can be destroyed before using the
2088   // lowered pointer or allocatable;
2089   Fortran::lower::StatementContext localStmtCtx;
2090   hlfir::EntityWithAttributes loweredExpr =
2091       HlfirBuilder(loc, converter, symMap, localStmtCtx).gen(expr);
2092   fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
2093       loc, converter.getFirOpBuilder(), loweredExpr, localStmtCtx);
2094   auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>();
2095   assert(mutableBox && "expression could not be lowered to mutable box");
2096   return *mutableBox;
2097 }
2098 
2099 hlfir::ElementalAddrOp
2100 Fortran::lower::convertVectorSubscriptedExprToElementalAddr(
2101     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2102     const Fortran::lower::SomeExpr &designatorExpr,
2103     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
2104   return HlfirDesignatorBuilder(loc, converter, symMap, stmtCtx)
2105       .convertVectorSubscriptedExprToElementalAddr(designatorExpr);
2106 }
2107