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

source code of flang/lib/Lower/ConvertExprToHLFIR.cpp