xref: /llvm-project/flang/lib/Lower/ConvertExprToHLFIR.cpp (revision fc97d2e68b03bc2979395e84b645e5b3ba35aecd)
1c14ef2d7SJean Perier //===-- ConvertExprToHLFIR.cpp --------------------------------------------===//
2c14ef2d7SJean Perier //
3c14ef2d7SJean Perier // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4c14ef2d7SJean Perier // See https://llvm.org/LICENSE.txt for license information.
5c14ef2d7SJean Perier // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6c14ef2d7SJean Perier //
7c14ef2d7SJean Perier //===----------------------------------------------------------------------===//
8c14ef2d7SJean Perier //
9c14ef2d7SJean Perier // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
10c14ef2d7SJean Perier //
11c14ef2d7SJean Perier //===----------------------------------------------------------------------===//
12c14ef2d7SJean Perier 
13c14ef2d7SJean Perier #include "flang/Lower/ConvertExprToHLFIR.h"
1407b89273SJean Perier #include "flang/Evaluate/shape.h"
15c14ef2d7SJean Perier #include "flang/Lower/AbstractConverter.h"
161ca458f7SSlava Zakharin #include "flang/Lower/Allocatable.h"
17e78e4a17SJean Perier #include "flang/Lower/CallInterface.h"
18ffde9f17SJean Perier #include "flang/Lower/ConvertArrayConstructor.h"
19e78e4a17SJean Perier #include "flang/Lower/ConvertCall.h"
203952377fSJean Perier #include "flang/Lower/ConvertConstant.h"
21cedfd272SJean Perier #include "flang/Lower/ConvertProcedureDesignator.h"
22e78e4a17SJean Perier #include "flang/Lower/ConvertType.h"
233508f691SJean Perier #include "flang/Lower/ConvertVariable.h"
24c14ef2d7SJean Perier #include "flang/Lower/StatementContext.h"
25c14ef2d7SJean Perier #include "flang/Lower/SymbolMap.h"
2626ceeee7SJean Perier #include "flang/Optimizer/Builder/Complex.h"
276dcb31deSTom Eccles #include "flang/Optimizer/Builder/IntrinsicCall.h"
284e78f885SJean Perier #include "flang/Optimizer/Builder/MutableBox.h"
2912530711SJean Perier #include "flang/Optimizer/Builder/Runtime/Character.h"
301ca458f7SSlava Zakharin #include "flang/Optimizer/Builder/Runtime/Derived.h"
31f8843efbSSlava Zakharin #include "flang/Optimizer/Builder/Runtime/Pointer.h"
32c14ef2d7SJean Perier #include "flang/Optimizer/Builder/Todo.h"
3307b89273SJean Perier #include "flang/Optimizer/HLFIR/HLFIROps.h"
34d0018c95SJean Perier #include "llvm/ADT/TypeSwitch.h"
354d4d4785SKazu Hirata #include <optional>
36c14ef2d7SJean Perier 
37c14ef2d7SJean Perier namespace {
38c14ef2d7SJean Perier 
39c14ef2d7SJean Perier /// Lower Designators to HLFIR.
40c14ef2d7SJean Perier class HlfirDesignatorBuilder {
41583d492cSJean Perier private:
42583d492cSJean Perier   /// Internal entry point on the rightest part of a evaluate::Designator.
43583d492cSJean Perier   template <typename T>
44583d492cSJean Perier   hlfir::EntityWithAttributes
45583d492cSJean Perier   genLeafPartRef(const T &designatorNode,
46583d492cSJean Perier                  bool vectorSubscriptDesignatorToValue) {
47583d492cSJean Perier     hlfir::EntityWithAttributes result = gen(designatorNode);
48583d492cSJean Perier     if (vectorSubscriptDesignatorToValue)
49583d492cSJean Perier       return turnVectorSubscriptedDesignatorIntoValue(result);
50583d492cSJean Perier     return result;
51583d492cSJean Perier   }
52583d492cSJean Perier 
53c7ff45a5SJean Perier   hlfir::EntityWithAttributes
54c7ff45a5SJean Perier   genDesignatorExpr(const Fortran::lower::SomeExpr &designatorExpr,
55c7ff45a5SJean Perier                     bool vectorSubscriptDesignatorToValue = true);
56c7ff45a5SJean Perier 
57c14ef2d7SJean Perier public:
58c14ef2d7SJean Perier   HlfirDesignatorBuilder(mlir::Location loc,
59c14ef2d7SJean Perier                          Fortran::lower::AbstractConverter &converter,
60c14ef2d7SJean Perier                          Fortran::lower::SymMap &symMap,
61c14ef2d7SJean Perier                          Fortran::lower::StatementContext &stmtCtx)
62c14ef2d7SJean Perier       : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {}
63c14ef2d7SJean Perier 
64583d492cSJean Perier   /// Public entry points to lower a Designator<T> (given its .u member, to
65583d492cSJean Perier   /// avoid the template arguments which does not matter here).
66583d492cSJean Perier   /// This lowers a designator to an hlfir variable SSA value (that can be
67583d492cSJean Perier   /// assigned to), except for vector subscripted designators that are
68583d492cSJean Perier   /// lowered by default to hlfir.expr value since they cannot be
69583d492cSJean Perier   /// represented as HLFIR variable SSA values.
70583d492cSJean Perier 
71c14ef2d7SJean Perier   // Character designators variant contains substrings
72c14ef2d7SJean Perier   using CharacterDesignators =
73c14ef2d7SJean Perier       decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
74c14ef2d7SJean Perier                    Fortran::evaluate::TypeCategory::Character, 1>>::u);
75fcfb620dSJean Perier   hlfir::EntityWithAttributes
76583d492cSJean Perier   gen(const CharacterDesignators &designatorVariant,
77583d492cSJean Perier       bool vectorSubscriptDesignatorToValue = true) {
7877d8cfb3SAlexander Shaposhnikov     return Fortran::common::visit(
79583d492cSJean Perier         [&](const auto &x) -> hlfir::EntityWithAttributes {
80583d492cSJean Perier           return genLeafPartRef(x, vectorSubscriptDesignatorToValue);
81583d492cSJean Perier         },
8207b89273SJean Perier         designatorVariant);
83c14ef2d7SJean Perier   }
84c14ef2d7SJean Perier   // Character designators variant contains complex parts
85c14ef2d7SJean Perier   using RealDesignators =
86c14ef2d7SJean Perier       decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
87c14ef2d7SJean Perier                    Fortran::evaluate::TypeCategory::Real, 4>>::u);
88583d492cSJean Perier   hlfir::EntityWithAttributes
89583d492cSJean Perier   gen(const RealDesignators &designatorVariant,
90583d492cSJean Perier       bool vectorSubscriptDesignatorToValue = true) {
9177d8cfb3SAlexander Shaposhnikov     return Fortran::common::visit(
92583d492cSJean Perier         [&](const auto &x) -> hlfir::EntityWithAttributes {
93583d492cSJean Perier           return genLeafPartRef(x, vectorSubscriptDesignatorToValue);
94583d492cSJean Perier         },
9507b89273SJean Perier         designatorVariant);
96c14ef2d7SJean Perier   }
97c14ef2d7SJean Perier   // All other designators are similar
98c14ef2d7SJean Perier   using OtherDesignators =
99c14ef2d7SJean Perier       decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
100c14ef2d7SJean Perier                    Fortran::evaluate::TypeCategory::Integer, 4>>::u);
101583d492cSJean Perier   hlfir::EntityWithAttributes
102583d492cSJean Perier   gen(const OtherDesignators &designatorVariant,
103583d492cSJean Perier       bool vectorSubscriptDesignatorToValue = true) {
10477d8cfb3SAlexander Shaposhnikov     return Fortran::common::visit(
105583d492cSJean Perier         [&](const auto &x) -> hlfir::EntityWithAttributes {
106583d492cSJean Perier           return genLeafPartRef(x, vectorSubscriptDesignatorToValue);
107583d492cSJean Perier         },
10807b89273SJean Perier         designatorVariant);
109c14ef2d7SJean Perier   }
110c14ef2d7SJean Perier 
111d0018c95SJean Perier   hlfir::EntityWithAttributes
112583d492cSJean Perier   genNamedEntity(const Fortran::evaluate::NamedEntity &namedEntity,
113583d492cSJean Perier                  bool vectorSubscriptDesignatorToValue = true) {
114d0018c95SJean Perier     if (namedEntity.IsSymbol())
115583d492cSJean Perier       return genLeafPartRef(
116583d492cSJean Perier           Fortran::evaluate::SymbolRef{namedEntity.GetLastSymbol()},
117583d492cSJean Perier           vectorSubscriptDesignatorToValue);
118583d492cSJean Perier     return genLeafPartRef(namedEntity.GetComponent(),
119583d492cSJean Perier                           vectorSubscriptDesignatorToValue);
120d0018c95SJean Perier   }
121d0018c95SJean Perier 
122c7ff45a5SJean Perier   /// Public entry point to lower a vector subscripted designator to
123c7ff45a5SJean Perier   /// an hlfir::ElementalAddrOp.
124c7ff45a5SJean Perier   hlfir::ElementalAddrOp convertVectorSubscriptedExprToElementalAddr(
125c7ff45a5SJean Perier       const Fortran::lower::SomeExpr &designatorExpr);
126c7ff45a5SJean Perier 
1271ca458f7SSlava Zakharin   mlir::Value genComponentShape(const Fortran::semantics::Symbol &componentSym,
1281ca458f7SSlava Zakharin                                 mlir::Type fieldType) {
1291ca458f7SSlava Zakharin     // For pointers and allocatable components, the
1301ca458f7SSlava Zakharin     // shape is deferred and should not be loaded now to preserve
1311ca458f7SSlava Zakharin     // pointer/allocatable aspects.
1321ca458f7SSlava Zakharin     if (componentSym.Rank() == 0 ||
1334998587eSDaniel Chen         Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym) ||
1344998587eSDaniel Chen         Fortran::semantics::IsProcedurePointer(&componentSym))
1351ca458f7SSlava Zakharin       return mlir::Value{};
1361ca458f7SSlava Zakharin 
1371ca458f7SSlava Zakharin     fir::FirOpBuilder &builder = getBuilder();
1381ca458f7SSlava Zakharin     mlir::Location loc = getLoc();
1391ca458f7SSlava Zakharin     mlir::Type idxTy = builder.getIndexType();
1401ca458f7SSlava Zakharin     llvm::SmallVector<mlir::Value> extents;
141fac349a1SChristian Sigg     auto seqTy = mlir::cast<fir::SequenceType>(
142fac349a1SChristian Sigg         hlfir::getFortranElementOrSequenceType(fieldType));
1431ca458f7SSlava Zakharin     for (auto extent : seqTy.getShape()) {
1441ca458f7SSlava Zakharin       if (extent == fir::SequenceType::getUnknownExtent()) {
1451ca458f7SSlava Zakharin         // We have already generated invalid hlfir.declare
1461ca458f7SSlava Zakharin         // without the type parameters and probably invalid storage
1471ca458f7SSlava Zakharin         // for the variable (e.g. fir.alloca without type parameters).
1481ca458f7SSlava Zakharin         // So this TODO here is a little bit late, but it matches
1491ca458f7SSlava Zakharin         // the non-HLFIR path.
1501ca458f7SSlava Zakharin         TODO(loc, "array component shape depending on length parameters");
1511ca458f7SSlava Zakharin       }
1521ca458f7SSlava Zakharin       extents.push_back(builder.createIntegerConstant(loc, idxTy, extent));
1531ca458f7SSlava Zakharin     }
154f917c396SjeanPerier     if (!mayHaveNonDefaultLowerBounds(componentSym))
1551ca458f7SSlava Zakharin       return builder.create<fir::ShapeOp>(loc, extents);
1561ca458f7SSlava Zakharin 
1571ca458f7SSlava Zakharin     llvm::SmallVector<mlir::Value> lbounds;
1581ca458f7SSlava Zakharin     if (const auto *objDetails =
1591ca458f7SSlava Zakharin             componentSym.detailsIf<Fortran::semantics::ObjectEntityDetails>())
1601ca458f7SSlava Zakharin       for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
1611ca458f7SSlava Zakharin         if (auto lb = bounds.lbound().GetExplicit())
1621ca458f7SSlava Zakharin           if (auto constant = Fortran::evaluate::ToInt64(*lb))
1631ca458f7SSlava Zakharin             lbounds.push_back(
1641ca458f7SSlava Zakharin                 builder.createIntegerConstant(loc, idxTy, *constant));
1651ca458f7SSlava Zakharin     assert(extents.size() == lbounds.size() &&
1661ca458f7SSlava Zakharin            "extents and lower bounds must match");
1671ca458f7SSlava Zakharin     return builder.genShape(loc, lbounds, extents);
1681ca458f7SSlava Zakharin   }
1691ca458f7SSlava Zakharin 
17067f9b5aeSValentin Clement (バレンタイン クレメン)   fir::FortranVariableOpInterface
17167f9b5aeSValentin Clement (バレンタイン クレメン)   gen(const Fortran::evaluate::DataRef &dataRef) {
17277d8cfb3SAlexander Shaposhnikov     return Fortran::common::visit(
17367f9b5aeSValentin Clement (バレンタイン クレメン)         Fortran::common::visitors{[&](const auto &x) { return gen(x); }},
17467f9b5aeSValentin Clement (バレンタイン クレメン)         dataRef.u);
17567f9b5aeSValentin Clement (バレンタイン クレメン)   }
17667f9b5aeSValentin Clement (バレンタイン クレメン) 
177c14ef2d7SJean Perier private:
17807b89273SJean Perier   /// Struct that is filled while visiting a part-ref (in the "visit" member
17907b89273SJean Perier   /// function) before the top level "gen" generates an hlfir.declare for the
18007b89273SJean Perier   /// part ref. It contains the lowered pieces of the part-ref that will
18107b89273SJean Perier   /// become the operands of an hlfir.declare.
18207b89273SJean Perier   struct PartInfo {
183b3bb4dd3SJean Perier     std::optional<hlfir::Entity> base;
184ffc3051dSJean Perier     std::string componentName{};
185ffc3051dSJean Perier     mlir::Value componentShape;
1863191e8e1SJean Perier     hlfir::DesignateOp::Subscripts subscripts;
187ba45f637SEthan Luis McDonough     std::optional<bool> complexPart;
18807b89273SJean Perier     mlir::Value resultShape;
18907b89273SJean Perier     llvm::SmallVector<mlir::Value> typeParams;
190d0018c95SJean Perier     llvm::SmallVector<mlir::Value, 2> substring;
19107b89273SJean Perier   };
19207b89273SJean Perier 
193ffc3051dSJean Perier   // Given the value type of a designator (T or fir.array<T>) and the front-end
194ffc3051dSJean Perier   // node for the designator, compute the memory type (fir.class, fir.ref, or
195ffc3051dSJean Perier   // fir.box)...
196ffc3051dSJean Perier   template <typename T>
197ffc3051dSJean Perier   mlir::Type computeDesignatorType(mlir::Type resultValueType,
198ba45f637SEthan Luis McDonough                                    PartInfo &partInfo,
199ffc3051dSJean Perier                                    const T &designatorNode) {
200ba45f637SEthan Luis McDonough     // Get base's shape if its a sequence type with no previously computed
201ba45f637SEthan Luis McDonough     // result shape
202fac349a1SChristian Sigg     if (partInfo.base && mlir::isa<fir::SequenceType>(resultValueType) &&
203ba45f637SEthan Luis McDonough         !partInfo.resultShape)
204ba45f637SEthan Luis McDonough       partInfo.resultShape =
205ba45f637SEthan Luis McDonough           hlfir::genShape(getLoc(), getBuilder(), *partInfo.base);
206ffc3051dSJean Perier     // Dynamic type of polymorphic base must be kept if the designator is
207ffc3051dSJean Perier     // polymorphic.
208ffc3051dSJean Perier     if (isPolymorphic(designatorNode))
209ffc3051dSJean Perier       return fir::ClassType::get(resultValueType);
210ffc3051dSJean Perier     // Character scalar with dynamic length needs a fir.boxchar to hold the
211ffc3051dSJean Perier     // designator length.
212fac349a1SChristian Sigg     auto charType = mlir::dyn_cast<fir::CharacterType>(resultValueType);
21307b89273SJean Perier     if (charType && charType.hasDynamicLen())
214ffc3051dSJean Perier       return fir::BoxCharType::get(charType.getContext(), charType.getFKind());
215ffc3051dSJean Perier     // Arrays with non default lower bounds or dynamic length or dynamic extent
216ffc3051dSJean Perier     // need a fir.box to hold the dynamic or lower bound information.
217ffc3051dSJean Perier     if (fir::hasDynamicSize(resultValueType) ||
218f917c396SjeanPerier         mayHaveNonDefaultLowerBounds(partInfo))
219ffc3051dSJean Perier       return fir::BoxType::get(resultValueType);
220ffc3051dSJean Perier     // Non simply contiguous ref require a fir.box to carry the byte stride.
221fac349a1SChristian Sigg     if (mlir::isa<fir::SequenceType>(resultValueType) &&
222ffc3051dSJean Perier         !Fortran::evaluate::IsSimplyContiguous(
223ffc3051dSJean Perier             designatorNode, getConverter().getFoldingContext()))
224ffc3051dSJean Perier       return fir::BoxType::get(resultValueType);
225ffc3051dSJean Perier     // Other designators can be handled as raw addresses.
226ffc3051dSJean Perier     return fir::ReferenceType::get(resultValueType);
227ffc3051dSJean Perier   }
22807b89273SJean Perier 
229ffc3051dSJean Perier   template <typename T>
230ffc3051dSJean Perier   static bool isPolymorphic(const T &designatorNode) {
231ffc3051dSJean Perier     if constexpr (!std::is_same_v<T, Fortran::evaluate::Substring>) {
232ffc3051dSJean Perier       return Fortran::semantics::IsPolymorphic(designatorNode.GetLastSymbol());
233ffc3051dSJean Perier     }
234ffc3051dSJean Perier     return false;
235ffc3051dSJean Perier   }
236ffc3051dSJean Perier 
237ffc3051dSJean Perier   template <typename T>
238ffc3051dSJean Perier   /// Generate an hlfir.designate for a part-ref given a filled PartInfo and the
239ffc3051dSJean Perier   /// FIR type for this part-ref.
240ffc3051dSJean Perier   fir::FortranVariableOpInterface genDesignate(mlir::Type resultValueType,
241ffc3051dSJean Perier                                                PartInfo &partInfo,
242ffc3051dSJean Perier                                                const T &designatorNode) {
243ffc3051dSJean Perier     mlir::Type designatorType =
244ffc3051dSJean Perier         computeDesignatorType(resultValueType, partInfo, designatorNode);
2453508f691SJean Perier     return genDesignate(designatorType, partInfo, /*attributes=*/{});
2463508f691SJean Perier   }
2473508f691SJean Perier   fir::FortranVariableOpInterface
2483508f691SJean Perier   genDesignate(mlir::Type designatorType, PartInfo &partInfo,
2493508f691SJean Perier                fir::FortranVariableFlagsAttr attributes) {
250583d492cSJean Perier     fir::FirOpBuilder &builder = getBuilder();
251583d492cSJean Perier     // Once a part with vector subscripts has been lowered, the following
252583d492cSJean Perier     // hlfir.designator (for the parts on the right of the designator) must
253583d492cSJean Perier     // be lowered inside the hlfir.elemental_addr because they depend on the
254583d492cSJean Perier     // hlfir.elemental_addr indices.
255583d492cSJean Perier     // All the subsequent Fortran indices however, should be lowered before
256583d492cSJean Perier     // the hlfir.elemental_addr because they should only be evaluated once,
257583d492cSJean Perier     // hence, the insertion point is restored outside of the
258583d492cSJean Perier     // hlfir.elemental_addr after generating the hlfir.designate. Example: in
259583d492cSJean Perier     // "X(VECTOR)%COMP(FOO(), BAR())", the calls to bar() and foo() must be
260583d492cSJean Perier     // generated outside of the hlfir.elemental, but the related hlfir.designate
261583d492cSJean Perier     // that depends on the scalar hlfir.designate of X(VECTOR) that was
262583d492cSJean Perier     // generated inside the hlfir.elemental_addr should be generated in the
263583d492cSJean Perier     // hlfir.elemental_addr.
264583d492cSJean Perier     if (auto elementalAddrOp = getVectorSubscriptElementAddrOp())
265583d492cSJean Perier       builder.setInsertionPointToEnd(&elementalAddrOp->getBody().front());
266583d492cSJean Perier     auto designate = builder.create<hlfir::DesignateOp>(
267b3bb4dd3SJean Perier         getLoc(), designatorType, partInfo.base.value().getBase(),
268ffc3051dSJean Perier         partInfo.componentName, partInfo.componentShape, partInfo.subscripts,
269ba45f637SEthan Luis McDonough         partInfo.substring, partInfo.complexPart, partInfo.resultShape,
2703508f691SJean Perier         partInfo.typeParams, attributes);
271583d492cSJean Perier     if (auto elementalAddrOp = getVectorSubscriptElementAddrOp())
272583d492cSJean Perier       builder.setInsertionPoint(*elementalAddrOp);
27307b89273SJean Perier     return mlir::cast<fir::FortranVariableOpInterface>(
27407b89273SJean Perier         designate.getOperation());
27507b89273SJean Perier   }
27607b89273SJean Perier 
27707b89273SJean Perier   fir::FortranVariableOpInterface
278fcfb620dSJean Perier   gen(const Fortran::evaluate::SymbolRef &symbolRef) {
279c0921586SKazu Hirata     if (std::optional<fir::FortranVariableOpInterface> varDef =
280f8843efbSSlava Zakharin             getSymMap().lookupVariableDefinition(symbolRef)) {
281f8843efbSSlava Zakharin       if (symbolRef->test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
282f8843efbSSlava Zakharin         // The pointee is represented with a descriptor inheriting
283f8843efbSSlava Zakharin         // the shape and type parameters of the pointee.
284f8843efbSSlava Zakharin         // We have to update the base_addr to point to the current
285f8843efbSSlava Zakharin         // value of the Cray pointer variable.
286f8843efbSSlava Zakharin         fir::FirOpBuilder &builder = getBuilder();
287f8843efbSSlava Zakharin         fir::FortranVariableOpInterface ptrVar =
288de7a50fbSjeanPerier             gen(Fortran::semantics::GetCrayPointer(symbolRef));
289f8843efbSSlava Zakharin         mlir::Value ptrAddr = ptrVar.getBase();
290f8843efbSSlava Zakharin 
291f8843efbSSlava Zakharin         // Reinterpret the reference to a Cray pointer so that
292f8843efbSSlava Zakharin         // we have a pointer-compatible value after loading
293f8843efbSSlava Zakharin         // the Cray pointer value.
294f8843efbSSlava Zakharin         mlir::Type refPtrType = builder.getRefType(
295f8843efbSSlava Zakharin             fir::PointerType::get(fir::dyn_cast_ptrEleTy(ptrAddr.getType())));
296f8843efbSSlava Zakharin         mlir::Value cast = builder.createConvert(loc, refPtrType, ptrAddr);
297f8843efbSSlava Zakharin         mlir::Value ptrVal = builder.create<fir::LoadOp>(loc, cast);
298f8843efbSSlava Zakharin 
299f8843efbSSlava Zakharin         // Update the base_addr to the value of the Cray pointer.
300f8843efbSSlava Zakharin         // This is a hacky way to do the update, and it may harm
301f8843efbSSlava Zakharin         // performance around Cray pointer references.
302f8843efbSSlava Zakharin         // TODO: we should introduce an operation that updates
303f8843efbSSlava Zakharin         // just the base_addr of the given box. The CodeGen
304f8843efbSSlava Zakharin         // will just convert it into a single store.
305f8843efbSSlava Zakharin         fir::runtime::genPointerAssociateScalar(builder, loc, varDef->getBase(),
306f8843efbSSlava Zakharin                                                 ptrVal);
307f8843efbSSlava Zakharin       }
308c14ef2d7SJean Perier       return *varDef;
309f8843efbSSlava Zakharin     }
310de7a50fbSjeanPerier     llvm::errs() << *symbolRef << "\n";
311c14ef2d7SJean Perier     TODO(getLoc(), "lowering symbol to HLFIR");
312c14ef2d7SJean Perier   }
31307b89273SJean Perier 
314ffc3051dSJean Perier   fir::FortranVariableOpInterface
315de7a50fbSjeanPerier   gen(const Fortran::semantics::Symbol &symbol) {
316de7a50fbSjeanPerier     Fortran::evaluate::SymbolRef symref{symbol};
317de7a50fbSjeanPerier     return gen(symref);
318de7a50fbSjeanPerier   }
319de7a50fbSjeanPerier 
320de7a50fbSjeanPerier   fir::FortranVariableOpInterface
321e45f6e93SjeanPerier   gen(const Fortran::evaluate::Component &component) {
322b3bb4dd3SJean Perier     if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol()))
323b3bb4dd3SJean Perier       return genWholeAllocatableOrPointerComponent(component);
324ffc3051dSJean Perier     PartInfo partInfo;
325ffc3051dSJean Perier     mlir::Type resultType = visit(component, partInfo);
326ffc3051dSJean Perier     return genDesignate(resultType, partInfo, component);
327c14ef2d7SJean Perier   }
32807b89273SJean Perier 
329ffc3051dSJean Perier   fir::FortranVariableOpInterface
330ffc3051dSJean Perier   gen(const Fortran::evaluate::ArrayRef &arrayRef) {
33107b89273SJean Perier     PartInfo partInfo;
33207b89273SJean Perier     mlir::Type resultType = visit(arrayRef, partInfo);
333ffc3051dSJean Perier     return genDesignate(resultType, partInfo, arrayRef);
334c14ef2d7SJean Perier   }
33507b89273SJean Perier 
336ffc3051dSJean Perier   fir::FortranVariableOpInterface
337fcfb620dSJean Perier   gen(const Fortran::evaluate::CoarrayRef &coarrayRef) {
3385db4779cSPete Steinfeld     TODO(getLoc(), "coarray: lowering a reference to a coarray object");
339c14ef2d7SJean Perier   }
340ffc3051dSJean Perier 
341d0018c95SJean Perier   mlir::Type visit(const Fortran::evaluate::CoarrayRef &, PartInfo &) {
3425db4779cSPete Steinfeld     TODO(getLoc(), "coarray: lowering a reference to a coarray object");
343d0018c95SJean Perier   }
34407b89273SJean Perier 
345ffc3051dSJean Perier   fir::FortranVariableOpInterface
346fcfb620dSJean Perier   gen(const Fortran::evaluate::ComplexPart &complexPart) {
347ba45f637SEthan Luis McDonough     PartInfo partInfo;
348ba45f637SEthan Luis McDonough     fir::factory::Complex cmplxHelper(getBuilder(), getLoc());
349ba45f637SEthan Luis McDonough 
350ba45f637SEthan Luis McDonough     bool complexBit =
351ba45f637SEthan Luis McDonough         complexPart.part() == Fortran::evaluate::ComplexPart::Part::IM;
352ba45f637SEthan Luis McDonough     partInfo.complexPart = {complexBit};
353ba45f637SEthan Luis McDonough 
354ba45f637SEthan Luis McDonough     mlir::Type resultType = visit(complexPart.complex(), partInfo);
355ba45f637SEthan Luis McDonough 
356ba45f637SEthan Luis McDonough     // Determine complex part type
357ba45f637SEthan Luis McDonough     mlir::Type base = hlfir::getFortranElementType(resultType);
358ba45f637SEthan Luis McDonough     mlir::Type cmplxValueType = cmplxHelper.getComplexPartType(base);
359ba45f637SEthan Luis McDonough     mlir::Type designatorType = changeElementType(resultType, cmplxValueType);
360ba45f637SEthan Luis McDonough 
361ba45f637SEthan Luis McDonough     return genDesignate(designatorType, partInfo, complexPart);
362c14ef2d7SJean Perier   }
36307b89273SJean Perier 
364ffc3051dSJean Perier   fir::FortranVariableOpInterface
365fcfb620dSJean Perier   gen(const Fortran::evaluate::Substring &substring) {
366d0018c95SJean Perier     PartInfo partInfo;
36777d8cfb3SAlexander Shaposhnikov     mlir::Type baseStringType = Fortran::common::visit(
368d0018c95SJean Perier         [&](const auto &x) { return visit(x, partInfo); }, substring.parent());
369d0018c95SJean Perier     assert(partInfo.typeParams.size() == 1 && "expect base string length");
370d0018c95SJean Perier     // Compute the substring lower and upper bound.
371d0018c95SJean Perier     partInfo.substring.push_back(genSubscript(substring.lower()));
372d0018c95SJean Perier     if (Fortran::evaluate::MaybeExtentExpr upperBound = substring.upper())
373d0018c95SJean Perier       partInfo.substring.push_back(genSubscript(*upperBound));
374d0018c95SJean Perier     else
375d0018c95SJean Perier       partInfo.substring.push_back(partInfo.typeParams[0]);
376d0018c95SJean Perier     fir::FirOpBuilder &builder = getBuilder();
377d0018c95SJean Perier     mlir::Location loc = getLoc();
378d0018c95SJean Perier     mlir::Type idxTy = builder.getIndexType();
379d0018c95SJean Perier     partInfo.substring[0] =
380d0018c95SJean Perier         builder.createConvert(loc, idxTy, partInfo.substring[0]);
381d0018c95SJean Perier     partInfo.substring[1] =
382d0018c95SJean Perier         builder.createConvert(loc, idxTy, partInfo.substring[1]);
383d0018c95SJean Perier     // Try using constant length if available. mlir::arith folding would
384d0018c95SJean Perier     // most likely be able to fold "max(ub-lb+1,0)" too, but getting
385d0018c95SJean Perier     // the constant length in the FIR types would be harder.
386d0018c95SJean Perier     std::optional<int64_t> cstLen =
387d0018c95SJean Perier         Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
388d0018c95SJean Perier             getConverter().getFoldingContext(), substring.LEN()));
389d0018c95SJean Perier     if (cstLen) {
390d0018c95SJean Perier       partInfo.typeParams[0] =
391d0018c95SJean Perier           builder.createIntegerConstant(loc, idxTy, *cstLen);
392d0018c95SJean Perier     } else {
393d0018c95SJean Perier       // Compute "len = max(ub-lb+1,0)" (Fortran 2018 9.4.1).
394d0018c95SJean Perier       mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
395d0018c95SJean Perier       auto boundsDiff = builder.create<mlir::arith::SubIOp>(
396d0018c95SJean Perier           loc, partInfo.substring[1], partInfo.substring[0]);
397d0018c95SJean Perier       auto rawLen = builder.create<mlir::arith::AddIOp>(loc, boundsDiff, one);
398d0018c95SJean Perier       partInfo.typeParams[0] =
399d0018c95SJean Perier           fir::factory::genMaxWithZero(builder, loc, rawLen);
400d0018c95SJean Perier     }
401fac349a1SChristian Sigg     auto kind = mlir::cast<fir::CharacterType>(
402fac349a1SChristian Sigg                     hlfir::getFortranElementType(baseStringType))
403ffc3051dSJean Perier                     .getFKind();
404ffc3051dSJean Perier     auto newCharTy = fir::CharacterType::get(
405ffc3051dSJean Perier         baseStringType.getContext(), kind,
406d0018c95SJean Perier         cstLen ? *cstLen : fir::CharacterType::unknownLen());
407ffc3051dSJean Perier     mlir::Type resultType = changeElementType(baseStringType, newCharTy);
408ffc3051dSJean Perier     return genDesignate(resultType, partInfo, substring);
409d0018c95SJean Perier   }
410d0018c95SJean Perier 
411ffc3051dSJean Perier   static mlir::Type changeElementType(mlir::Type type, mlir::Type newEleTy) {
412d0018c95SJean Perier     return llvm::TypeSwitch<mlir::Type, mlir::Type>(type)
413d0018c95SJean Perier         .Case<fir::SequenceType>([&](fir::SequenceType seqTy) -> mlir::Type {
414ffc3051dSJean Perier           return fir::SequenceType::get(seqTy.getShape(), newEleTy);
415d0018c95SJean Perier         })
416a49f630cSjeanPerier         .Case<fir::PointerType, fir::HeapType, fir::ReferenceType, fir::BoxType,
417a49f630cSjeanPerier               fir::ClassType>([&](auto t) -> mlir::Type {
418d0018c95SJean Perier           using FIRT = decltype(t);
419ffc3051dSJean Perier           return FIRT::get(changeElementType(t.getEleTy(), newEleTy));
420d0018c95SJean Perier         })
421ffc3051dSJean Perier         .Default([newEleTy](mlir::Type t) -> mlir::Type { return newEleTy; });
422d0018c95SJean Perier   }
423d0018c95SJean Perier 
424b3bb4dd3SJean Perier   fir::FortranVariableOpInterface genWholeAllocatableOrPointerComponent(
425b3bb4dd3SJean Perier       const Fortran::evaluate::Component &component) {
426b3bb4dd3SJean Perier     // Generate whole allocatable or pointer component reference. The
427b3bb4dd3SJean Perier     // hlfir.designate result will be a pointer/allocatable.
428b3bb4dd3SJean Perier     PartInfo partInfo;
429b3bb4dd3SJean Perier     mlir::Type componentType = visitComponentImpl(component, partInfo).second;
430b3bb4dd3SJean Perier     mlir::Type designatorType = fir::ReferenceType::get(componentType);
431b3bb4dd3SJean Perier     fir::FortranVariableFlagsAttr attributes =
432b3bb4dd3SJean Perier         Fortran::lower::translateSymbolAttributes(getBuilder().getContext(),
433b3bb4dd3SJean Perier                                                   component.GetLastSymbol());
434b3bb4dd3SJean Perier     return genDesignate(designatorType, partInfo, attributes);
435b3bb4dd3SJean Perier   }
436b3bb4dd3SJean Perier 
437d0018c95SJean Perier   mlir::Type visit(const Fortran::evaluate::DataRef &dataRef,
438d0018c95SJean Perier                    PartInfo &partInfo) {
43977d8cfb3SAlexander Shaposhnikov     return Fortran::common::visit(
44077d8cfb3SAlexander Shaposhnikov         [&](const auto &x) { return visit(x, partInfo); }, dataRef.u);
441d0018c95SJean Perier   }
442d0018c95SJean Perier 
443d0018c95SJean Perier   mlir::Type
444d0018c95SJean Perier   visit(const Fortran::evaluate::StaticDataObject::Pointer &staticObject,
445d0018c95SJean Perier         PartInfo &partInfo) {
446d0018c95SJean Perier     fir::FirOpBuilder &builder = getBuilder();
447d0018c95SJean Perier     mlir::Location loc = getLoc();
448d0018c95SJean Perier     std::optional<std::string> string = staticObject->AsString();
449d0018c95SJean Perier     // TODO: see if StaticDataObject can be replaced by something based on
450d0018c95SJean Perier     // Constant<T> to avoid dealing with endianness here for KIND>1.
451d0018c95SJean Perier     // This will also avoid making string copies here.
452d0018c95SJean Perier     if (!string)
453d0018c95SJean Perier       TODO(loc, "StaticDataObject::Pointer substring with kind > 1");
454d0018c95SJean Perier     fir::ExtendedValue exv =
455d0018c95SJean Perier         fir::factory::createStringLiteral(builder, getLoc(), *string);
456d0018c95SJean Perier     auto flags = fir::FortranVariableFlagsAttr::get(
457d0018c95SJean Perier         builder.getContext(), fir::FortranVariableFlagsEnum::parameter);
458d0018c95SJean Perier     partInfo.base = hlfir::genDeclare(loc, builder, exv, ".stringlit", flags);
459d0018c95SJean Perier     partInfo.typeParams.push_back(fir::getLen(exv));
460b3bb4dd3SJean Perier     return partInfo.base->getElementOrSequenceType();
461c14ef2d7SJean Perier   }
462c14ef2d7SJean Perier 
46307b89273SJean Perier   mlir::Type visit(const Fortran::evaluate::SymbolRef &symbolRef,
46407b89273SJean Perier                    PartInfo &partInfo) {
465b3bb4dd3SJean Perier     // A symbol is only visited if there is a following array, substring, or
466b3bb4dd3SJean Perier     // complex reference. If the entity is a pointer or allocatable, this
467b3bb4dd3SJean Perier     // reference designates the target, so the pointer, allocatable must be
468b3bb4dd3SJean Perier     // dereferenced here.
469b3bb4dd3SJean Perier     partInfo.base =
470b3bb4dd3SJean Perier         hlfir::derefPointersAndAllocatables(loc, getBuilder(), gen(symbolRef));
471b3bb4dd3SJean Perier     hlfir::genLengthParameters(loc, getBuilder(), *partInfo.base,
47207b89273SJean Perier                                partInfo.typeParams);
473b3bb4dd3SJean Perier     return partInfo.base->getElementOrSequenceType();
47407b89273SJean Perier   }
47507b89273SJean Perier 
47607b89273SJean Perier   mlir::Type visit(const Fortran::evaluate::ArrayRef &arrayRef,
47707b89273SJean Perier                    PartInfo &partInfo) {
47807b89273SJean Perier     mlir::Type baseType;
479b3bb4dd3SJean Perier     if (const auto *component = arrayRef.base().UnwrapComponent()) {
480b3bb4dd3SJean Perier       // Pointers and allocatable components must be dereferenced since the
481b3bb4dd3SJean Perier       // array ref designates the target (this is done in "visit"). Other
482b3bb4dd3SJean Perier       // components need special care to deal with the array%array_comp(indices)
483b3bb4dd3SJean Perier       // case.
484031b4e5eSPeter Klausler       if (Fortran::semantics::IsAllocatableOrObjectPointer(
485031b4e5eSPeter Klausler               &component->GetLastSymbol()))
486b3bb4dd3SJean Perier         baseType = visit(*component, partInfo);
487b3bb4dd3SJean Perier       else
4883508f691SJean Perier         baseType = hlfir::getFortranElementOrSequenceType(
4893508f691SJean Perier             visitComponentImpl(*component, partInfo).second);
490b3bb4dd3SJean Perier     } else {
49107b89273SJean Perier       baseType = visit(arrayRef.base().GetLastSymbol(), partInfo);
492b3bb4dd3SJean Perier     }
49307b89273SJean Perier 
49407b89273SJean Perier     fir::FirOpBuilder &builder = getBuilder();
49507b89273SJean Perier     mlir::Location loc = getLoc();
49607b89273SJean Perier     mlir::Type idxTy = builder.getIndexType();
49707b89273SJean Perier     llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> bounds;
498ffc3051dSJean Perier     auto getBaseBounds = [&](unsigned i) {
499ffc3051dSJean Perier       if (bounds.empty()) {
500ffc3051dSJean Perier         if (partInfo.componentName.empty()) {
501b3bb4dd3SJean Perier           bounds = hlfir::genBounds(loc, builder, partInfo.base.value());
502ffc3051dSJean Perier         } else {
503ffc3051dSJean Perier           assert(
504ffc3051dSJean Perier               partInfo.componentShape &&
505ffc3051dSJean Perier               "implicit array section bounds must come from component shape");
506ffc3051dSJean Perier           bounds = hlfir::genBounds(loc, builder, partInfo.componentShape);
507ffc3051dSJean Perier         }
508ffc3051dSJean Perier         assert(!bounds.empty() &&
509ffc3051dSJean Perier                "failed to compute implicit array section bounds");
510ffc3051dSJean Perier       }
51107b89273SJean Perier       return bounds[i];
51207b89273SJean Perier     };
51307b89273SJean Perier     auto frontEndResultShape =
51407b89273SJean Perier         Fortran::evaluate::GetShape(converter.getFoldingContext(), arrayRef);
515583d492cSJean Perier     auto tryGettingExtentFromFrontEnd =
516583d492cSJean Perier         [&](unsigned dim) -> std::pair<mlir::Value, fir::SequenceType::Extent> {
517583d492cSJean Perier       // Use constant extent if possible. The main advantage to do this now
518583d492cSJean Perier       // is to get the best FIR array types as possible while lowering.
519583d492cSJean Perier       if (frontEndResultShape)
520583d492cSJean Perier         if (auto maybeI64 =
521583d492cSJean Perier                 Fortran::evaluate::ToInt64(frontEndResultShape->at(dim)))
522583d492cSJean Perier           return {builder.createIntegerConstant(loc, idxTy, *maybeI64),
523583d492cSJean Perier                   *maybeI64};
524583d492cSJean Perier       return {mlir::Value{}, fir::SequenceType::getUnknownExtent()};
525583d492cSJean Perier     };
52607b89273SJean Perier     llvm::SmallVector<mlir::Value> resultExtents;
52707b89273SJean Perier     fir::SequenceType::Shape resultTypeShape;
528583d492cSJean Perier     bool sawVectorSubscripts = false;
52907b89273SJean Perier     for (auto subscript : llvm::enumerate(arrayRef.subscript())) {
53007b89273SJean Perier       if (const auto *triplet =
53107b89273SJean Perier               std::get_if<Fortran::evaluate::Triplet>(&subscript.value().u)) {
53207b89273SJean Perier         mlir::Value lb, ub;
53307b89273SJean Perier         if (const auto &lbExpr = triplet->lower())
53407b89273SJean Perier           lb = genSubscript(*lbExpr);
53507b89273SJean Perier         else
536ffc3051dSJean Perier           lb = getBaseBounds(subscript.index()).first;
53707b89273SJean Perier         if (const auto &ubExpr = triplet->upper())
53807b89273SJean Perier           ub = genSubscript(*ubExpr);
53907b89273SJean Perier         else
540ffc3051dSJean Perier           ub = getBaseBounds(subscript.index()).second;
54107b89273SJean Perier         lb = builder.createConvert(loc, idxTy, lb);
54207b89273SJean Perier         ub = builder.createConvert(loc, idxTy, ub);
54307b89273SJean Perier         mlir::Value stride = genSubscript(triplet->stride());
54407b89273SJean Perier         stride = builder.createConvert(loc, idxTy, stride);
545583d492cSJean Perier         auto [extentValue, shapeExtent] =
546583d492cSJean Perier             tryGettingExtentFromFrontEnd(resultExtents.size());
547583d492cSJean Perier         resultTypeShape.push_back(shapeExtent);
548583d492cSJean Perier         if (!extentValue)
549583d492cSJean Perier           extentValue =
550583d492cSJean Perier               builder.genExtentFromTriplet(loc, lb, ub, stride, idxTy);
551583d492cSJean Perier         resultExtents.push_back(extentValue);
55207b89273SJean Perier         partInfo.subscripts.emplace_back(
55307b89273SJean Perier             hlfir::DesignateOp::Triplet{lb, ub, stride});
55407b89273SJean Perier       } else {
55507b89273SJean Perier         const auto &expr =
55607b89273SJean Perier             std::get<Fortran::evaluate::IndirectSubscriptIntegerExpr>(
55707b89273SJean Perier                 subscript.value().u)
55807b89273SJean Perier                 .value();
559583d492cSJean Perier         hlfir::Entity subscript = genSubscript(expr);
560583d492cSJean Perier         partInfo.subscripts.push_back(subscript);
561583d492cSJean Perier         if (expr.Rank() > 0) {
562583d492cSJean Perier           sawVectorSubscripts = true;
563583d492cSJean Perier           auto [extentValue, shapeExtent] =
564583d492cSJean Perier               tryGettingExtentFromFrontEnd(resultExtents.size());
565583d492cSJean Perier           resultTypeShape.push_back(shapeExtent);
566583d492cSJean Perier           if (!extentValue)
567583d492cSJean Perier             extentValue = hlfir::genExtent(loc, builder, subscript, /*dim=*/0);
568583d492cSJean Perier           resultExtents.push_back(extentValue);
56907b89273SJean Perier         }
57007b89273SJean Perier       }
571583d492cSJean Perier     }
57207b89273SJean Perier     assert(resultExtents.size() == resultTypeShape.size() &&
57307b89273SJean Perier            "inconsistent hlfir.designate shape");
574583d492cSJean Perier 
575583d492cSJean Perier     // For vector subscripts, create an hlfir.elemental_addr and continue
576583d492cSJean Perier     // lowering the designator inside it as if it was addressing an element of
577583d492cSJean Perier     // the vector subscripts.
578583d492cSJean Perier     if (sawVectorSubscripts)
579583d492cSJean Perier       return createVectorSubscriptElementAddrOp(partInfo, baseType,
580583d492cSJean Perier                                                 resultExtents);
581583d492cSJean Perier 
582e6a4346bSScott Manley     mlir::Type resultType =
583e6a4346bSScott Manley         mlir::cast<fir::SequenceType>(baseType).getElementType();
58407b89273SJean Perier     if (!resultTypeShape.empty()) {
585ffc3051dSJean Perier       // Ranked array section. The result shape comes from the array section
586ffc3051dSJean Perier       // subscripts.
58707b89273SJean Perier       resultType = fir::SequenceType::get(resultTypeShape, resultType);
588ffc3051dSJean Perier       assert(!partInfo.resultShape &&
589ffc3051dSJean Perier              "Fortran designator can only have one ranked part");
59007b89273SJean Perier       partInfo.resultShape = builder.genShape(loc, resultExtents);
591b3bb4dd3SJean Perier     } else if (!partInfo.componentName.empty() &&
592b3bb4dd3SJean Perier                partInfo.base.value().isArray()) {
593ffc3051dSJean Perier       // This is an array%array_comp(indices) reference. Keep the
594ffc3051dSJean Perier       // shape of the base array and not the array_comp.
595b3bb4dd3SJean Perier       auto compBaseTy = partInfo.base->getElementOrSequenceType();
596ffc3051dSJean Perier       resultType = changeElementType(compBaseTy, resultType);
597ffc3051dSJean Perier       assert(!partInfo.resultShape && "should not have been computed already");
598b3bb4dd3SJean Perier       partInfo.resultShape = hlfir::genShape(loc, builder, *partInfo.base);
59907b89273SJean Perier     }
60007b89273SJean Perier     return resultType;
60107b89273SJean Perier   }
60207b89273SJean Perier 
603ffc3051dSJean Perier   static bool
604f917c396SjeanPerier   mayHaveNonDefaultLowerBounds(const Fortran::semantics::Symbol &componentSym) {
605ffc3051dSJean Perier     if (const auto *objDetails =
606ffc3051dSJean Perier             componentSym.detailsIf<Fortran::semantics::ObjectEntityDetails>())
607ffc3051dSJean Perier       for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
608ffc3051dSJean Perier         if (auto lb = bounds.lbound().GetExplicit())
609ffc3051dSJean Perier           if (auto constant = Fortran::evaluate::ToInt64(*lb))
610ffc3051dSJean Perier             if (!constant || *constant != 1)
611ffc3051dSJean Perier               return true;
612ffc3051dSJean Perier     return false;
613ffc3051dSJean Perier   }
614f917c396SjeanPerier   static bool mayHaveNonDefaultLowerBounds(const PartInfo &partInfo) {
615ffc3051dSJean Perier     return partInfo.resultShape &&
616fac349a1SChristian Sigg            mlir::isa<fir::ShiftType, fir::ShapeShiftType>(
617fac349a1SChristian Sigg                partInfo.resultShape.getType());
618ffc3051dSJean Perier   }
619ffc3051dSJean Perier 
62007b89273SJean Perier   mlir::Type visit(const Fortran::evaluate::Component &component,
62107b89273SJean Perier                    PartInfo &partInfo) {
622b3bb4dd3SJean Perier     if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol())) {
623b3bb4dd3SJean Perier       // In a visit, the following reference will address the target. Insert
624b3bb4dd3SJean Perier       // the dereference here.
625b3bb4dd3SJean Perier       partInfo.base = genWholeAllocatableOrPointerComponent(component);
626b3bb4dd3SJean Perier       partInfo.base = hlfir::derefPointersAndAllocatables(loc, getBuilder(),
627b3bb4dd3SJean Perier                                                           *partInfo.base);
628b3bb4dd3SJean Perier       hlfir::genLengthParameters(loc, getBuilder(), *partInfo.base,
629b3bb4dd3SJean Perier                                  partInfo.typeParams);
630b3bb4dd3SJean Perier       return partInfo.base->getElementOrSequenceType();
631b3bb4dd3SJean Perier     }
632b3bb4dd3SJean Perier     // This function must be called from contexts where the component is not the
633b3bb4dd3SJean Perier     // base of an ArrayRef. In these cases, the component cannot be an array
634b3bb4dd3SJean Perier     // if the base is an array. The code below determines the shape of the
635b3bb4dd3SJean Perier     // component reference if any.
636ffc3051dSJean Perier     auto [baseType, componentType] = visitComponentImpl(component, partInfo);
6373508f691SJean Perier     mlir::Type componentBaseType =
6383508f691SJean Perier         hlfir::getFortranElementOrSequenceType(componentType);
639b3bb4dd3SJean Perier     if (partInfo.base.value().isArray()) {
640ffc3051dSJean Perier       // For array%scalar_comp, the result shape is
641ffc3051dSJean Perier       // the one of the base. Compute it here. Note that the lower bounds of the
642ffc3051dSJean Perier       // base are not the ones of the resulting reference (that are default
643ffc3051dSJean Perier       // ones).
644b3bb4dd3SJean Perier       partInfo.resultShape = hlfir::genShape(loc, getBuilder(), *partInfo.base);
645ffc3051dSJean Perier       assert(!partInfo.componentShape &&
646ffc3051dSJean Perier              "Fortran designators can only have one ranked part");
6473508f691SJean Perier       return changeElementType(baseType, componentBaseType);
648ffc3051dSJean Perier     }
649f809bf2bSSlava Zakharin 
650f809bf2bSSlava Zakharin     if (partInfo.complexPart && partInfo.componentShape) {
651f809bf2bSSlava Zakharin       // Treat ...array_comp%im/re as ...array_comp(:,:,...)%im/re
652f809bf2bSSlava Zakharin       // so that the codegen has the full slice triples for the component
653f809bf2bSSlava Zakharin       // readily available.
654f809bf2bSSlava Zakharin       fir::FirOpBuilder &builder = getBuilder();
655f809bf2bSSlava Zakharin       mlir::Type idxTy = builder.getIndexType();
656f809bf2bSSlava Zakharin       mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
657f809bf2bSSlava Zakharin 
658f809bf2bSSlava Zakharin       llvm::SmallVector<mlir::Value> resultExtents;
659f809bf2bSSlava Zakharin       // Collect <lb, ub> pairs from the component shape.
660f809bf2bSSlava Zakharin       auto bounds = hlfir::genBounds(loc, builder, partInfo.componentShape);
661f809bf2bSSlava Zakharin       for (auto &boundPair : bounds) {
662f809bf2bSSlava Zakharin         // The default subscripts are <lb, ub, 1>:
663f809bf2bSSlava Zakharin         partInfo.subscripts.emplace_back(hlfir::DesignateOp::Triplet{
664f809bf2bSSlava Zakharin             boundPair.first, boundPair.second, one});
665f809bf2bSSlava Zakharin         auto extentValue = builder.genExtentFromTriplet(
666f809bf2bSSlava Zakharin             loc, boundPair.first, boundPair.second, one, idxTy);
667f809bf2bSSlava Zakharin         resultExtents.push_back(extentValue);
668f809bf2bSSlava Zakharin       }
669f809bf2bSSlava Zakharin       // The result shape is: <max((ub - lb + 1) / 1, 0), ...>.
670f809bf2bSSlava Zakharin       partInfo.resultShape = builder.genShape(loc, resultExtents);
671f809bf2bSSlava Zakharin       return componentBaseType;
672f809bf2bSSlava Zakharin     }
673f809bf2bSSlava Zakharin 
674ffc3051dSJean Perier     // scalar%array_comp or scalar%scalar. In any case the shape of this
675ffc3051dSJean Perier     // part-ref is coming from the component.
676ffc3051dSJean Perier     partInfo.resultShape = partInfo.componentShape;
677ffc3051dSJean Perier     partInfo.componentShape = {};
6783508f691SJean Perier     return componentBaseType;
679ffc3051dSJean Perier   }
680ffc3051dSJean Perier 
681ffc3051dSJean Perier   // Returns the <BaseType, ComponentType> pair, computes partInfo.base,
682ffc3051dSJean Perier   // partInfo.componentShape and partInfo.typeParams, but does not set the
683ffc3051dSJean Perier   // partInfo.resultShape yet. The result shape will be computed after
684ffc3051dSJean Perier   // processing a following ArrayRef, if any, and in "visit" otherwise.
685ffc3051dSJean Perier   std::pair<mlir::Type, mlir::Type>
686ffc3051dSJean Perier   visitComponentImpl(const Fortran::evaluate::Component &component,
687b3bb4dd3SJean Perier                      PartInfo &partInfo) {
688ffc3051dSJean Perier     fir::FirOpBuilder &builder = getBuilder();
689ffc3051dSJean Perier     // Break the Designator visit here: if the base is an array-ref, a
690ffc3051dSJean Perier     // coarray-ref, or another component, this creates another hlfir.designate
691ffc3051dSJean Perier     // for it.  hlfir.designate is not meant to represent more than one
692ffc3051dSJean Perier     // part-ref.
693e45f6e93SjeanPerier     partInfo.base = gen(component.base());
694b3bb4dd3SJean Perier     // If the base is an allocatable/pointer, dereference it here since the
695b3bb4dd3SJean Perier     // component ref designates its target.
696b3bb4dd3SJean Perier     partInfo.base =
697b3bb4dd3SJean Perier         hlfir::derefPointersAndAllocatables(loc, builder, *partInfo.base);
698ffc3051dSJean Perier     assert(partInfo.typeParams.empty() && "should not have been computed yet");
699b3bb4dd3SJean Perier 
700b3bb4dd3SJean Perier     hlfir::genLengthParameters(getLoc(), getBuilder(), *partInfo.base,
701ffc3051dSJean Perier                                partInfo.typeParams);
702b3bb4dd3SJean Perier     mlir::Type baseType = partInfo.base->getElementOrSequenceType();
703ffc3051dSJean Perier 
704ffc3051dSJean Perier     // Lower the information about the component (type, length parameters and
705ffc3051dSJean Perier     // shape).
706ffc3051dSJean Perier     const Fortran::semantics::Symbol &componentSym = component.GetLastSymbol();
70799a54b83SjeanPerier     partInfo.componentName = converter.getRecordTypeFieldName(componentSym);
708ffc3051dSJean Perier     auto recordType =
709fac349a1SChristian Sigg         mlir::cast<fir::RecordType>(hlfir::getFortranElementType(baseType));
710ffc3051dSJean Perier     if (recordType.isDependentType())
711ffc3051dSJean Perier       TODO(getLoc(), "Designate derived type with length parameters in HLFIR");
712ffc3051dSJean Perier     mlir::Type fieldType = recordType.getType(partInfo.componentName);
7132d46264cSJean Perier     assert(fieldType && "component name is not known");
7143508f691SJean Perier     mlir::Type fieldBaseType =
7153508f691SJean Perier         hlfir::getFortranElementOrSequenceType(fieldType);
7163508f691SJean Perier     partInfo.componentShape = genComponentShape(componentSym, fieldBaseType);
717ffc3051dSJean Perier 
7183508f691SJean Perier     mlir::Type fieldEleType = hlfir::getFortranElementType(fieldBaseType);
719ffc3051dSJean Perier     if (fir::isRecordWithTypeParameters(fieldEleType))
720ffc3051dSJean Perier       TODO(loc,
721ffc3051dSJean Perier            "lower a component that is a parameterized derived type to HLFIR");
722fac349a1SChristian Sigg     if (auto charTy = mlir::dyn_cast<fir::CharacterType>(fieldEleType)) {
723ffc3051dSJean Perier       mlir::Location loc = getLoc();
724ffc3051dSJean Perier       mlir::Type idxTy = builder.getIndexType();
725ffc3051dSJean Perier       if (charTy.hasConstantLen())
726ffc3051dSJean Perier         partInfo.typeParams.push_back(
727ffc3051dSJean Perier             builder.createIntegerConstant(loc, idxTy, charTy.getLen()));
728031b4e5eSPeter Klausler       else if (!Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym))
729ffc3051dSJean Perier         TODO(loc, "compute character length of automatic character component "
730ffc3051dSJean Perier                   "in a PDT");
731ffc3051dSJean Perier       // Otherwise, the length of the component is deferred and will only
732ffc3051dSJean Perier       // be read when the component is dereferenced.
733ffc3051dSJean Perier     }
734ffc3051dSJean Perier     return {baseType, fieldType};
73507b89273SJean Perier   }
73607b89273SJean Perier 
737583d492cSJean Perier   // Compute: "lb + (i-1)*step".
738583d492cSJean Perier   mlir::Value computeTripletPosition(mlir::Location loc,
739583d492cSJean Perier                                      fir::FirOpBuilder &builder,
740583d492cSJean Perier                                      hlfir::DesignateOp::Triplet &triplet,
741583d492cSJean Perier                                      mlir::Value oneBasedIndex) {
742583d492cSJean Perier     mlir::Type idxTy = builder.getIndexType();
743583d492cSJean Perier     mlir::Value lb = builder.createConvert(loc, idxTy, std::get<0>(triplet));
744583d492cSJean Perier     mlir::Value step = builder.createConvert(loc, idxTy, std::get<2>(triplet));
745583d492cSJean Perier     mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
746583d492cSJean Perier     oneBasedIndex = builder.createConvert(loc, idxTy, oneBasedIndex);
747583d492cSJean Perier     mlir::Value zeroBased =
748583d492cSJean Perier         builder.create<mlir::arith::SubIOp>(loc, oneBasedIndex, one);
749583d492cSJean Perier     mlir::Value offset =
750583d492cSJean Perier         builder.create<mlir::arith::MulIOp>(loc, zeroBased, step);
751583d492cSJean Perier     return builder.create<mlir::arith::AddIOp>(loc, lb, offset);
752583d492cSJean Perier   }
753583d492cSJean Perier 
754583d492cSJean Perier   /// Create an hlfir.element_addr operation to deal with vector subscripted
755583d492cSJean Perier   /// entities. This transforms the current vector subscripted array-ref into a
756583d492cSJean Perier   /// a scalar array-ref that is addressing the vector subscripted part given
757583d492cSJean Perier   /// the one based indices of the hlfir.element_addr.
758583d492cSJean Perier   /// The rest of the designator lowering will continue lowering any further
759583d492cSJean Perier   /// parts inside the hlfir.elemental as a scalar reference.
760583d492cSJean Perier   /// At the end of the designator lowering, the hlfir.elemental_addr will
761583d492cSJean Perier   /// be turned into an hlfir.elemental value, unless the caller of this
762583d492cSJean Perier   /// utility requested to get the hlfir.elemental_addr instead of lowering
763583d492cSJean Perier   /// the designator to an mlir::Value.
764583d492cSJean Perier   mlir::Type createVectorSubscriptElementAddrOp(
765583d492cSJean Perier       PartInfo &partInfo, mlir::Type baseType,
766583d492cSJean Perier       llvm::ArrayRef<mlir::Value> resultExtents) {
767583d492cSJean Perier     fir::FirOpBuilder &builder = getBuilder();
768583d492cSJean Perier     mlir::Value shape = builder.genShape(loc, resultExtents);
769583d492cSJean Perier     // The type parameters to be added on the hlfir.elemental_addr are the ones
770583d492cSJean Perier     // of the whole designator (not the ones of the vector subscripted part).
771583d492cSJean Perier     // These are not yet known and will be added when finalizing the designator
772583d492cSJean Perier     // lowering.
773939f0382SjeanPerier     // The resulting designator may be polymorphic, in which case the resulting
774939f0382SjeanPerier     // type is the base of the vector subscripted part because
775939f0382SjeanPerier     // allocatable/pointer components cannot be referenced after a vector
776939f0382SjeanPerier     // subscripted part. Set the mold to the current base. It will be erased if
777939f0382SjeanPerier     // the resulting designator is not polymorphic.
778939f0382SjeanPerier     assert(partInfo.base.has_value() &&
779939f0382SjeanPerier            "vector subscripted part must have a base");
780939f0382SjeanPerier     mlir::Value mold = *partInfo.base;
781939f0382SjeanPerier     auto elementalAddrOp = builder.create<hlfir::ElementalAddrOp>(
782939f0382SjeanPerier         loc, shape, mold, mlir::ValueRange{},
7837b4aa95dSSlava Zakharin         /*isUnordered=*/true);
784583d492cSJean Perier     setVectorSubscriptElementAddrOp(elementalAddrOp);
785583d492cSJean Perier     builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front());
786583d492cSJean Perier     mlir::Region::BlockArgListType indices = elementalAddrOp.getIndices();
787583d492cSJean Perier     auto indicesIterator = indices.begin();
788583d492cSJean Perier     auto getNextOneBasedIndex = [&]() -> mlir::Value {
789583d492cSJean Perier       assert(indicesIterator != indices.end() && "ill formed ElementalAddrOp");
790583d492cSJean Perier       return *(indicesIterator++);
791583d492cSJean Perier     };
792583d492cSJean Perier     // Transform the designator into a scalar designator computing the vector
793583d492cSJean Perier     // subscripted entity element address given one based indices (for the shape
794583d492cSJean Perier     // of the vector subscripted designator).
795583d492cSJean Perier     for (hlfir::DesignateOp::Subscript &subscript : partInfo.subscripts) {
796583d492cSJean Perier       if (auto *triplet =
797583d492cSJean Perier               std::get_if<hlfir::DesignateOp::Triplet>(&subscript)) {
798583d492cSJean Perier         // subscript = (lb + (i-1)*step)
799583d492cSJean Perier         mlir::Value scalarSubscript = computeTripletPosition(
800583d492cSJean Perier             loc, builder, *triplet, getNextOneBasedIndex());
801583d492cSJean Perier         subscript = scalarSubscript;
802583d492cSJean Perier       } else {
803583d492cSJean Perier         hlfir::Entity valueSubscript{std::get<mlir::Value>(subscript)};
804583d492cSJean Perier         if (valueSubscript.isScalar())
805583d492cSJean Perier           continue;
806583d492cSJean Perier         // subscript = vector(i + (vector_lb-1))
807583d492cSJean Perier         hlfir::Entity scalarSubscript = hlfir::getElementAt(
808583d492cSJean Perier             loc, builder, valueSubscript, {getNextOneBasedIndex()});
809583d492cSJean Perier         scalarSubscript =
810583d492cSJean Perier             hlfir::loadTrivialScalar(loc, builder, scalarSubscript);
811583d492cSJean Perier         subscript = scalarSubscript;
812583d492cSJean Perier       }
813583d492cSJean Perier     }
814583d492cSJean Perier     builder.setInsertionPoint(elementalAddrOp);
815e6a4346bSScott Manley     return mlir::cast<fir::SequenceType>(baseType).getElementType();
816583d492cSJean Perier   }
817583d492cSJean Perier 
818583d492cSJean Perier   /// Yield the designator for the final part-ref inside the
819583d492cSJean Perier   /// hlfir.elemental_addr.
820583d492cSJean Perier   void finalizeElementAddrOp(hlfir::ElementalAddrOp elementalAddrOp,
821583d492cSJean Perier                              hlfir::EntityWithAttributes elementAddr) {
822583d492cSJean Perier     fir::FirOpBuilder &builder = getBuilder();
823583d492cSJean Perier     builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front());
824939f0382SjeanPerier     if (!elementAddr.isPolymorphic())
825939f0382SjeanPerier       elementalAddrOp.getMoldMutable().clear();
826583d492cSJean Perier     builder.create<hlfir::YieldOp>(loc, elementAddr);
827583d492cSJean Perier     builder.setInsertionPointAfter(elementalAddrOp);
828583d492cSJean Perier   }
829583d492cSJean Perier 
830583d492cSJean Perier   /// If the lowered designator has vector subscripts turn it into an
831583d492cSJean Perier   /// ElementalOp, otherwise, return the lowered designator. This should
832583d492cSJean Perier   /// only be called if the user did not request to get the
833583d492cSJean Perier   /// hlfir.elemental_addr. In Fortran, vector subscripted designators are only
834583d492cSJean Perier   /// writable on the left-hand side of an assignment and in input IO
835583d492cSJean Perier   /// statements. Otherwise, they are not variables (cannot be modified, their
836583d492cSJean Perier   /// value is taken at the place they appear).
837583d492cSJean Perier   hlfir::EntityWithAttributes turnVectorSubscriptedDesignatorIntoValue(
838583d492cSJean Perier       hlfir::EntityWithAttributes loweredDesignator) {
839583d492cSJean Perier     std::optional<hlfir::ElementalAddrOp> elementalAddrOp =
840583d492cSJean Perier         getVectorSubscriptElementAddrOp();
841583d492cSJean Perier     if (!elementalAddrOp)
842583d492cSJean Perier       return loweredDesignator;
843583d492cSJean Perier     finalizeElementAddrOp(*elementalAddrOp, loweredDesignator);
844583d492cSJean Perier     // This vector subscript designator is only being read, transform the
845583d492cSJean Perier     // hlfir.elemental_addr into an hlfir.elemental.  The content of the
846583d492cSJean Perier     // hlfir.elemental_addr is cloned, and the resulting address is loaded to
847583d492cSJean Perier     // get the new element value.
848583d492cSJean Perier     fir::FirOpBuilder &builder = getBuilder();
849583d492cSJean Perier     mlir::Location loc = getLoc();
850583d492cSJean Perier     mlir::Value elemental =
851583d492cSJean Perier         hlfir::cloneToElementalOp(loc, builder, *elementalAddrOp);
852583d492cSJean Perier     (*elementalAddrOp)->erase();
853583d492cSJean Perier     setVectorSubscriptElementAddrOp(std::nullopt);
854583d492cSJean Perier     fir::FirOpBuilder *bldr = &builder;
855583d492cSJean Perier     getStmtCtx().attachCleanup(
856583d492cSJean Perier         [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
857583d492cSJean Perier     return hlfir::EntityWithAttributes{elemental};
858583d492cSJean Perier   }
859583d492cSJean Perier 
860583d492cSJean Perier   /// Lower a subscript expression. If it is a scalar subscript that is a
861583d492cSJean Perier   /// variable, it is loaded into an integer value. If it is an array (for
862583d492cSJean Perier   /// vector subscripts) it is dereferenced if this is an allocatable or
863583d492cSJean Perier   /// pointer.
86407b89273SJean Perier   template <typename T>
865583d492cSJean Perier   hlfir::Entity genSubscript(const Fortran::evaluate::Expr<T> &expr);
866583d492cSJean Perier 
867583d492cSJean Perier   const std::optional<hlfir::ElementalAddrOp> &
868583d492cSJean Perier   getVectorSubscriptElementAddrOp() const {
869583d492cSJean Perier     return vectorSubscriptElementAddrOp;
870583d492cSJean Perier   }
871583d492cSJean Perier   void setVectorSubscriptElementAddrOp(
872583d492cSJean Perier       std::optional<hlfir::ElementalAddrOp> elementalAddrOp) {
873583d492cSJean Perier     vectorSubscriptElementAddrOp = elementalAddrOp;
874583d492cSJean Perier   }
87507b89273SJean Perier 
876c14ef2d7SJean Perier   mlir::Location getLoc() const { return loc; }
877c14ef2d7SJean Perier   Fortran::lower::AbstractConverter &getConverter() { return converter; }
878c14ef2d7SJean Perier   fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); }
879c14ef2d7SJean Perier   Fortran::lower::SymMap &getSymMap() { return symMap; }
880c14ef2d7SJean Perier   Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; }
881c14ef2d7SJean Perier 
882c14ef2d7SJean Perier   Fortran::lower::AbstractConverter &converter;
883c14ef2d7SJean Perier   Fortran::lower::SymMap &symMap;
884c14ef2d7SJean Perier   Fortran::lower::StatementContext &stmtCtx;
885583d492cSJean Perier   // If there is a vector subscript, an elementalAddrOp is created
886583d492cSJean Perier   // to compute the address of the designator elements.
887583d492cSJean Perier   std::optional<hlfir::ElementalAddrOp> vectorSubscriptElementAddrOp{};
888c14ef2d7SJean Perier   mlir::Location loc;
889c14ef2d7SJean Perier };
890c14ef2d7SJean Perier 
891c7ff45a5SJean Perier hlfir::EntityWithAttributes HlfirDesignatorBuilder::genDesignatorExpr(
892c7ff45a5SJean Perier     const Fortran::lower::SomeExpr &designatorExpr,
893c7ff45a5SJean Perier     bool vectorSubscriptDesignatorToValue) {
894c7ff45a5SJean Perier   // Expr<SomeType> plumbing to unwrap Designator<T> and call
895c7ff45a5SJean Perier   // gen(Designator<T>.u).
89677d8cfb3SAlexander Shaposhnikov   return Fortran::common::visit(
897c7ff45a5SJean Perier       [&](const auto &x) -> hlfir::EntityWithAttributes {
898c7ff45a5SJean Perier         using T = std::decay_t<decltype(x)>;
899c7ff45a5SJean Perier         if constexpr (Fortran::common::HasMember<
900c7ff45a5SJean Perier                           T, Fortran::lower::CategoryExpression>) {
901c7ff45a5SJean Perier           if constexpr (T::Result::category ==
902c7ff45a5SJean Perier                         Fortran::common::TypeCategory::Derived) {
903c7ff45a5SJean Perier             return gen(std::get<Fortran::evaluate::Designator<
904c7ff45a5SJean Perier                            Fortran::evaluate::SomeDerived>>(x.u)
905c7ff45a5SJean Perier                            .u,
906c7ff45a5SJean Perier                        vectorSubscriptDesignatorToValue);
907c7ff45a5SJean Perier           } else {
90877d8cfb3SAlexander Shaposhnikov             return Fortran::common::visit(
909c7ff45a5SJean Perier                 [&](const auto &preciseKind) {
910c7ff45a5SJean Perier                   using TK =
911c7ff45a5SJean Perier                       typename std::decay_t<decltype(preciseKind)>::Result;
912c7ff45a5SJean Perier                   return gen(
913c7ff45a5SJean Perier                       std::get<Fortran::evaluate::Designator<TK>>(preciseKind.u)
914c7ff45a5SJean Perier                           .u,
915c7ff45a5SJean Perier                       vectorSubscriptDesignatorToValue);
916c7ff45a5SJean Perier                 },
917c7ff45a5SJean Perier                 x.u);
918c7ff45a5SJean Perier           }
919c7ff45a5SJean Perier         } else {
920c7ff45a5SJean Perier           fir::emitFatalError(loc, "unexpected typeless Designator");
921c7ff45a5SJean Perier         }
922c7ff45a5SJean Perier       },
923c7ff45a5SJean Perier       designatorExpr.u);
924c7ff45a5SJean Perier }
925c7ff45a5SJean Perier 
926c7ff45a5SJean Perier hlfir::ElementalAddrOp
927c7ff45a5SJean Perier HlfirDesignatorBuilder::convertVectorSubscriptedExprToElementalAddr(
928c7ff45a5SJean Perier     const Fortran::lower::SomeExpr &designatorExpr) {
929c7ff45a5SJean Perier 
930c7ff45a5SJean Perier   hlfir::EntityWithAttributes elementAddrEntity = genDesignatorExpr(
931c7ff45a5SJean Perier       designatorExpr, /*vectorSubscriptDesignatorToValue=*/false);
932c7ff45a5SJean Perier   assert(getVectorSubscriptElementAddrOp().has_value() &&
933c7ff45a5SJean Perier          "expected vector subscripts");
934c7ff45a5SJean Perier   hlfir::ElementalAddrOp elementalAddrOp = *getVectorSubscriptElementAddrOp();
935c7ff45a5SJean Perier   // Now that the type parameters have been computed, add then to the
936c7ff45a5SJean Perier   // hlfir.elemental_addr.
937c7ff45a5SJean Perier   fir::FirOpBuilder &builder = getBuilder();
938c7ff45a5SJean Perier   llvm::SmallVector<mlir::Value, 1> lengths;
939c7ff45a5SJean Perier   hlfir::genLengthParameters(loc, builder, elementAddrEntity, lengths);
940c7ff45a5SJean Perier   if (!lengths.empty())
941c7ff45a5SJean Perier     elementalAddrOp.getTypeparamsMutable().assign(lengths);
942939f0382SjeanPerier   if (!elementAddrEntity.isPolymorphic())
943939f0382SjeanPerier     elementalAddrOp.getMoldMutable().clear();
944c7ff45a5SJean Perier   // Create the hlfir.yield terminator inside the hlfir.elemental_body.
945c7ff45a5SJean Perier   builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front());
946c7ff45a5SJean Perier   builder.create<hlfir::YieldOp>(loc, elementAddrEntity);
947c7ff45a5SJean Perier   builder.setInsertionPointAfter(elementalAddrOp);
948c7ff45a5SJean Perier   // Reset the HlfirDesignatorBuilder state, in case it is used on a new
949c7ff45a5SJean Perier   // designator.
950c7ff45a5SJean Perier   setVectorSubscriptElementAddrOp(std::nullopt);
951c7ff45a5SJean Perier   return elementalAddrOp;
952c7ff45a5SJean Perier }
953c7ff45a5SJean Perier 
954440e9baaSJean Perier //===--------------------------------------------------------------------===//
955440e9baaSJean Perier // Binary Operation implementation
956440e9baaSJean Perier //===--------------------------------------------------------------------===//
957440e9baaSJean Perier 
958440e9baaSJean Perier template <typename T>
959fed3d272SJean Perier struct BinaryOp {};
960440e9baaSJean Perier 
961440e9baaSJean Perier #undef GENBIN
962440e9baaSJean Perier #define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
963440e9baaSJean Perier   template <int KIND>                                                          \
964440e9baaSJean Perier   struct BinaryOp<Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type<       \
965440e9baaSJean Perier       Fortran::common::TypeCategory::GenBinTyCat, KIND>>> {                    \
966991a90a0SJean Perier     using Op = Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type<          \
967991a90a0SJean Perier         Fortran::common::TypeCategory::GenBinTyCat, KIND>>;                    \
968440e9baaSJean Perier     static hlfir::EntityWithAttributes gen(mlir::Location loc,                 \
969440e9baaSJean Perier                                            fir::FirOpBuilder &builder,         \
970991a90a0SJean Perier                                            const Op &, hlfir::Entity lhs,      \
971440e9baaSJean Perier                                            hlfir::Entity rhs) {                \
972*fc97d2e6SPeter Klausler       if constexpr (Fortran::common::TypeCategory::GenBinTyCat ==              \
973*fc97d2e6SPeter Klausler                     Fortran::common::TypeCategory::Unsigned) {                 \
974*fc97d2e6SPeter Klausler         return hlfir::EntityWithAttributes{                                    \
975*fc97d2e6SPeter Klausler             builder.createUnsigned<GenBinFirOp>(loc, lhs.getType(), lhs,       \
976*fc97d2e6SPeter Klausler                                                 rhs)};                         \
977*fc97d2e6SPeter Klausler       } else {                                                                 \
978440e9baaSJean Perier         return hlfir::EntityWithAttributes{                                    \
979440e9baaSJean Perier             builder.create<GenBinFirOp>(loc, lhs, rhs)};                       \
980440e9baaSJean Perier       }                                                                        \
981*fc97d2e6SPeter Klausler     }                                                                          \
982440e9baaSJean Perier   };
983440e9baaSJean Perier 
984440e9baaSJean Perier GENBIN(Add, Integer, mlir::arith::AddIOp)
985*fc97d2e6SPeter Klausler GENBIN(Add, Unsigned, mlir::arith::AddIOp)
986440e9baaSJean Perier GENBIN(Add, Real, mlir::arith::AddFOp)
987440e9baaSJean Perier GENBIN(Add, Complex, fir::AddcOp)
988440e9baaSJean Perier GENBIN(Subtract, Integer, mlir::arith::SubIOp)
989*fc97d2e6SPeter Klausler GENBIN(Subtract, Unsigned, mlir::arith::SubIOp)
990440e9baaSJean Perier GENBIN(Subtract, Real, mlir::arith::SubFOp)
991440e9baaSJean Perier GENBIN(Subtract, Complex, fir::SubcOp)
992440e9baaSJean Perier GENBIN(Multiply, Integer, mlir::arith::MulIOp)
993*fc97d2e6SPeter Klausler GENBIN(Multiply, Unsigned, mlir::arith::MulIOp)
994440e9baaSJean Perier GENBIN(Multiply, Real, mlir::arith::MulFOp)
995440e9baaSJean Perier GENBIN(Multiply, Complex, fir::MulcOp)
996440e9baaSJean Perier GENBIN(Divide, Integer, mlir::arith::DivSIOp)
997*fc97d2e6SPeter Klausler GENBIN(Divide, Unsigned, mlir::arith::DivUIOp)
998440e9baaSJean Perier GENBIN(Divide, Real, mlir::arith::DivFOp)
999c3a0df19SKiran Chandramohan 
1000c3a0df19SKiran Chandramohan template <int KIND>
1001c3a0df19SKiran Chandramohan struct BinaryOp<Fortran::evaluate::Divide<
1002c3a0df19SKiran Chandramohan     Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
1003c3a0df19SKiran Chandramohan   using Op = Fortran::evaluate::Divide<
1004c3a0df19SKiran Chandramohan       Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
1005c3a0df19SKiran Chandramohan   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1006c3a0df19SKiran Chandramohan                                          fir::FirOpBuilder &builder, const Op &,
1007c3a0df19SKiran Chandramohan                                          hlfir::Entity lhs, hlfir::Entity rhs) {
1008c3a0df19SKiran Chandramohan     mlir::Type ty = Fortran::lower::getFIRType(
1009c3a0df19SKiran Chandramohan         builder.getContext(), Fortran::common::TypeCategory::Complex, KIND,
1010c3a0df19SKiran Chandramohan         /*params=*/std::nullopt);
1011c3a0df19SKiran Chandramohan     return hlfir::EntityWithAttributes{
1012c3a0df19SKiran Chandramohan         fir::genDivC(builder, loc, ty, lhs, rhs)};
1013c3a0df19SKiran Chandramohan   }
1014c3a0df19SKiran Chandramohan };
1015440e9baaSJean Perier 
101689af7de9SJean Perier template <Fortran::common::TypeCategory TC, int KIND>
101789af7de9SJean Perier struct BinaryOp<Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>> {
1018991a90a0SJean Perier   using Op = Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>;
101989af7de9SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1020655d994aSJean Perier                                          fir::FirOpBuilder &builder, const Op &,
1021655d994aSJean Perier                                          hlfir::Entity lhs, hlfir::Entity rhs) {
102289af7de9SJean Perier     mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
10239a417395SKazu Hirata                                                /*params=*/std::nullopt);
10246dcb31deSTom Eccles     return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
102589af7de9SJean Perier   }
102689af7de9SJean Perier };
102789af7de9SJean Perier 
102889af7de9SJean Perier template <Fortran::common::TypeCategory TC, int KIND>
102989af7de9SJean Perier struct BinaryOp<
103089af7de9SJean Perier     Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>> {
1031991a90a0SJean Perier   using Op =
1032991a90a0SJean Perier       Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>;
103389af7de9SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1034655d994aSJean Perier                                          fir::FirOpBuilder &builder, const Op &,
1035655d994aSJean Perier                                          hlfir::Entity lhs, hlfir::Entity rhs) {
103689af7de9SJean Perier     mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
10379a417395SKazu Hirata                                                /*params=*/std::nullopt);
10386dcb31deSTom Eccles     return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
103989af7de9SJean Perier   }
104089af7de9SJean Perier };
104189af7de9SJean Perier 
1042991a90a0SJean Perier template <Fortran::common::TypeCategory TC, int KIND>
1043991a90a0SJean Perier struct BinaryOp<
1044991a90a0SJean Perier     Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>> {
1045991a90a0SJean Perier   using Op = Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>;
1046991a90a0SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1047991a90a0SJean Perier                                          fir::FirOpBuilder &builder,
1048991a90a0SJean Perier                                          const Op &op, hlfir::Entity lhs,
1049991a90a0SJean Perier                                          hlfir::Entity rhs) {
1050991a90a0SJean Perier     llvm::SmallVector<mlir::Value, 2> args{lhs, rhs};
1051991a90a0SJean Perier     fir::ExtendedValue res = op.ordering == Fortran::evaluate::Ordering::Greater
10526dcb31deSTom Eccles                                  ? fir::genMax(builder, loc, args)
10536dcb31deSTom Eccles                                  : fir::genMin(builder, loc, args);
1054991a90a0SJean Perier     return hlfir::EntityWithAttributes{fir::getBase(res)};
1055991a90a0SJean Perier   }
1056991a90a0SJean Perier };
1057991a90a0SJean Perier 
10583191e8e1SJean Perier // evaluate::Extremum is only created by the front-end when building compiler
10593191e8e1SJean Perier // generated expressions (like when folding LEN() or shape/bounds inquiries).
10603191e8e1SJean Perier // MIN and MAX are represented as evaluate::ProcedureRef and are not going
10613191e8e1SJean Perier // through here. So far the frontend does not generate character Extremum so
10623191e8e1SJean Perier // there is no way to test it.
10633191e8e1SJean Perier template <int KIND>
10643191e8e1SJean Perier struct BinaryOp<Fortran::evaluate::Extremum<
10653191e8e1SJean Perier     Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> {
10663191e8e1SJean Perier   using Op = Fortran::evaluate::Extremum<
10673191e8e1SJean Perier       Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>;
10683191e8e1SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
10693191e8e1SJean Perier                                          fir::FirOpBuilder &, const Op &,
10703191e8e1SJean Perier                                          hlfir::Entity, hlfir::Entity) {
10713191e8e1SJean Perier     fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected");
10723191e8e1SJean Perier   }
10733191e8e1SJean Perier   static void genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &,
10743191e8e1SJean Perier                                   hlfir::Entity, hlfir::Entity,
10753191e8e1SJean Perier                                   llvm::SmallVectorImpl<mlir::Value> &) {
10763191e8e1SJean Perier     fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected");
10773191e8e1SJean Perier   }
10783191e8e1SJean Perier };
10793191e8e1SJean Perier 
108012530711SJean Perier /// Convert parser's INTEGER relational operators to MLIR.
108112530711SJean Perier static mlir::arith::CmpIPredicate
1082*fc97d2e6SPeter Klausler translateSignedRelational(Fortran::common::RelationalOperator rop) {
108312530711SJean Perier   switch (rop) {
108412530711SJean Perier   case Fortran::common::RelationalOperator::LT:
108512530711SJean Perier     return mlir::arith::CmpIPredicate::slt;
108612530711SJean Perier   case Fortran::common::RelationalOperator::LE:
108712530711SJean Perier     return mlir::arith::CmpIPredicate::sle;
108812530711SJean Perier   case Fortran::common::RelationalOperator::EQ:
108912530711SJean Perier     return mlir::arith::CmpIPredicate::eq;
109012530711SJean Perier   case Fortran::common::RelationalOperator::NE:
109112530711SJean Perier     return mlir::arith::CmpIPredicate::ne;
109212530711SJean Perier   case Fortran::common::RelationalOperator::GT:
109312530711SJean Perier     return mlir::arith::CmpIPredicate::sgt;
109412530711SJean Perier   case Fortran::common::RelationalOperator::GE:
109512530711SJean Perier     return mlir::arith::CmpIPredicate::sge;
109612530711SJean Perier   }
109712530711SJean Perier   llvm_unreachable("unhandled INTEGER relational operator");
109812530711SJean Perier }
109912530711SJean Perier 
1100*fc97d2e6SPeter Klausler static mlir::arith::CmpIPredicate
1101*fc97d2e6SPeter Klausler translateUnsignedRelational(Fortran::common::RelationalOperator rop) {
1102*fc97d2e6SPeter Klausler   switch (rop) {
1103*fc97d2e6SPeter Klausler   case Fortran::common::RelationalOperator::LT:
1104*fc97d2e6SPeter Klausler     return mlir::arith::CmpIPredicate::ult;
1105*fc97d2e6SPeter Klausler   case Fortran::common::RelationalOperator::LE:
1106*fc97d2e6SPeter Klausler     return mlir::arith::CmpIPredicate::ule;
1107*fc97d2e6SPeter Klausler   case Fortran::common::RelationalOperator::EQ:
1108*fc97d2e6SPeter Klausler     return mlir::arith::CmpIPredicate::eq;
1109*fc97d2e6SPeter Klausler   case Fortran::common::RelationalOperator::NE:
1110*fc97d2e6SPeter Klausler     return mlir::arith::CmpIPredicate::ne;
1111*fc97d2e6SPeter Klausler   case Fortran::common::RelationalOperator::GT:
1112*fc97d2e6SPeter Klausler     return mlir::arith::CmpIPredicate::ugt;
1113*fc97d2e6SPeter Klausler   case Fortran::common::RelationalOperator::GE:
1114*fc97d2e6SPeter Klausler     return mlir::arith::CmpIPredicate::uge;
1115*fc97d2e6SPeter Klausler   }
1116*fc97d2e6SPeter Klausler   llvm_unreachable("unhandled UNSIGNED relational operator");
1117*fc97d2e6SPeter Klausler }
1118*fc97d2e6SPeter Klausler 
111912530711SJean Perier /// Convert parser's REAL relational operators to MLIR.
112012530711SJean Perier /// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018
112112530711SJean Perier /// requirements in the IEEE context (table 17.1 of F2018). This choice is
112212530711SJean Perier /// also applied in other contexts because it is easier and in line with
112312530711SJean Perier /// other Fortran compilers.
112412530711SJean Perier /// FIXME: The signaling/quiet aspect of the table 17.1 requirement is not
112512530711SJean Perier /// fully enforced. FIR and LLVM `fcmp` instructions do not give any guarantee
112612530711SJean Perier /// whether the comparison will signal or not in case of quiet NaN argument.
112712530711SJean Perier static mlir::arith::CmpFPredicate
112812530711SJean Perier translateFloatRelational(Fortran::common::RelationalOperator rop) {
112912530711SJean Perier   switch (rop) {
113012530711SJean Perier   case Fortran::common::RelationalOperator::LT:
113112530711SJean Perier     return mlir::arith::CmpFPredicate::OLT;
113212530711SJean Perier   case Fortran::common::RelationalOperator::LE:
113312530711SJean Perier     return mlir::arith::CmpFPredicate::OLE;
113412530711SJean Perier   case Fortran::common::RelationalOperator::EQ:
113512530711SJean Perier     return mlir::arith::CmpFPredicate::OEQ;
113612530711SJean Perier   case Fortran::common::RelationalOperator::NE:
113712530711SJean Perier     return mlir::arith::CmpFPredicate::UNE;
113812530711SJean Perier   case Fortran::common::RelationalOperator::GT:
113912530711SJean Perier     return mlir::arith::CmpFPredicate::OGT;
114012530711SJean Perier   case Fortran::common::RelationalOperator::GE:
114112530711SJean Perier     return mlir::arith::CmpFPredicate::OGE;
114212530711SJean Perier   }
114312530711SJean Perier   llvm_unreachable("unhandled REAL relational operator");
114412530711SJean Perier }
114512530711SJean Perier 
114612530711SJean Perier template <int KIND>
114712530711SJean Perier struct BinaryOp<Fortran::evaluate::Relational<
114812530711SJean Perier     Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> {
114912530711SJean Perier   using Op = Fortran::evaluate::Relational<
115012530711SJean Perier       Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>;
115112530711SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
115212530711SJean Perier                                          fir::FirOpBuilder &builder,
115312530711SJean Perier                                          const Op &op, hlfir::Entity lhs,
115412530711SJean Perier                                          hlfir::Entity rhs) {
115512530711SJean Perier     auto cmp = builder.create<mlir::arith::CmpIOp>(
1156*fc97d2e6SPeter Klausler         loc, translateSignedRelational(op.opr), lhs, rhs);
1157*fc97d2e6SPeter Klausler     return hlfir::EntityWithAttributes{cmp};
1158*fc97d2e6SPeter Klausler   }
1159*fc97d2e6SPeter Klausler };
1160*fc97d2e6SPeter Klausler 
1161*fc97d2e6SPeter Klausler template <int KIND>
1162*fc97d2e6SPeter Klausler struct BinaryOp<Fortran::evaluate::Relational<
1163*fc97d2e6SPeter Klausler     Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
1164*fc97d2e6SPeter Klausler   using Op = Fortran::evaluate::Relational<
1165*fc97d2e6SPeter Klausler       Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
1166*fc97d2e6SPeter Klausler   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1167*fc97d2e6SPeter Klausler                                          fir::FirOpBuilder &builder,
1168*fc97d2e6SPeter Klausler                                          const Op &op, hlfir::Entity lhs,
1169*fc97d2e6SPeter Klausler                                          hlfir::Entity rhs) {
1170*fc97d2e6SPeter Klausler     int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
1171*fc97d2e6SPeter Klausler                                        KIND>::Scalar::bits;
1172*fc97d2e6SPeter Klausler     auto signlessType = mlir::IntegerType::get(
1173*fc97d2e6SPeter Klausler         builder.getContext(), bits,
1174*fc97d2e6SPeter Klausler         mlir::IntegerType::SignednessSemantics::Signless);
1175*fc97d2e6SPeter Klausler     mlir::Value lhsSL = builder.createConvert(loc, signlessType, lhs);
1176*fc97d2e6SPeter Klausler     mlir::Value rhsSL = builder.createConvert(loc, signlessType, rhs);
1177*fc97d2e6SPeter Klausler     auto cmp = builder.create<mlir::arith::CmpIOp>(
1178*fc97d2e6SPeter Klausler         loc, translateUnsignedRelational(op.opr), lhsSL, rhsSL);
117912530711SJean Perier     return hlfir::EntityWithAttributes{cmp};
118012530711SJean Perier   }
118112530711SJean Perier };
118212530711SJean Perier 
118312530711SJean Perier template <int KIND>
118412530711SJean Perier struct BinaryOp<Fortran::evaluate::Relational<
118512530711SJean Perier     Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
118612530711SJean Perier   using Op = Fortran::evaluate::Relational<
118712530711SJean Perier       Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>;
118812530711SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
118912530711SJean Perier                                          fir::FirOpBuilder &builder,
119012530711SJean Perier                                          const Op &op, hlfir::Entity lhs,
119112530711SJean Perier                                          hlfir::Entity rhs) {
119212530711SJean Perier     auto cmp = builder.create<mlir::arith::CmpFOp>(
119312530711SJean Perier         loc, translateFloatRelational(op.opr), lhs, rhs);
119412530711SJean Perier     return hlfir::EntityWithAttributes{cmp};
119512530711SJean Perier   }
119612530711SJean Perier };
119712530711SJean Perier 
119812530711SJean Perier template <int KIND>
119912530711SJean Perier struct BinaryOp<Fortran::evaluate::Relational<
120012530711SJean Perier     Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
120112530711SJean Perier   using Op = Fortran::evaluate::Relational<
120212530711SJean Perier       Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
120312530711SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
120412530711SJean Perier                                          fir::FirOpBuilder &builder,
120512530711SJean Perier                                          const Op &op, hlfir::Entity lhs,
120612530711SJean Perier                                          hlfir::Entity rhs) {
120712530711SJean Perier     auto cmp = builder.create<fir::CmpcOp>(
120812530711SJean Perier         loc, translateFloatRelational(op.opr), lhs, rhs);
120912530711SJean Perier     return hlfir::EntityWithAttributes{cmp};
121012530711SJean Perier   }
121112530711SJean Perier };
121212530711SJean Perier 
121312530711SJean Perier template <int KIND>
121412530711SJean Perier struct BinaryOp<Fortran::evaluate::Relational<
121512530711SJean Perier     Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> {
121612530711SJean Perier   using Op = Fortran::evaluate::Relational<
121712530711SJean Perier       Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>;
121812530711SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
121912530711SJean Perier                                          fir::FirOpBuilder &builder,
122012530711SJean Perier                                          const Op &op, hlfir::Entity lhs,
122112530711SJean Perier                                          hlfir::Entity rhs) {
122212530711SJean Perier     auto [lhsExv, lhsCleanUp] =
122312530711SJean Perier         hlfir::translateToExtendedValue(loc, builder, lhs);
122412530711SJean Perier     auto [rhsExv, rhsCleanUp] =
122512530711SJean Perier         hlfir::translateToExtendedValue(loc, builder, rhs);
122612530711SJean Perier     auto cmp = fir::runtime::genCharCompare(
1227*fc97d2e6SPeter Klausler         builder, loc, translateSignedRelational(op.opr), lhsExv, rhsExv);
122812530711SJean Perier     if (lhsCleanUp)
122915a9a72eSFangrui Song       (*lhsCleanUp)();
123012530711SJean Perier     if (rhsCleanUp)
123115a9a72eSFangrui Song       (*rhsCleanUp)();
123212530711SJean Perier     return hlfir::EntityWithAttributes{cmp};
123312530711SJean Perier   }
123412530711SJean Perier };
123512530711SJean Perier 
1236248fcb13SJean Perier template <int KIND>
1237248fcb13SJean Perier struct BinaryOp<Fortran::evaluate::LogicalOperation<KIND>> {
1238248fcb13SJean Perier   using Op = Fortran::evaluate::LogicalOperation<KIND>;
1239248fcb13SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1240248fcb13SJean Perier                                          fir::FirOpBuilder &builder,
1241248fcb13SJean Perier                                          const Op &op, hlfir::Entity lhs,
1242248fcb13SJean Perier                                          hlfir::Entity rhs) {
1243248fcb13SJean Perier     mlir::Type i1Type = builder.getI1Type();
1244248fcb13SJean Perier     mlir::Value i1Lhs = builder.createConvert(loc, i1Type, lhs);
1245248fcb13SJean Perier     mlir::Value i1Rhs = builder.createConvert(loc, i1Type, rhs);
1246248fcb13SJean Perier     switch (op.logicalOperator) {
1247248fcb13SJean Perier     case Fortran::evaluate::LogicalOperator::And:
1248248fcb13SJean Perier       return hlfir::EntityWithAttributes{
1249248fcb13SJean Perier           builder.create<mlir::arith::AndIOp>(loc, i1Lhs, i1Rhs)};
1250248fcb13SJean Perier     case Fortran::evaluate::LogicalOperator::Or:
1251248fcb13SJean Perier       return hlfir::EntityWithAttributes{
1252248fcb13SJean Perier           builder.create<mlir::arith::OrIOp>(loc, i1Lhs, i1Rhs)};
1253248fcb13SJean Perier     case Fortran::evaluate::LogicalOperator::Eqv:
1254248fcb13SJean Perier       return hlfir::EntityWithAttributes{builder.create<mlir::arith::CmpIOp>(
1255248fcb13SJean Perier           loc, mlir::arith::CmpIPredicate::eq, i1Lhs, i1Rhs)};
1256248fcb13SJean Perier     case Fortran::evaluate::LogicalOperator::Neqv:
1257248fcb13SJean Perier       return hlfir::EntityWithAttributes{builder.create<mlir::arith::CmpIOp>(
1258248fcb13SJean Perier           loc, mlir::arith::CmpIPredicate::ne, i1Lhs, i1Rhs)};
1259248fcb13SJean Perier     case Fortran::evaluate::LogicalOperator::Not:
1260248fcb13SJean Perier       // lib/evaluate expression for .NOT. is Fortran::evaluate::Not<KIND>.
1261248fcb13SJean Perier       llvm_unreachable(".NOT. is not a binary operator");
1262248fcb13SJean Perier     }
1263ffdb5f95SJean Perier     llvm_unreachable("unhandled logical operation");
1264248fcb13SJean Perier   }
1265248fcb13SJean Perier };
1266248fcb13SJean Perier 
126726ceeee7SJean Perier template <int KIND>
126826ceeee7SJean Perier struct BinaryOp<Fortran::evaluate::ComplexConstructor<KIND>> {
126926ceeee7SJean Perier   using Op = Fortran::evaluate::ComplexConstructor<KIND>;
127026ceeee7SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1271655d994aSJean Perier                                          fir::FirOpBuilder &builder, const Op &,
1272655d994aSJean Perier                                          hlfir::Entity lhs, hlfir::Entity rhs) {
127326ceeee7SJean Perier     mlir::Value res =
1274c4204c0bSjeanPerier         fir::factory::Complex{builder, loc}.createComplex(lhs, rhs);
127526ceeee7SJean Perier     return hlfir::EntityWithAttributes{res};
127626ceeee7SJean Perier   }
127726ceeee7SJean Perier };
127826ceeee7SJean Perier 
1279fed3d272SJean Perier template <int KIND>
1280fed3d272SJean Perier struct BinaryOp<Fortran::evaluate::SetLength<KIND>> {
1281fed3d272SJean Perier   using Op = Fortran::evaluate::SetLength<KIND>;
1282fed3d272SJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
12838febe678SJean Perier                                          fir::FirOpBuilder &builder, const Op &,
12848febe678SJean Perier                                          hlfir::Entity string,
12858febe678SJean Perier                                          hlfir::Entity length) {
12867a4570acSjeanPerier     // The input length may be a user input and needs to be sanitized as per
12877a4570acSjeanPerier     // Fortran 2018 7.4.4.2 point 5.
12887a4570acSjeanPerier     mlir::Value safeLength = fir::factory::genMaxWithZero(builder, loc, length);
12898febe678SJean Perier     return hlfir::EntityWithAttributes{
12907a4570acSjeanPerier         builder.create<hlfir::SetLengthOp>(loc, string, safeLength)};
1291fed3d272SJean Perier   }
12923191e8e1SJean Perier   static void
12938febe678SJean Perier   genResultTypeParams(mlir::Location, fir::FirOpBuilder &, hlfir::Entity,
12948febe678SJean Perier                       hlfir::Entity rhs,
12953191e8e1SJean Perier                       llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
12963191e8e1SJean Perier     resultTypeParams.push_back(rhs);
12973191e8e1SJean Perier   }
12983191e8e1SJean Perier };
12993191e8e1SJean Perier 
13003191e8e1SJean Perier template <int KIND>
13013191e8e1SJean Perier struct BinaryOp<Fortran::evaluate::Concat<KIND>> {
13023191e8e1SJean Perier   using Op = Fortran::evaluate::Concat<KIND>;
13033191e8e1SJean Perier   hlfir::EntityWithAttributes gen(mlir::Location loc,
13043191e8e1SJean Perier                                   fir::FirOpBuilder &builder, const Op &,
13053191e8e1SJean Perier                                   hlfir::Entity lhs, hlfir::Entity rhs) {
13063191e8e1SJean Perier     assert(len && "genResultTypeParams must have been called");
13073191e8e1SJean Perier     auto concat =
13083191e8e1SJean Perier         builder.create<hlfir::ConcatOp>(loc, mlir::ValueRange{lhs, rhs}, len);
13093191e8e1SJean Perier     return hlfir::EntityWithAttributes{concat.getResult()};
13103191e8e1SJean Perier   }
13113191e8e1SJean Perier   void
13123191e8e1SJean Perier   genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
13133191e8e1SJean Perier                       hlfir::Entity lhs, hlfir::Entity rhs,
13143191e8e1SJean Perier                       llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
13153191e8e1SJean Perier     llvm::SmallVector<mlir::Value> lengths;
13163191e8e1SJean Perier     hlfir::genLengthParameters(loc, builder, lhs, lengths);
13173191e8e1SJean Perier     hlfir::genLengthParameters(loc, builder, rhs, lengths);
13183191e8e1SJean Perier     assert(lengths.size() == 2 && "lacks rhs or lhs length");
13193191e8e1SJean Perier     mlir::Type idxType = builder.getIndexType();
13203191e8e1SJean Perier     mlir::Value lhsLen = builder.createConvert(loc, idxType, lengths[0]);
13213191e8e1SJean Perier     mlir::Value rhsLen = builder.createConvert(loc, idxType, lengths[1]);
13223191e8e1SJean Perier     len = builder.create<mlir::arith::AddIOp>(loc, lhsLen, rhsLen);
13233191e8e1SJean Perier     resultTypeParams.push_back(len);
13243191e8e1SJean Perier   }
13253191e8e1SJean Perier 
13263191e8e1SJean Perier private:
13273191e8e1SJean Perier   mlir::Value len{};
1328fed3d272SJean Perier };
1329fed3d272SJean Perier 
133012c8797fSJean Perier //===--------------------------------------------------------------------===//
133112c8797fSJean Perier // Unary Operation implementation
133212c8797fSJean Perier //===--------------------------------------------------------------------===//
133312c8797fSJean Perier 
133412c8797fSJean Perier template <typename T>
133512c8797fSJean Perier struct UnaryOp {};
133612c8797fSJean Perier 
133712c8797fSJean Perier template <int KIND>
133812c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Not<KIND>> {
133912c8797fSJean Perier   using Op = Fortran::evaluate::Not<KIND>;
134012c8797fSJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1341655d994aSJean Perier                                          fir::FirOpBuilder &builder, const Op &,
1342655d994aSJean Perier                                          hlfir::Entity lhs) {
134312c8797fSJean Perier     mlir::Value one = builder.createBool(loc, true);
134412c8797fSJean Perier     mlir::Value val = builder.createConvert(loc, builder.getI1Type(), lhs);
134512c8797fSJean Perier     return hlfir::EntityWithAttributes{
134612c8797fSJean Perier         builder.create<mlir::arith::XOrIOp>(loc, val, one)};
134712c8797fSJean Perier   }
134812c8797fSJean Perier };
134912c8797fSJean Perier 
135012c8797fSJean Perier template <int KIND>
135112c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Negate<
135212c8797fSJean Perier     Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> {
135312c8797fSJean Perier   using Op = Fortran::evaluate::Negate<
135412c8797fSJean Perier       Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>;
135512c8797fSJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1356655d994aSJean Perier                                          fir::FirOpBuilder &builder, const Op &,
1357655d994aSJean Perier                                          hlfir::Entity lhs) {
135812c8797fSJean Perier     // Like LLVM, integer negation is the binary op "0 - value"
135912c8797fSJean Perier     mlir::Type type = Fortran::lower::getFIRType(
136012c8797fSJean Perier         builder.getContext(), Fortran::common::TypeCategory::Integer, KIND,
13619a417395SKazu Hirata         /*params=*/std::nullopt);
136212c8797fSJean Perier     mlir::Value zero = builder.createIntegerConstant(loc, type, 0);
136312c8797fSJean Perier     return hlfir::EntityWithAttributes{
136412c8797fSJean Perier         builder.create<mlir::arith::SubIOp>(loc, zero, lhs)};
136512c8797fSJean Perier   }
136612c8797fSJean Perier };
136712c8797fSJean Perier 
136812c8797fSJean Perier template <int KIND>
136912c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Negate<
1370*fc97d2e6SPeter Klausler     Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
1371*fc97d2e6SPeter Klausler   using Op = Fortran::evaluate::Negate<
1372*fc97d2e6SPeter Klausler       Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
1373*fc97d2e6SPeter Klausler   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1374*fc97d2e6SPeter Klausler                                          fir::FirOpBuilder &builder, const Op &,
1375*fc97d2e6SPeter Klausler                                          hlfir::Entity lhs) {
1376*fc97d2e6SPeter Klausler     int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
1377*fc97d2e6SPeter Klausler                                        KIND>::Scalar::bits;
1378*fc97d2e6SPeter Klausler     mlir::Type signlessType = mlir::IntegerType::get(
1379*fc97d2e6SPeter Klausler         builder.getContext(), bits,
1380*fc97d2e6SPeter Klausler         mlir::IntegerType::SignednessSemantics::Signless);
1381*fc97d2e6SPeter Klausler     mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
1382*fc97d2e6SPeter Klausler     mlir::Value signless = builder.createConvert(loc, signlessType, lhs);
1383*fc97d2e6SPeter Klausler     mlir::Value negated =
1384*fc97d2e6SPeter Klausler         builder.create<mlir::arith::SubIOp>(loc, zero, signless);
1385*fc97d2e6SPeter Klausler     return hlfir::EntityWithAttributes(
1386*fc97d2e6SPeter Klausler         builder.createConvert(loc, lhs.getType(), negated));
1387*fc97d2e6SPeter Klausler   }
1388*fc97d2e6SPeter Klausler };
1389*fc97d2e6SPeter Klausler 
1390*fc97d2e6SPeter Klausler template <int KIND>
1391*fc97d2e6SPeter Klausler struct UnaryOp<Fortran::evaluate::Negate<
139212c8797fSJean Perier     Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
139312c8797fSJean Perier   using Op = Fortran::evaluate::Negate<
139412c8797fSJean Perier       Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>;
139512c8797fSJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1396655d994aSJean Perier                                          fir::FirOpBuilder &builder, const Op &,
1397655d994aSJean Perier                                          hlfir::Entity lhs) {
139812c8797fSJean Perier     return hlfir::EntityWithAttributes{
139912c8797fSJean Perier         builder.create<mlir::arith::NegFOp>(loc, lhs)};
140012c8797fSJean Perier   }
140112c8797fSJean Perier };
140212c8797fSJean Perier 
140312c8797fSJean Perier template <int KIND>
140412c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Negate<
140512c8797fSJean Perier     Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
140612c8797fSJean Perier   using Op = Fortran::evaluate::Negate<
140712c8797fSJean Perier       Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
140812c8797fSJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1409655d994aSJean Perier                                          fir::FirOpBuilder &builder, const Op &,
1410655d994aSJean Perier                                          hlfir::Entity lhs) {
141112c8797fSJean Perier     return hlfir::EntityWithAttributes{builder.create<fir::NegcOp>(loc, lhs)};
141212c8797fSJean Perier   }
141312c8797fSJean Perier };
141412c8797fSJean Perier 
141512c8797fSJean Perier template <int KIND>
141612c8797fSJean Perier struct UnaryOp<Fortran::evaluate::ComplexComponent<KIND>> {
141712c8797fSJean Perier   using Op = Fortran::evaluate::ComplexComponent<KIND>;
141812c8797fSJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
141912c8797fSJean Perier                                          fir::FirOpBuilder &builder,
142012c8797fSJean Perier                                          const Op &op, hlfir::Entity lhs) {
142112c8797fSJean Perier     mlir::Value res = fir::factory::Complex{builder, loc}.extractComplexPart(
142212c8797fSJean Perier         lhs, op.isImaginaryPart);
142312c8797fSJean Perier     return hlfir::EntityWithAttributes{res};
142412c8797fSJean Perier   }
142512c8797fSJean Perier };
142612c8797fSJean Perier 
142712c8797fSJean Perier template <typename T>
142812c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Parentheses<T>> {
142912c8797fSJean Perier   using Op = Fortran::evaluate::Parentheses<T>;
14306e3292fbSJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
14316e3292fbSJean Perier                                          fir::FirOpBuilder &builder,
14326e3292fbSJean Perier                                          const Op &op, hlfir::Entity lhs) {
14336e3292fbSJean Perier     if (lhs.isVariable())
14346e3292fbSJean Perier       return hlfir::EntityWithAttributes{
14356e3292fbSJean Perier           builder.create<hlfir::AsExprOp>(loc, lhs)};
14366e3292fbSJean Perier     return hlfir::EntityWithAttributes{
14376e3292fbSJean Perier         builder.create<hlfir::NoReassocOp>(loc, lhs.getType(), lhs)};
143812c8797fSJean Perier   }
14393191e8e1SJean Perier 
14403191e8e1SJean Perier   static void
14413191e8e1SJean Perier   genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
14423191e8e1SJean Perier                       hlfir::Entity lhs,
14433191e8e1SJean Perier                       llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
14443191e8e1SJean Perier     hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams);
14453191e8e1SJean Perier   }
144612c8797fSJean Perier };
144712c8797fSJean Perier 
1448f24466cfSJean Perier template <Fortran::common::TypeCategory TC1, int KIND,
1449f24466cfSJean Perier           Fortran::common::TypeCategory TC2>
1450f24466cfSJean Perier struct UnaryOp<
1451f24466cfSJean Perier     Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>> {
1452f24466cfSJean Perier   using Op =
1453f24466cfSJean Perier       Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>;
1454f24466cfSJean Perier   static hlfir::EntityWithAttributes gen(mlir::Location loc,
1455655d994aSJean Perier                                          fir::FirOpBuilder &builder, const Op &,
1456655d994aSJean Perier                                          hlfir::Entity lhs) {
1457f24466cfSJean Perier     if constexpr (TC1 == Fortran::common::TypeCategory::Character &&
1458f24466cfSJean Perier                   TC2 == TC1) {
14597046202cSjeanPerier       return hlfir::convertCharacterKind(loc, builder, lhs, KIND);
1460655d994aSJean Perier     }
1461f24466cfSJean Perier     mlir::Type type = Fortran::lower::getFIRType(builder.getContext(), TC1,
14629a417395SKazu Hirata                                                  KIND, /*params=*/std::nullopt);
1463f24466cfSJean Perier     mlir::Value res = builder.convertWithSemantics(loc, type, lhs);
1464f24466cfSJean Perier     return hlfir::EntityWithAttributes{res};
1465f24466cfSJean Perier   }
14663191e8e1SJean Perier 
14673191e8e1SJean Perier   static void
14683191e8e1SJean Perier   genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
14693191e8e1SJean Perier                       hlfir::Entity lhs,
14703191e8e1SJean Perier                       llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
14713191e8e1SJean Perier     hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams);
14723191e8e1SJean Perier   }
1473f24466cfSJean Perier };
1474f24466cfSJean Perier 
14758252137bSjeanPerier static bool hasDeferredCharacterLength(const Fortran::semantics::Symbol &sym) {
14768252137bSjeanPerier   const Fortran::semantics::DeclTypeSpec *type = sym.GetType();
14778252137bSjeanPerier   return type &&
14788252137bSjeanPerier          type->category() ==
14798252137bSjeanPerier              Fortran::semantics::DeclTypeSpec::Category::Character &&
14808252137bSjeanPerier          type->characterTypeSpec().length().isDeferred();
14818252137bSjeanPerier }
14828252137bSjeanPerier 
1483c14ef2d7SJean Perier /// Lower Expr to HLFIR.
1484c14ef2d7SJean Perier class HlfirBuilder {
1485c14ef2d7SJean Perier public:
1486c14ef2d7SJean Perier   HlfirBuilder(mlir::Location loc, Fortran::lower::AbstractConverter &converter,
1487c14ef2d7SJean Perier                Fortran::lower::SymMap &symMap,
1488c14ef2d7SJean Perier                Fortran::lower::StatementContext &stmtCtx)
1489c14ef2d7SJean Perier       : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {}
1490c14ef2d7SJean Perier 
1491c14ef2d7SJean Perier   template <typename T>
1492fcfb620dSJean Perier   hlfir::EntityWithAttributes gen(const Fortran::evaluate::Expr<T> &expr) {
1493b6b0756cSjeanPerier     if (const Fortran::lower::ExprToValueMap *map =
1494b6b0756cSjeanPerier             getConverter().getExprOverrides()) {
1495b6b0756cSjeanPerier       if constexpr (std::is_same_v<T, Fortran::evaluate::SomeType>) {
1496b6b0756cSjeanPerier         if (auto match = map->find(&expr); match != map->end())
1497b6b0756cSjeanPerier           return hlfir::EntityWithAttributes{match->second};
1498b6b0756cSjeanPerier       } else {
1499b6b0756cSjeanPerier         Fortran::lower::SomeExpr someExpr = toEvExpr(expr);
1500b6b0756cSjeanPerier         if (auto match = map->find(&someExpr); match != map->end())
1501b6b0756cSjeanPerier           return hlfir::EntityWithAttributes{match->second};
1502b6b0756cSjeanPerier       }
1503b6b0756cSjeanPerier     }
150477d8cfb3SAlexander Shaposhnikov     return Fortran::common::visit([&](const auto &x) { return gen(x); },
150577d8cfb3SAlexander Shaposhnikov                                   expr.u);
1506c14ef2d7SJean Perier   }
1507c14ef2d7SJean Perier 
1508c14ef2d7SJean Perier private:
1509fcfb620dSJean Perier   hlfir::EntityWithAttributes
1510fcfb620dSJean Perier   gen(const Fortran::evaluate::BOZLiteralConstant &expr) {
1511ca2ec4b7SSlava Zakharin     TODO(getLoc(), "BOZ");
1512c14ef2d7SJean Perier   }
15134e78f885SJean Perier 
1514fcfb620dSJean Perier   hlfir::EntityWithAttributes gen(const Fortran::evaluate::NullPointer &expr) {
15154e78f885SJean Perier     auto nullop = getBuilder().create<hlfir::NullOp>(getLoc());
15164e78f885SJean Perier     return mlir::cast<fir::FortranVariableOpInterface>(nullop.getOperation());
1517c14ef2d7SJean Perier   }
15184e78f885SJean Perier 
1519fcfb620dSJean Perier   hlfir::EntityWithAttributes
1520cedfd272SJean Perier   gen(const Fortran::evaluate::ProcedureDesignator &proc) {
1521cedfd272SJean Perier     return Fortran::lower::convertProcedureDesignatorToHLFIR(
1522cedfd272SJean Perier         getLoc(), getConverter(), proc, getSymMap(), getStmtCtx());
1523c14ef2d7SJean Perier   }
1524cedfd272SJean Perier 
1525fcfb620dSJean Perier   hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) {
1526cdb320b4SDaniel Chen     Fortran::evaluate::ProcedureDesignator proc{expr.proc()};
1527cdb320b4SDaniel Chen     auto procTy{Fortran::lower::translateSignature(proc, getConverter())};
1528cdb320b4SDaniel Chen     auto result = Fortran::lower::convertCallToHLFIR(getLoc(), getConverter(),
1529cdb320b4SDaniel Chen                                                      expr, procTy.getResult(0),
1530cdb320b4SDaniel Chen                                                      getSymMap(), getStmtCtx());
1531cdb320b4SDaniel Chen     assert(result.has_value());
1532cdb320b4SDaniel Chen     return *result;
1533c14ef2d7SJean Perier   }
1534c14ef2d7SJean Perier 
1535c14ef2d7SJean Perier   template <typename T>
1536fcfb620dSJean Perier   hlfir::EntityWithAttributes
1537fcfb620dSJean Perier   gen(const Fortran::evaluate::Designator<T> &designator) {
1538c14ef2d7SJean Perier     return HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(),
1539c14ef2d7SJean Perier                                   getStmtCtx())
1540c14ef2d7SJean Perier         .gen(designator.u);
1541c14ef2d7SJean Perier   }
1542c14ef2d7SJean Perier 
1543c14ef2d7SJean Perier   template <typename T>
1544fcfb620dSJean Perier   hlfir::EntityWithAttributes
1545fcfb620dSJean Perier   gen(const Fortran::evaluate::FunctionRef<T> &expr) {
1546e78e4a17SJean Perier     mlir::Type resType =
1547e78e4a17SJean Perier         Fortran::lower::TypeBuilder<T>::genType(getConverter(), expr);
1548a8234196SPeter Klausler     auto result = Fortran::lower::convertCallToHLFIR(
154915a9a72eSFangrui Song         getLoc(), getConverter(), expr, resType, getSymMap(), getStmtCtx());
1550a8234196SPeter Klausler     assert(result.has_value());
1551a8234196SPeter Klausler     return *result;
1552c14ef2d7SJean Perier   }
1553c14ef2d7SJean Perier 
1554c14ef2d7SJean Perier   template <typename T>
1555fcfb620dSJean Perier   hlfir::EntityWithAttributes gen(const Fortran::evaluate::Constant<T> &expr) {
15563952377fSJean Perier     mlir::Location loc = getLoc();
15573952377fSJean Perier     fir::FirOpBuilder &builder = getBuilder();
15582d9b4a50SJean Perier     fir::ExtendedValue exv = Fortran::lower::convertConstant(
15592d9b4a50SJean Perier         converter, loc, expr, /*outlineBigConstantInReadOnlyMemory=*/true);
15603952377fSJean Perier     if (const auto *scalarBox = exv.getUnboxed())
15613952377fSJean Perier       if (fir::isa_trivial(scalarBox->getType()))
1562fcfb620dSJean Perier         return hlfir::EntityWithAttributes(*scalarBox);
15633952377fSJean Perier     if (auto addressOf = fir::getBase(exv).getDefiningOp<fir::AddrOfOp>()) {
15643952377fSJean Perier       auto flags = fir::FortranVariableFlagsAttr::get(
15653952377fSJean Perier           builder.getContext(), fir::FortranVariableFlagsEnum::parameter);
15663952377fSJean Perier       return hlfir::genDeclare(
15673952377fSJean Perier           loc, builder, exv,
15683952377fSJean Perier           addressOf.getSymbol().getRootReference().getValue(), flags);
15693952377fSJean Perier     }
15703952377fSJean Perier     fir::emitFatalError(loc, "Constant<T> was lowered to unexpected format");
15713952377fSJean Perier   }
1572c14ef2d7SJean Perier 
1573c14ef2d7SJean Perier   template <typename T>
1574fcfb620dSJean Perier   hlfir::EntityWithAttributes
1575ffde9f17SJean Perier   gen(const Fortran::evaluate::ArrayConstructor<T> &arrayCtor) {
1576ffde9f17SJean Perier     return Fortran::lower::ArrayConstructorBuilder<T>::gen(
1577ffde9f17SJean Perier         getLoc(), getConverter(), arrayCtor, getSymMap(), getStmtCtx());
1578c14ef2d7SJean Perier   }
1579c14ef2d7SJean Perier 
1580c14ef2d7SJean Perier   template <typename D, typename R, typename O>
1581fcfb620dSJean Perier   hlfir::EntityWithAttributes
1582fcfb620dSJean Perier   gen(const Fortran::evaluate::Operation<D, R, O> &op) {
158312c8797fSJean Perier     auto &builder = getBuilder();
158412c8797fSJean Perier     mlir::Location loc = getLoc();
15853191e8e1SJean Perier     const int rank = op.Rank();
15863191e8e1SJean Perier     UnaryOp<D> unaryOp;
158712c8797fSJean Perier     auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left()));
15883191e8e1SJean Perier     llvm::SmallVector<mlir::Value, 1> typeParams;
15893191e8e1SJean Perier     if constexpr (R::category == Fortran::common::TypeCategory::Character) {
15903191e8e1SJean Perier       unaryOp.genResultTypeParams(loc, builder, left, typeParams);
15913191e8e1SJean Perier     }
15923191e8e1SJean Perier     if (rank == 0)
15933191e8e1SJean Perier       return unaryOp.gen(loc, builder, op.derived(), left);
15943191e8e1SJean Perier 
15953191e8e1SJean Perier     // Elemental expression.
15963191e8e1SJean Perier     mlir::Type elementType;
15973191e8e1SJean Perier     if constexpr (R::category == Fortran::common::TypeCategory::Derived) {
15989184eb84SSlava Zakharin       if (op.derived().GetType().IsUnlimitedPolymorphic())
15999184eb84SSlava Zakharin         elementType = mlir::NoneType::get(builder.getContext());
16009184eb84SSlava Zakharin       else
16013191e8e1SJean Perier         elementType = Fortran::lower::translateDerivedTypeToFIRType(
16023191e8e1SJean Perier             getConverter(), op.derived().GetType().GetDerivedTypeSpec());
16033191e8e1SJean Perier     } else {
16043191e8e1SJean Perier       elementType =
16053191e8e1SJean Perier           Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind,
16063191e8e1SJean Perier                                      /*params=*/std::nullopt);
16073191e8e1SJean Perier     }
16083191e8e1SJean Perier     mlir::Value shape = hlfir::genShape(loc, builder, left);
16093191e8e1SJean Perier     auto genKernel = [&op, &left, &unaryOp](
16103191e8e1SJean Perier                          mlir::Location l, fir::FirOpBuilder &b,
16113191e8e1SJean Perier                          mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
16123191e8e1SJean Perier       auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices);
16133191e8e1SJean Perier       auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement);
16143191e8e1SJean Perier       return unaryOp.gen(l, b, op.derived(), leftVal);
16153191e8e1SJean Perier     };
16165a4c5c86SSlava Zakharin     mlir::Value elemental = hlfir::genElementalOp(
16175a4c5c86SSlava Zakharin         loc, builder, elementType, shape, typeParams, genKernel,
16185a4c5c86SSlava Zakharin         /*isUnordered=*/true, left.isPolymorphic() ? left : mlir::Value{});
1619c0b45fefSJean Perier     fir::FirOpBuilder *bldr = &builder;
1620c0b45fefSJean Perier     getStmtCtx().attachCleanup(
1621c0b45fefSJean Perier         [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
1622c0b45fefSJean Perier     return hlfir::EntityWithAttributes{elemental};
1623c14ef2d7SJean Perier   }
1624c14ef2d7SJean Perier 
1625c14ef2d7SJean Perier   template <typename D, typename R, typename LO, typename RO>
1626fcfb620dSJean Perier   hlfir::EntityWithAttributes
1627c14ef2d7SJean Perier   gen(const Fortran::evaluate::Operation<D, R, LO, RO> &op) {
1628440e9baaSJean Perier     auto &builder = getBuilder();
1629440e9baaSJean Perier     mlir::Location loc = getLoc();
16303191e8e1SJean Perier     const int rank = op.Rank();
16313191e8e1SJean Perier     BinaryOp<D> binaryOp;
1632440e9baaSJean Perier     auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left()));
1633440e9baaSJean Perier     auto right = hlfir::loadTrivialScalar(loc, builder, gen(op.right()));
16343191e8e1SJean Perier     llvm::SmallVector<mlir::Value, 1> typeParams;
16353191e8e1SJean Perier     if constexpr (R::category == Fortran::common::TypeCategory::Character) {
16363191e8e1SJean Perier       binaryOp.genResultTypeParams(loc, builder, left, right, typeParams);
1637c14ef2d7SJean Perier     }
16383191e8e1SJean Perier     if (rank == 0)
16393191e8e1SJean Perier       return binaryOp.gen(loc, builder, op.derived(), left, right);
1640c14ef2d7SJean Perier 
16413191e8e1SJean Perier     // Elemental expression.
16423191e8e1SJean Perier     mlir::Type elementType =
16433191e8e1SJean Perier         Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind,
16443191e8e1SJean Perier                                    /*params=*/std::nullopt);
16453191e8e1SJean Perier     // TODO: "merge" shape, get cst shape from front-end if possible.
16463191e8e1SJean Perier     mlir::Value shape;
16473191e8e1SJean Perier     if (left.isArray()) {
16483191e8e1SJean Perier       shape = hlfir::genShape(loc, builder, left);
16493191e8e1SJean Perier     } else {
16503191e8e1SJean Perier       assert(right.isArray() && "must have at least one array operand");
16513191e8e1SJean Perier       shape = hlfir::genShape(loc, builder, right);
16523191e8e1SJean Perier     }
16533191e8e1SJean Perier     auto genKernel = [&op, &left, &right, &binaryOp](
16543191e8e1SJean Perier                          mlir::Location l, fir::FirOpBuilder &b,
16553191e8e1SJean Perier                          mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
16563191e8e1SJean Perier       auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices);
16573191e8e1SJean Perier       auto rightElement = hlfir::getElementAt(l, b, right, oneBasedIndices);
16583191e8e1SJean Perier       auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement);
16593191e8e1SJean Perier       auto rightVal = hlfir::loadTrivialScalar(l, b, rightElement);
16603191e8e1SJean Perier       return binaryOp.gen(l, b, op.derived(), leftVal, rightVal);
16613191e8e1SJean Perier     };
1662b91a25efSYusuke MINATO     auto iofBackup = builder.getIntegerOverflowFlags();
1663b91a25efSYusuke MINATO     // nsw is never added to operations on vector subscripts
1664b91a25efSYusuke MINATO     // even if -fno-wrapv is enabled.
1665b91a25efSYusuke MINATO     builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::none);
1666c0b45fefSJean Perier     mlir::Value elemental = hlfir::genElementalOp(loc, builder, elementType,
16677b4aa95dSSlava Zakharin                                                   shape, typeParams, genKernel,
16687b4aa95dSSlava Zakharin                                                   /*isUnordered=*/true);
1669b91a25efSYusuke MINATO     builder.setIntegerOverflowFlags(iofBackup);
1670c0b45fefSJean Perier     fir::FirOpBuilder *bldr = &builder;
1671c0b45fefSJean Perier     getStmtCtx().attachCleanup(
1672c0b45fefSJean Perier         [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
1673c0b45fefSJean Perier     return hlfir::EntityWithAttributes{elemental};
167494b9fbabSJean Perier   }
167594b9fbabSJean Perier 
1676fcfb620dSJean Perier   hlfir::EntityWithAttributes
1677c14ef2d7SJean Perier   gen(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &op) {
167877d8cfb3SAlexander Shaposhnikov     return Fortran::common::visit([&](const auto &x) { return gen(x); }, op.u);
1679c14ef2d7SJean Perier   }
1680c14ef2d7SJean Perier 
1681fcfb620dSJean Perier   hlfir::EntityWithAttributes gen(const Fortran::evaluate::TypeParamInquiry &) {
1682c14ef2d7SJean Perier     TODO(getLoc(), "lowering type parameter inquiry to HLFIR");
1683c14ef2d7SJean Perier   }
1684c14ef2d7SJean Perier 
1685fcfb620dSJean Perier   hlfir::EntityWithAttributes
1686fcfb620dSJean Perier   gen(const Fortran::evaluate::DescriptorInquiry &desc) {
1687d0018c95SJean Perier     mlir::Location loc = getLoc();
1688d0018c95SJean Perier     auto &builder = getBuilder();
1689d0018c95SJean Perier     hlfir::EntityWithAttributes entity =
1690d0018c95SJean Perier         HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(),
1691d0018c95SJean Perier                                getStmtCtx())
1692583d492cSJean Perier             .genNamedEntity(desc.base());
1693d0018c95SJean Perier     using ResTy = Fortran::evaluate::DescriptorInquiry::Result;
1694d0018c95SJean Perier     mlir::Type resultType =
1695d0018c95SJean Perier         getConverter().genType(ResTy::category, ResTy::kind);
1696d0018c95SJean Perier     auto castResult = [&](mlir::Value v) {
1697d0018c95SJean Perier       return hlfir::EntityWithAttributes{
1698d0018c95SJean Perier           builder.createConvert(loc, resultType, v)};
1699d0018c95SJean Perier     };
1700d0018c95SJean Perier     switch (desc.field()) {
1701d0018c95SJean Perier     case Fortran::evaluate::DescriptorInquiry::Field::Len:
1702d0018c95SJean Perier       return castResult(hlfir::genCharLength(loc, builder, entity));
1703d0018c95SJean Perier     case Fortran::evaluate::DescriptorInquiry::Field::LowerBound:
170492e5234fSJean Perier       return castResult(
170592e5234fSJean Perier           hlfir::genLBound(loc, builder, entity, desc.dimension()));
1706d0018c95SJean Perier     case Fortran::evaluate::DescriptorInquiry::Field::Extent:
170792e5234fSJean Perier       return castResult(
170892e5234fSJean Perier           hlfir::genExtent(loc, builder, entity, desc.dimension()));
1709d0018c95SJean Perier     case Fortran::evaluate::DescriptorInquiry::Field::Rank:
1710fd8b2d20SjeanPerier       return castResult(hlfir::genRank(loc, builder, entity, resultType));
1711d0018c95SJean Perier     case Fortran::evaluate::DescriptorInquiry::Field::Stride:
1712d0018c95SJean Perier       // So far the front end does not generate this inquiry.
1713d0018c95SJean Perier       TODO(loc, "stride inquiry");
1714d0018c95SJean Perier     }
1715d0018c95SJean Perier     llvm_unreachable("unknown descriptor inquiry");
1716c14ef2d7SJean Perier   }
1717c14ef2d7SJean Perier 
1718fcfb620dSJean Perier   hlfir::EntityWithAttributes
1719fcfb620dSJean Perier   gen(const Fortran::evaluate::ImpliedDoIndex &var) {
1720ffde9f17SJean Perier     mlir::Value value = symMap.lookupImpliedDo(toStringRef(var.name));
17219a7b363eSSlava Zakharin     if (!value)
17229a7b363eSSlava Zakharin       fir::emitFatalError(getLoc(), "ac-do-variable has no binding");
17239a7b363eSSlava Zakharin     // The index value generated by the implied-do has Index type,
17249a7b363eSSlava Zakharin     // while computations based on it inside the loop body are using
17259a7b363eSSlava Zakharin     // the original data type. So we need to cast it appropriately.
17269a7b363eSSlava Zakharin     mlir::Type varTy = getConverter().genType(toEvExpr(var));
17279a7b363eSSlava Zakharin     value = getBuilder().createConvert(getLoc(), varTy, value);
1728ffde9f17SJean Perier     return hlfir::EntityWithAttributes{value};
1729c14ef2d7SJean Perier   }
1730c14ef2d7SJean Perier 
17311ca458f7SSlava Zakharin   static bool
17321ca458f7SSlava Zakharin   isDerivedTypeWithLenParameters(const Fortran::semantics::Symbol &sym) {
17331ca458f7SSlava Zakharin     if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType())
17341ca458f7SSlava Zakharin       if (const Fortran::semantics::DerivedTypeSpec *derived =
17351ca458f7SSlava Zakharin               declTy->AsDerived())
17361ca458f7SSlava Zakharin         return Fortran::semantics::CountLenParameters(*derived) > 0;
17371ca458f7SSlava Zakharin     return false;
17381ca458f7SSlava Zakharin   }
17391ca458f7SSlava Zakharin 
17401ca458f7SSlava Zakharin   // Construct an entity holding the value specified by the
17411ca458f7SSlava Zakharin   // StructureConstructor. The initialization of the temporary entity
17421ca458f7SSlava Zakharin   // is done component by component with the help of HLFIR operations
1743e45f6e93SjeanPerier   // DesignateOp and AssignOp.
1744fcfb620dSJean Perier   hlfir::EntityWithAttributes
17451ca458f7SSlava Zakharin   gen(const Fortran::evaluate::StructureConstructor &ctor) {
17461ca458f7SSlava Zakharin     mlir::Location loc = getLoc();
17471ca458f7SSlava Zakharin     fir::FirOpBuilder &builder = getBuilder();
17481ca458f7SSlava Zakharin     mlir::Type ty = translateSomeExprToFIRType(converter, toEvExpr(ctor));
1749fac349a1SChristian Sigg     auto recTy = mlir::cast<fir::RecordType>(ty);
17501ca458f7SSlava Zakharin 
17511ca458f7SSlava Zakharin     if (recTy.isDependentType())
17521ca458f7SSlava Zakharin       TODO(loc, "structure constructor for derived type with length parameters "
17531ca458f7SSlava Zakharin                 "in HLFIR");
17541ca458f7SSlava Zakharin 
17551ca458f7SSlava Zakharin     // Allocate scalar temporary that will be initialized
17561ca458f7SSlava Zakharin     // with the values specified by the constructor.
17571ca458f7SSlava Zakharin     mlir::Value storagePtr = builder.createTemporary(loc, recTy);
17581ca458f7SSlava Zakharin     auto varOp = hlfir::EntityWithAttributes{builder.create<hlfir::DeclareOp>(
17591ca458f7SSlava Zakharin         loc, storagePtr, "ctor.temp", /*shape=*/nullptr,
17601710c8cfSSlava Zakharin         /*typeparams=*/mlir::ValueRange{}, /*dummy_scope=*/nullptr,
17611710c8cfSSlava Zakharin         fir::FortranVariableFlagsAttr{})};
17621ca458f7SSlava Zakharin 
17631ca458f7SSlava Zakharin     // Initialize any components that need initialization.
17641ca458f7SSlava Zakharin     mlir::Value box = builder.createBox(loc, fir::ExtendedValue{varOp});
17651ca458f7SSlava Zakharin     fir::runtime::genDerivedTypeInitialize(builder, loc, box);
17661ca458f7SSlava Zakharin 
1767e45f6e93SjeanPerier     // StructureConstructor values may relate to name of components in parent
1768e45f6e93SjeanPerier     // types. These components cannot be addressed directly, the parent
1769e45f6e93SjeanPerier     // components must be addressed first. The loop below creates all the
1770e45f6e93SjeanPerier     // required chains of hlfir.designate to address the parent components so
1771e45f6e93SjeanPerier     // that the StructureConstructor can later be lowered by addressing these
1772e45f6e93SjeanPerier     // parent components if needed. Note: the front-end orders the components in
17732d57333dSPeter Klausler     // structure constructors.
1774e45f6e93SjeanPerier     using ValueAndParent = std::tuple<const Fortran::lower::SomeExpr &,
1775e45f6e93SjeanPerier                                       const Fortran::semantics::Symbol &,
1776e45f6e93SjeanPerier                                       hlfir::EntityWithAttributes>;
1777e45f6e93SjeanPerier     llvm::SmallVector<ValueAndParent> valuesAndParents;
1778e45f6e93SjeanPerier     for (const auto &value : llvm::reverse(ctor.values())) {
1779e45f6e93SjeanPerier       const Fortran::semantics::Symbol &compSym = *value.first;
17802d57333dSPeter Klausler       hlfir::EntityWithAttributes currentParent = varOp;
17812d57333dSPeter Klausler       for (Fortran::lower::ComponentReverseIterator compIterator(
17822d57333dSPeter Klausler                ctor.result().derivedTypeSpec());
17832d57333dSPeter Klausler            !compIterator.lookup(compSym.name());) {
1784e45f6e93SjeanPerier         const auto &parentType = compIterator.advanceToParentType();
1785e45f6e93SjeanPerier         llvm::StringRef parentName = toStringRef(parentType.name());
1786e45f6e93SjeanPerier         auto baseRecTy = mlir::cast<fir::RecordType>(
1787e45f6e93SjeanPerier             hlfir::getFortranElementType(currentParent.getType()));
1788e45f6e93SjeanPerier         auto parentCompType = baseRecTy.getType(parentName);
1789e45f6e93SjeanPerier         assert(parentCompType && "failed to retrieve parent component type");
1790e45f6e93SjeanPerier         mlir::Type designatorType = builder.getRefType(parentCompType);
1791e45f6e93SjeanPerier         mlir::Value newParent = builder.create<hlfir::DesignateOp>(
1792e45f6e93SjeanPerier             loc, designatorType, currentParent, parentName,
1793e45f6e93SjeanPerier             /*compShape=*/mlir::Value{}, hlfir::DesignateOp::Subscripts{},
1794e45f6e93SjeanPerier             /*substring=*/mlir::ValueRange{},
1795e45f6e93SjeanPerier             /*complexPart=*/std::nullopt,
1796e45f6e93SjeanPerier             /*shape=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{},
1797e45f6e93SjeanPerier             fir::FortranVariableFlagsAttr{});
1798e45f6e93SjeanPerier         currentParent = hlfir::EntityWithAttributes{newParent};
17991ca458f7SSlava Zakharin       }
1800e45f6e93SjeanPerier       valuesAndParents.emplace_back(
1801e45f6e93SjeanPerier           ValueAndParent{value.second.value(), compSym, currentParent});
1802e45f6e93SjeanPerier     }
1803e45f6e93SjeanPerier 
1804e45f6e93SjeanPerier     HlfirDesignatorBuilder designatorBuilder(loc, converter, symMap, stmtCtx);
1805e45f6e93SjeanPerier     for (const auto &iter : llvm::reverse(valuesAndParents)) {
1806e45f6e93SjeanPerier       auto &sym = std::get<const Fortran::semantics::Symbol &>(iter);
1807e45f6e93SjeanPerier       auto &expr = std::get<const Fortran::lower::SomeExpr &>(iter);
1808e45f6e93SjeanPerier       auto &baseOp = std::get<hlfir::EntityWithAttributes>(iter);
1809e45f6e93SjeanPerier       std::string name = converter.getRecordTypeFieldName(sym);
18101ca458f7SSlava Zakharin 
18111ca458f7SSlava Zakharin       // Generate DesignateOp for the component.
18121ca458f7SSlava Zakharin       // The designator's result type is just a reference to the component type,
18131ca458f7SSlava Zakharin       // because the whole component is being designated.
1814e45f6e93SjeanPerier       auto baseRecTy = mlir::cast<fir::RecordType>(
1815e45f6e93SjeanPerier           hlfir::getFortranElementType(baseOp.getType()));
1816e45f6e93SjeanPerier       auto compType = baseRecTy.getType(name);
1817e45f6e93SjeanPerier       assert(compType && "failed to retrieve component type");
18181ca458f7SSlava Zakharin       mlir::Value compShape =
18191ca458f7SSlava Zakharin           designatorBuilder.genComponentShape(sym, compType);
18201ca458f7SSlava Zakharin       mlir::Type designatorType = builder.getRefType(compType);
18211ca458f7SSlava Zakharin 
18221ca458f7SSlava Zakharin       mlir::Type fieldElemType = hlfir::getFortranElementType(compType);
18231ca458f7SSlava Zakharin       llvm::SmallVector<mlir::Value, 1> typeParams;
18241ca458f7SSlava Zakharin       if (auto charType = mlir::dyn_cast<fir::CharacterType>(fieldElemType)) {
18251ca458f7SSlava Zakharin         if (charType.hasConstantLen()) {
18261ca458f7SSlava Zakharin           mlir::Type idxType = builder.getIndexType();
18271ca458f7SSlava Zakharin           typeParams.push_back(
18281ca458f7SSlava Zakharin               builder.createIntegerConstant(loc, idxType, charType.getLen()));
18298252137bSjeanPerier         } else if (!hasDeferredCharacterLength(sym)) {
18308252137bSjeanPerier           // If the length is not deferred, this is a parametrized derived type
18318252137bSjeanPerier           // where the character length depends on the derived type length
18328252137bSjeanPerier           // parameters. Otherwise, this is a pointer/allocatable component and
18338252137bSjeanPerier           // the length will be set during the assignment.
18348252137bSjeanPerier           TODO(loc, "automatic character component in structure constructor");
18351ca458f7SSlava Zakharin         }
18361ca458f7SSlava Zakharin       }
18371ca458f7SSlava Zakharin 
18381ca458f7SSlava Zakharin       // Convert component symbol attributes to variable attributes.
18391ca458f7SSlava Zakharin       fir::FortranVariableFlagsAttr attrs =
18401ca458f7SSlava Zakharin           Fortran::lower::translateSymbolAttributes(builder.getContext(), sym);
18411ca458f7SSlava Zakharin 
18421ca458f7SSlava Zakharin       // Get the component designator.
18431ca458f7SSlava Zakharin       auto lhs = builder.create<hlfir::DesignateOp>(
1844e45f6e93SjeanPerier           loc, designatorType, baseOp, name, compShape,
18451ca458f7SSlava Zakharin           hlfir::DesignateOp::Subscripts{},
18461ca458f7SSlava Zakharin           /*substring=*/mlir::ValueRange{},
18471ca458f7SSlava Zakharin           /*complexPart=*/std::nullopt,
18481ca458f7SSlava Zakharin           /*shape=*/compShape, typeParams, attrs);
18491ca458f7SSlava Zakharin 
18501ca458f7SSlava Zakharin       if (attrs && bitEnumContainsAny(attrs.getFlags(),
18511ca458f7SSlava Zakharin                                       fir::FortranVariableFlagsEnum::pointer)) {
18524998587eSDaniel Chen         if (Fortran::semantics::IsProcedure(sym)) {
18534998587eSDaniel Chen           // Procedure pointer components.
18544998587eSDaniel Chen           if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
18554998587eSDaniel Chen                   expr)) {
18564998587eSDaniel Chen             auto boxTy{
18574998587eSDaniel Chen                 Fortran::lower::getUntypedBoxProcType(builder.getContext())};
18584998587eSDaniel Chen             hlfir::Entity rhs(
18594998587eSDaniel Chen                 fir::factory::createNullBoxProc(builder, loc, boxTy));
18604998587eSDaniel Chen             builder.createStoreWithConvert(loc, rhs, lhs);
18614998587eSDaniel Chen             continue;
18624998587eSDaniel Chen           }
18634998587eSDaniel Chen           hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress(
18644998587eSDaniel Chen               loc, converter, expr, symMap, stmtCtx)));
18654998587eSDaniel Chen           builder.createStoreWithConvert(loc, rhs, lhs);
18664998587eSDaniel Chen           continue;
18674998587eSDaniel Chen         }
18681ca458f7SSlava Zakharin         // Pointer component construction is just a copy of the box contents.
18691ca458f7SSlava Zakharin         fir::ExtendedValue lhsExv =
18701ca458f7SSlava Zakharin             hlfir::translateToExtendedValue(loc, builder, lhs);
18711ca458f7SSlava Zakharin         auto *toBox = lhsExv.getBoxOf<fir::MutableBoxValue>();
18721ca458f7SSlava Zakharin         if (!toBox)
18731ca458f7SSlava Zakharin           fir::emitFatalError(loc, "pointer component designator could not be "
18741ca458f7SSlava Zakharin                                    "lowered to mutable box");
18751ca458f7SSlava Zakharin         Fortran::lower::associateMutableBox(converter, loc, *toBox, expr,
18761ca458f7SSlava Zakharin                                             /*lbounds=*/std::nullopt, stmtCtx);
18771ca458f7SSlava Zakharin         continue;
18781ca458f7SSlava Zakharin       }
18791ca458f7SSlava Zakharin 
18801ca458f7SSlava Zakharin       // Use generic assignment for all the other cases.
18811ca458f7SSlava Zakharin       bool allowRealloc =
18821ca458f7SSlava Zakharin           attrs &&
18831ca458f7SSlava Zakharin           bitEnumContainsAny(attrs.getFlags(),
18841ca458f7SSlava Zakharin                              fir::FortranVariableFlagsEnum::allocatable);
18853a4e9f7aSSlava Zakharin       // If the component is allocatable, then we have to check
18863a4e9f7aSSlava Zakharin       // whether the RHS value is allocatable or not.
18873a4e9f7aSSlava Zakharin       // If it is not allocatable, then AssignOp can be used directly.
18883a4e9f7aSSlava Zakharin       // If it is allocatable, then using AssignOp for unallocated RHS
18893a4e9f7aSSlava Zakharin       // will cause illegal dereference. When an unallocated allocatable
18903a4e9f7aSSlava Zakharin       // value is used to construct an allocatable component, the component
18917046202cSjeanPerier       // must just stay unallocated (see Fortran 2018 7.5.10 point 7).
189207593a39SSlava Zakharin 
189307593a39SSlava Zakharin       // If the component is allocatable and RHS is NULL() expression, then
189407593a39SSlava Zakharin       // we can just skip it: the LHS must remain unallocated with its
189507593a39SSlava Zakharin       // defined rank.
189607593a39SSlava Zakharin       if (allowRealloc &&
189707593a39SSlava Zakharin           Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr))
189807593a39SSlava Zakharin         continue;
189907593a39SSlava Zakharin 
19007046202cSjeanPerier       bool keepLhsLength = false;
19017046202cSjeanPerier       if (allowRealloc)
19027046202cSjeanPerier         if (const Fortran::semantics::DeclTypeSpec *declType = sym.GetType())
19037046202cSjeanPerier           keepLhsLength =
19047046202cSjeanPerier               declType->category() ==
19057046202cSjeanPerier                   Fortran::semantics::DeclTypeSpec::Category::Character &&
19067046202cSjeanPerier               !declType->characterTypeSpec().length().isDeferred();
19071fa4a0a0SSlava Zakharin       // Handle special case when the initializer expression is
19081fa4a0a0SSlava Zakharin       // '{%SET_LENGTH(x,const_kind)}'. In structure constructor,
19097046202cSjeanPerier       // SET_LENGTH is used for initializers of non-allocatable character
19107046202cSjeanPerier       // components so that the front-end can better
19117046202cSjeanPerier       // fold and work with these structure constructors.
19127046202cSjeanPerier       // Here, they are just noise since the assignment semantics will deal
19137046202cSjeanPerier       // with any length mismatch, and creating an extra temp with the lhs
19147046202cSjeanPerier       // length is useless.
19157046202cSjeanPerier       // TODO: should this be moved into an hlfir.assign + hlfir.set_length
19167046202cSjeanPerier       // pattern rewrite?
19177046202cSjeanPerier       hlfir::Entity rhs = gen(expr);
19187046202cSjeanPerier       if (auto set_length = rhs.getDefiningOp<hlfir::SetLengthOp>())
19197046202cSjeanPerier         rhs = hlfir::Entity{set_length.getString()};
19201fa4a0a0SSlava Zakharin 
19217046202cSjeanPerier       // lambda to generate `lhs = rhs` and deal with potential rhs implicit
19227046202cSjeanPerier       // cast
19237046202cSjeanPerier       auto genAssign = [&] {
19243a4e9f7aSSlava Zakharin         rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
19257046202cSjeanPerier         auto rhsCastAndCleanup =
19267046202cSjeanPerier             hlfir::genTypeAndKindConvert(loc, builder, rhs, lhs.getType(),
19277046202cSjeanPerier                                          /*preserveLowerBounds=*/allowRealloc);
19287046202cSjeanPerier         builder.create<hlfir::AssignOp>(loc, rhsCastAndCleanup.first, lhs,
19297046202cSjeanPerier                                         allowRealloc,
19301fa4a0a0SSlava Zakharin                                         allowRealloc ? keepLhsLength : false,
1931ebd0b8a0SSlava Zakharin                                         /*temporary_lhs=*/true);
19327046202cSjeanPerier         if (rhsCastAndCleanup.second)
19337046202cSjeanPerier           (*rhsCastAndCleanup.second)();
19347046202cSjeanPerier       };
19357046202cSjeanPerier 
19367046202cSjeanPerier       if (!allowRealloc || !rhs.isMutableBox()) {
19377046202cSjeanPerier         genAssign();
19383a4e9f7aSSlava Zakharin         continue;
19393a4e9f7aSSlava Zakharin       }
19403a4e9f7aSSlava Zakharin 
19413a4e9f7aSSlava Zakharin       auto [rhsExv, cleanup] =
19423a4e9f7aSSlava Zakharin           hlfir::translateToExtendedValue(loc, builder, rhs);
19433a4e9f7aSSlava Zakharin       assert(!cleanup && "unexpected cleanup");
19443a4e9f7aSSlava Zakharin       auto *fromBox = rhsExv.getBoxOf<fir::MutableBoxValue>();
19453a4e9f7aSSlava Zakharin       if (!fromBox)
19463a4e9f7aSSlava Zakharin         fir::emitFatalError(loc, "allocatable entity could not be lowered "
19473a4e9f7aSSlava Zakharin                                  "to mutable box");
19483a4e9f7aSSlava Zakharin       mlir::Value isAlloc =
19493a4e9f7aSSlava Zakharin           fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *fromBox);
19507046202cSjeanPerier       builder.genIfThen(loc, isAlloc).genThen(genAssign).end();
19511ca458f7SSlava Zakharin     }
19521ca458f7SSlava Zakharin 
195374dfded4SjeanPerier     if (fir::isRecordWithAllocatableMember(recTy)) {
195474dfded4SjeanPerier       // Deallocate allocatable components without calling final subroutines.
195574dfded4SjeanPerier       // The Fortran 2018 section 9.7.3.2 about deallocation is not ruling
195674dfded4SjeanPerier       // about the fate of allocatable components of structure constructors,
195774dfded4SjeanPerier       // and there is no behavior consensus in other compilers.
195874dfded4SjeanPerier       fir::FirOpBuilder *bldr = &builder;
195974dfded4SjeanPerier       getStmtCtx().attachCleanup([=]() {
196074dfded4SjeanPerier         fir::runtime::genDerivedTypeDestroyWithoutFinalization(*bldr, loc, box);
196174dfded4SjeanPerier       });
196274dfded4SjeanPerier     }
19631ca458f7SSlava Zakharin     return varOp;
1964c14ef2d7SJean Perier   }
1965c14ef2d7SJean Perier 
1966c14ef2d7SJean Perier   mlir::Location getLoc() const { return loc; }
1967c14ef2d7SJean Perier   Fortran::lower::AbstractConverter &getConverter() { return converter; }
1968c14ef2d7SJean Perier   fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); }
1969c14ef2d7SJean Perier   Fortran::lower::SymMap &getSymMap() { return symMap; }
1970c14ef2d7SJean Perier   Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; }
1971c14ef2d7SJean Perier 
1972c14ef2d7SJean Perier   Fortran::lower::AbstractConverter &converter;
1973c14ef2d7SJean Perier   Fortran::lower::SymMap &symMap;
1974c14ef2d7SJean Perier   Fortran::lower::StatementContext &stmtCtx;
1975c14ef2d7SJean Perier   mlir::Location loc;
1976c14ef2d7SJean Perier };
1977c14ef2d7SJean Perier 
197807b89273SJean Perier template <typename T>
1979583d492cSJean Perier hlfir::Entity
198007b89273SJean Perier HlfirDesignatorBuilder::genSubscript(const Fortran::evaluate::Expr<T> &expr) {
1981b91a25efSYusuke MINATO   fir::FirOpBuilder &builder = getBuilder();
1982b91a25efSYusuke MINATO   mlir::arith::IntegerOverflowFlags iofBackup{};
1983b91a25efSYusuke MINATO   if (!getConverter().getLoweringOptions().getIntegerWrapAround()) {
1984b91a25efSYusuke MINATO     iofBackup = builder.getIntegerOverflowFlags();
1985b91a25efSYusuke MINATO     builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::nsw);
1986b91a25efSYusuke MINATO   }
198707b89273SJean Perier   auto loweredExpr =
198807b89273SJean Perier       HlfirBuilder(getLoc(), getConverter(), getSymMap(), getStmtCtx())
198907b89273SJean Perier           .gen(expr);
1990b91a25efSYusuke MINATO   if (!getConverter().getLoweringOptions().getIntegerWrapAround())
1991b91a25efSYusuke MINATO     builder.setIntegerOverflowFlags(iofBackup);
199207b89273SJean Perier   // Skip constant conversions that litters designators and makes generated
199307b89273SJean Perier   // IR harder to read: directly use index constants for constant subscripts.
199407b89273SJean Perier   mlir::Type idxTy = builder.getIndexType();
1995583d492cSJean Perier   if (!loweredExpr.isArray() && loweredExpr.getType() != idxTy)
1996a1fae71fSJean Perier     if (auto cstIndex = fir::getIntIfConstant(loweredExpr))
199707b89273SJean Perier       return hlfir::EntityWithAttributes{
199807b89273SJean Perier           builder.createIntegerConstant(getLoc(), idxTy, *cstIndex)};
1999583d492cSJean Perier   return hlfir::loadTrivialScalar(loc, builder, loweredExpr);
200007b89273SJean Perier }
200107b89273SJean Perier 
2002c14ef2d7SJean Perier } // namespace
2003c14ef2d7SJean Perier 
2004fcfb620dSJean Perier hlfir::EntityWithAttributes Fortran::lower::convertExprToHLFIR(
2005c14ef2d7SJean Perier     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2006c14ef2d7SJean Perier     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2007c14ef2d7SJean Perier     Fortran::lower::StatementContext &stmtCtx) {
2008c14ef2d7SJean Perier   return HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2009c14ef2d7SJean Perier }
20104e78f885SJean Perier 
2011cedfd272SJean Perier fir::ExtendedValue Fortran::lower::convertToBox(
2012199e4974SJean Perier     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2013ff2912a0SJean Perier     hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx,
2014ff2912a0SJean Perier     mlir::Type fortranType) {
201561c5c597STom Eccles   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
201661c5c597STom Eccles   auto [exv, cleanup] = hlfir::convertToBox(loc, builder, entity, fortranType);
201761c5c597STom Eccles   if (cleanup)
201861c5c597STom Eccles     stmtCtx.attachCleanup(*cleanup);
201961c5c597STom Eccles   return exv;
2020199e4974SJean Perier }
2021cedfd272SJean Perier 
2022cedfd272SJean Perier fir::ExtendedValue Fortran::lower::convertExprToBox(
20234e78f885SJean Perier     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
20244e78f885SJean Perier     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
20254e78f885SJean Perier     Fortran::lower::StatementContext &stmtCtx) {
20264e78f885SJean Perier   hlfir::EntityWithAttributes loweredExpr =
20274e78f885SJean Perier       HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2028ff2912a0SJean Perier   return convertToBox(loc, converter, loweredExpr, stmtCtx,
2029ff2912a0SJean Perier                       converter.genType(expr));
20304e78f885SJean Perier }
20314e78f885SJean Perier 
20327531c871SJean Perier fir::ExtendedValue Fortran::lower::convertToAddress(
20337531c871SJean Perier     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2034ff2912a0SJean Perier     hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx,
2035ff2912a0SJean Perier     mlir::Type fortranType) {
20367531c871SJean Perier   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
203761c5c597STom Eccles   auto [exv, cleanup] =
203861c5c597STom Eccles       hlfir::convertToAddress(loc, builder, entity, fortranType);
203961c5c597STom Eccles   if (cleanup)
204061c5c597STom Eccles     stmtCtx.attachCleanup(*cleanup);
20414e78f885SJean Perier   return exv;
20424e78f885SJean Perier }
2043ff2912a0SJean Perier 
2044199e4974SJean Perier fir::ExtendedValue Fortran::lower::convertExprToAddress(
2045199e4974SJean Perier     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2046199e4974SJean Perier     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2047199e4974SJean Perier     Fortran::lower::StatementContext &stmtCtx) {
2048199e4974SJean Perier   hlfir::EntityWithAttributes loweredExpr =
2049199e4974SJean Perier       HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2050ff2912a0SJean Perier   return convertToAddress(loc, converter, loweredExpr, stmtCtx,
2051ff2912a0SJean Perier                           converter.genType(expr));
2052199e4974SJean Perier }
2053199e4974SJean Perier 
2054199e4974SJean Perier fir::ExtendedValue Fortran::lower::convertToValue(
2055199e4974SJean Perier     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2056199e4974SJean Perier     hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx) {
2057199e4974SJean Perier   auto &builder = converter.getFirOpBuilder();
205861c5c597STom Eccles   auto [exv, cleanup] = hlfir::convertToValue(loc, builder, entity);
205961c5c597STom Eccles   if (cleanup)
206061c5c597STom Eccles     stmtCtx.attachCleanup(*cleanup);
206161c5c597STom Eccles   return exv;
2062199e4974SJean Perier }
2063199e4974SJean Perier 
2064199e4974SJean Perier fir::ExtendedValue Fortran::lower::convertExprToValue(
2065199e4974SJean Perier     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2066199e4974SJean Perier     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2067199e4974SJean Perier     Fortran::lower::StatementContext &stmtCtx) {
2068199e4974SJean Perier   hlfir::EntityWithAttributes loweredExpr =
2069199e4974SJean Perier       HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2070199e4974SJean Perier   return convertToValue(loc, converter, loweredExpr, stmtCtx);
2071199e4974SJean Perier }
20727531c871SJean Perier 
207367f9b5aeSValentin Clement (バレンタイン クレメン) fir::ExtendedValue Fortran::lower::convertDataRefToValue(
207467f9b5aeSValentin Clement (バレンタイン クレメン)     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
207567f9b5aeSValentin Clement (バレンタイン クレメン)     const Fortran::evaluate::DataRef &dataRef, Fortran::lower::SymMap &symMap,
207667f9b5aeSValentin Clement (バレンタイン クレメン)     Fortran::lower::StatementContext &stmtCtx) {
207767f9b5aeSValentin Clement (バレンタイン クレメン)   fir::FortranVariableOpInterface loweredExpr =
207867f9b5aeSValentin Clement (バレンタイン クレメン)       HlfirDesignatorBuilder(loc, converter, symMap, stmtCtx).gen(dataRef);
207967f9b5aeSValentin Clement (バレンタイン クレメン)   return convertToValue(loc, converter, loweredExpr, stmtCtx);
208067f9b5aeSValentin Clement (バレンタイン クレメン) }
208167f9b5aeSValentin Clement (バレンタイン クレメン) 
20827531c871SJean Perier fir::MutableBoxValue Fortran::lower::convertExprToMutableBox(
20837531c871SJean Perier     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
20847531c871SJean Perier     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
20857531c871SJean Perier   // Pointers and Allocatable cannot be temporary expressions. Temporaries may
20867531c871SJean Perier   // be created while lowering it (e.g. if any indices expression of a
20877531c871SJean Perier   // designator create temporaries), but they can be destroyed before using the
20887531c871SJean Perier   // lowered pointer or allocatable;
20897531c871SJean Perier   Fortran::lower::StatementContext localStmtCtx;
20907531c871SJean Perier   hlfir::EntityWithAttributes loweredExpr =
20917531c871SJean Perier       HlfirBuilder(loc, converter, symMap, localStmtCtx).gen(expr);
20927531c871SJean Perier   fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
20937531c871SJean Perier       loc, converter.getFirOpBuilder(), loweredExpr, localStmtCtx);
20947531c871SJean Perier   auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>();
20957531c871SJean Perier   assert(mutableBox && "expression could not be lowered to mutable box");
20967531c871SJean Perier   return *mutableBox;
20977531c871SJean Perier }
2098c7ff45a5SJean Perier 
2099c7ff45a5SJean Perier hlfir::ElementalAddrOp
2100c7ff45a5SJean Perier Fortran::lower::convertVectorSubscriptedExprToElementalAddr(
2101c7ff45a5SJean Perier     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2102c7ff45a5SJean Perier     const Fortran::lower::SomeExpr &designatorExpr,
2103c7ff45a5SJean Perier     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
2104c7ff45a5SJean Perier   return HlfirDesignatorBuilder(loc, converter, symMap, stmtCtx)
2105c7ff45a5SJean Perier       .convertVectorSubscriptedExprToElementalAddr(designatorExpr);
2106c7ff45a5SJean Perier }
2107