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