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=*/std::nullopt);
1069 return hlfir::EntityWithAttributes{
1070 fir::genDivC(builder, loc, ty, lhs, rhs)};
1071 }
1072};
1073
1074template <Fortran::common::TypeCategory TC, int KIND>
1075struct BinaryOp<Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>> {
1076 using Op = Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>;
1077 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1078 fir::FirOpBuilder &builder, const Op &,
1079 hlfir::Entity lhs, hlfir::Entity rhs) {
1080 mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
1081 /*params=*/std::nullopt);
1082 return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
1083 }
1084};
1085
1086template <Fortran::common::TypeCategory TC, int KIND>
1087struct BinaryOp<
1088 Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>> {
1089 using Op =
1090 Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>;
1091 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1092 fir::FirOpBuilder &builder, const Op &,
1093 hlfir::Entity lhs, hlfir::Entity rhs) {
1094 mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
1095 /*params=*/std::nullopt);
1096 return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
1097 }
1098};
1099
1100template <Fortran::common::TypeCategory TC, int KIND>
1101struct BinaryOp<
1102 Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>> {
1103 using Op = Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>;
1104 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1105 fir::FirOpBuilder &builder,
1106 const Op &op, hlfir::Entity lhs,
1107 hlfir::Entity rhs) {
1108 llvm::SmallVector<mlir::Value, 2> args{lhs, rhs};
1109 fir::ExtendedValue res = op.ordering == Fortran::evaluate::Ordering::Greater
1110 ? fir::genMax(builder, loc, args)
1111 : fir::genMin(builder, loc, args);
1112 return hlfir::EntityWithAttributes{fir::getBase(res)};
1113 }
1114};
1115
1116// evaluate::Extremum is only created by the front-end when building compiler
1117// generated expressions (like when folding LEN() or shape/bounds inquiries).
1118// MIN and MAX are represented as evaluate::ProcedureRef and are not going
1119// through here. So far the frontend does not generate character Extremum so
1120// there is no way to test it.
1121template <int KIND>
1122struct BinaryOp<Fortran::evaluate::Extremum<
1123 Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> {
1124 using Op = Fortran::evaluate::Extremum<
1125 Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>;
1126 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1127 fir::FirOpBuilder &, const Op &,
1128 hlfir::Entity, hlfir::Entity) {
1129 fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected");
1130 }
1131 static void genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &,
1132 hlfir::Entity, hlfir::Entity,
1133 llvm::SmallVectorImpl<mlir::Value> &) {
1134 fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected");
1135 }
1136};
1137
1138/// Convert parser's INTEGER relational operators to MLIR.
1139static mlir::arith::CmpIPredicate
1140translateSignedRelational(Fortran::common::RelationalOperator rop) {
1141 switch (rop) {
1142 case Fortran::common::RelationalOperator::LT:
1143 return mlir::arith::CmpIPredicate::slt;
1144 case Fortran::common::RelationalOperator::LE:
1145 return mlir::arith::CmpIPredicate::sle;
1146 case Fortran::common::RelationalOperator::EQ:
1147 return mlir::arith::CmpIPredicate::eq;
1148 case Fortran::common::RelationalOperator::NE:
1149 return mlir::arith::CmpIPredicate::ne;
1150 case Fortran::common::RelationalOperator::GT:
1151 return mlir::arith::CmpIPredicate::sgt;
1152 case Fortran::common::RelationalOperator::GE:
1153 return mlir::arith::CmpIPredicate::sge;
1154 }
1155 llvm_unreachable("unhandled INTEGER relational operator");
1156}
1157
1158static mlir::arith::CmpIPredicate
1159translateUnsignedRelational(Fortran::common::RelationalOperator rop) {
1160 switch (rop) {
1161 case Fortran::common::RelationalOperator::LT:
1162 return mlir::arith::CmpIPredicate::ult;
1163 case Fortran::common::RelationalOperator::LE:
1164 return mlir::arith::CmpIPredicate::ule;
1165 case Fortran::common::RelationalOperator::EQ:
1166 return mlir::arith::CmpIPredicate::eq;
1167 case Fortran::common::RelationalOperator::NE:
1168 return mlir::arith::CmpIPredicate::ne;
1169 case Fortran::common::RelationalOperator::GT:
1170 return mlir::arith::CmpIPredicate::ugt;
1171 case Fortran::common::RelationalOperator::GE:
1172 return mlir::arith::CmpIPredicate::uge;
1173 }
1174 llvm_unreachable("unhandled UNSIGNED relational operator");
1175}
1176
1177/// Convert parser's REAL relational operators to MLIR.
1178/// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018
1179/// requirements in the IEEE context (table 17.1 of F2018). This choice is
1180/// also applied in other contexts because it is easier and in line with
1181/// other Fortran compilers.
1182/// FIXME: The signaling/quiet aspect of the table 17.1 requirement is not
1183/// fully enforced. FIR and LLVM `fcmp` instructions do not give any guarantee
1184/// whether the comparison will signal or not in case of quiet NaN argument.
1185static mlir::arith::CmpFPredicate
1186translateFloatRelational(Fortran::common::RelationalOperator rop) {
1187 switch (rop) {
1188 case Fortran::common::RelationalOperator::LT:
1189 return mlir::arith::CmpFPredicate::OLT;
1190 case Fortran::common::RelationalOperator::LE:
1191 return mlir::arith::CmpFPredicate::OLE;
1192 case Fortran::common::RelationalOperator::EQ:
1193 return mlir::arith::CmpFPredicate::OEQ;
1194 case Fortran::common::RelationalOperator::NE:
1195 return mlir::arith::CmpFPredicate::UNE;
1196 case Fortran::common::RelationalOperator::GT:
1197 return mlir::arith::CmpFPredicate::OGT;
1198 case Fortran::common::RelationalOperator::GE:
1199 return mlir::arith::CmpFPredicate::OGE;
1200 }
1201 llvm_unreachable("unhandled REAL relational operator");
1202}
1203
1204template <int KIND>
1205struct BinaryOp<Fortran::evaluate::Relational<
1206 Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> {
1207 using Op = Fortran::evaluate::Relational<
1208 Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>;
1209 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1210 fir::FirOpBuilder &builder,
1211 const Op &op, hlfir::Entity lhs,
1212 hlfir::Entity rhs) {
1213 auto cmp = builder.create<mlir::arith::CmpIOp>(
1214 loc, translateSignedRelational(op.opr), lhs, rhs);
1215 return hlfir::EntityWithAttributes{cmp};
1216 }
1217};
1218
1219template <int KIND>
1220struct BinaryOp<Fortran::evaluate::Relational<
1221 Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
1222 using Op = Fortran::evaluate::Relational<
1223 Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
1224 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1225 fir::FirOpBuilder &builder,
1226 const Op &op, hlfir::Entity lhs,
1227 hlfir::Entity rhs) {
1228 int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
1229 KIND>::Scalar::bits;
1230 auto signlessType = mlir::IntegerType::get(
1231 builder.getContext(), bits,
1232 mlir::IntegerType::SignednessSemantics::Signless);
1233 mlir::Value lhsSL = builder.createConvert(loc, signlessType, lhs);
1234 mlir::Value rhsSL = builder.createConvert(loc, signlessType, rhs);
1235 auto cmp = builder.create<mlir::arith::CmpIOp>(
1236 loc, translateUnsignedRelational(op.opr), lhsSL, rhsSL);
1237 return hlfir::EntityWithAttributes{cmp};
1238 }
1239};
1240
1241template <int KIND>
1242struct BinaryOp<Fortran::evaluate::Relational<
1243 Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
1244 using Op = Fortran::evaluate::Relational<
1245 Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>;
1246 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1247 fir::FirOpBuilder &builder,
1248 const Op &op, hlfir::Entity lhs,
1249 hlfir::Entity rhs) {
1250 auto cmp = builder.create<mlir::arith::CmpFOp>(
1251 loc, translateFloatRelational(op.opr), lhs, rhs);
1252 return hlfir::EntityWithAttributes{cmp};
1253 }
1254};
1255
1256template <int KIND>
1257struct BinaryOp<Fortran::evaluate::Relational<
1258 Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
1259 using Op = Fortran::evaluate::Relational<
1260 Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
1261 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1262 fir::FirOpBuilder &builder,
1263 const Op &op, hlfir::Entity lhs,
1264 hlfir::Entity rhs) {
1265 auto cmp = builder.create<fir::CmpcOp>(
1266 loc, translateFloatRelational(op.opr), lhs, rhs);
1267 return hlfir::EntityWithAttributes{cmp};
1268 }
1269};
1270
1271template <int KIND>
1272struct BinaryOp<Fortran::evaluate::Relational<
1273 Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> {
1274 using Op = Fortran::evaluate::Relational<
1275 Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>;
1276 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1277 fir::FirOpBuilder &builder,
1278 const Op &op, hlfir::Entity lhs,
1279 hlfir::Entity rhs) {
1280 auto [lhsExv, lhsCleanUp] =
1281 hlfir::translateToExtendedValue(loc, builder, lhs);
1282 auto [rhsExv, rhsCleanUp] =
1283 hlfir::translateToExtendedValue(loc, builder, rhs);
1284 auto cmp = fir::runtime::genCharCompare(
1285 builder, loc, translateSignedRelational(op.opr), lhsExv, rhsExv);
1286 if (lhsCleanUp)
1287 (*lhsCleanUp)();
1288 if (rhsCleanUp)
1289 (*rhsCleanUp)();
1290 return hlfir::EntityWithAttributes{cmp};
1291 }
1292};
1293
1294template <int KIND>
1295struct BinaryOp<Fortran::evaluate::LogicalOperation<KIND>> {
1296 using Op = Fortran::evaluate::LogicalOperation<KIND>;
1297 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1298 fir::FirOpBuilder &builder,
1299 const Op &op, hlfir::Entity lhs,
1300 hlfir::Entity rhs) {
1301 mlir::Type i1Type = builder.getI1Type();
1302 mlir::Value i1Lhs = builder.createConvert(loc, i1Type, lhs);
1303 mlir::Value i1Rhs = builder.createConvert(loc, i1Type, rhs);
1304 switch (op.logicalOperator) {
1305 case Fortran::evaluate::LogicalOperator::And:
1306 return hlfir::EntityWithAttributes{
1307 builder.create<mlir::arith::AndIOp>(loc, i1Lhs, i1Rhs)};
1308 case Fortran::evaluate::LogicalOperator::Or:
1309 return hlfir::EntityWithAttributes{
1310 builder.create<mlir::arith::OrIOp>(loc, i1Lhs, i1Rhs)};
1311 case Fortran::evaluate::LogicalOperator::Eqv:
1312 return hlfir::EntityWithAttributes{builder.create<mlir::arith::CmpIOp>(
1313 loc, mlir::arith::CmpIPredicate::eq, i1Lhs, i1Rhs)};
1314 case Fortran::evaluate::LogicalOperator::Neqv:
1315 return hlfir::EntityWithAttributes{builder.create<mlir::arith::CmpIOp>(
1316 loc, mlir::arith::CmpIPredicate::ne, i1Lhs, i1Rhs)};
1317 case Fortran::evaluate::LogicalOperator::Not:
1318 // lib/evaluate expression for .NOT. is Fortran::evaluate::Not<KIND>.
1319 llvm_unreachable(".NOT. is not a binary operator");
1320 }
1321 llvm_unreachable("unhandled logical operation");
1322 }
1323};
1324
1325template <int KIND>
1326struct BinaryOp<Fortran::evaluate::ComplexConstructor<KIND>> {
1327 using Op = Fortran::evaluate::ComplexConstructor<KIND>;
1328 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1329 fir::FirOpBuilder &builder, const Op &,
1330 hlfir::Entity lhs, hlfir::Entity rhs) {
1331 mlir::Value res =
1332 fir::factory::Complex{builder, loc}.createComplex(lhs, rhs);
1333 return hlfir::EntityWithAttributes{res};
1334 }
1335};
1336
1337template <int KIND>
1338struct BinaryOp<Fortran::evaluate::SetLength<KIND>> {
1339 using Op = Fortran::evaluate::SetLength<KIND>;
1340 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1341 fir::FirOpBuilder &builder, const Op &,
1342 hlfir::Entity string,
1343 hlfir::Entity length) {
1344 // The input length may be a user input and needs to be sanitized as per
1345 // Fortran 2018 7.4.4.2 point 5.
1346 mlir::Value safeLength = fir::factory::genMaxWithZero(builder, loc, length);
1347 return hlfir::EntityWithAttributes{
1348 builder.create<hlfir::SetLengthOp>(loc, string, safeLength)};
1349 }
1350 static void
1351 genResultTypeParams(mlir::Location, fir::FirOpBuilder &, hlfir::Entity,
1352 hlfir::Entity rhs,
1353 llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
1354 resultTypeParams.push_back(rhs);
1355 }
1356};
1357
1358template <int KIND>
1359struct BinaryOp<Fortran::evaluate::Concat<KIND>> {
1360 using Op = Fortran::evaluate::Concat<KIND>;
1361 hlfir::EntityWithAttributes gen(mlir::Location loc,
1362 fir::FirOpBuilder &builder, const Op &,
1363 hlfir::Entity lhs, hlfir::Entity rhs) {
1364 assert(len && "genResultTypeParams must have been called");
1365 auto concat =
1366 builder.create<hlfir::ConcatOp>(loc, mlir::ValueRange{lhs, rhs}, len);
1367 return hlfir::EntityWithAttributes{concat.getResult()};
1368 }
1369 void
1370 genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
1371 hlfir::Entity lhs, hlfir::Entity rhs,
1372 llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
1373 llvm::SmallVector<mlir::Value> lengths;
1374 hlfir::genLengthParameters(loc, builder, lhs, lengths);
1375 hlfir::genLengthParameters(loc, builder, rhs, lengths);
1376 assert(lengths.size() == 2 && "lacks rhs or lhs length");
1377 mlir::Type idxType = builder.getIndexType();
1378 mlir::Value lhsLen = builder.createConvert(loc, idxType, lengths[0]);
1379 mlir::Value rhsLen = builder.createConvert(loc, idxType, lengths[1]);
1380 len = builder.create<mlir::arith::AddIOp>(loc, lhsLen, rhsLen);
1381 resultTypeParams.push_back(len);
1382 }
1383
1384private:
1385 mlir::Value len{};
1386};
1387
1388//===--------------------------------------------------------------------===//
1389// Unary Operation implementation
1390//===--------------------------------------------------------------------===//
1391
1392template <typename T>
1393struct UnaryOp {};
1394
1395template <int KIND>
1396struct UnaryOp<Fortran::evaluate::Not<KIND>> {
1397 using Op = Fortran::evaluate::Not<KIND>;
1398 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1399 fir::FirOpBuilder &builder, const Op &,
1400 hlfir::Entity lhs) {
1401 mlir::Value one = builder.createBool(loc, true);
1402 mlir::Value val = builder.createConvert(loc, builder.getI1Type(), lhs);
1403 return hlfir::EntityWithAttributes{
1404 builder.create<mlir::arith::XOrIOp>(loc, val, one)};
1405 }
1406};
1407
1408template <int KIND>
1409struct UnaryOp<Fortran::evaluate::Negate<
1410 Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> {
1411 using Op = Fortran::evaluate::Negate<
1412 Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>;
1413 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1414 fir::FirOpBuilder &builder, const Op &,
1415 hlfir::Entity lhs) {
1416 // Like LLVM, integer negation is the binary op "0 - value"
1417 mlir::Type type = Fortran::lower::getFIRType(
1418 builder.getContext(), Fortran::common::TypeCategory::Integer, KIND,
1419 /*params=*/std::nullopt);
1420 mlir::Value zero = builder.createIntegerConstant(loc, type, 0);
1421 return hlfir::EntityWithAttributes{
1422 builder.create<mlir::arith::SubIOp>(loc, zero, lhs)};
1423 }
1424};
1425
1426template <int KIND>
1427struct UnaryOp<Fortran::evaluate::Negate<
1428 Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
1429 using Op = Fortran::evaluate::Negate<
1430 Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
1431 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1432 fir::FirOpBuilder &builder, const Op &,
1433 hlfir::Entity lhs) {
1434 int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
1435 KIND>::Scalar::bits;
1436 mlir::Type signlessType = mlir::IntegerType::get(
1437 builder.getContext(), bits,
1438 mlir::IntegerType::SignednessSemantics::Signless);
1439 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
1440 mlir::Value signless = builder.createConvert(loc, signlessType, lhs);
1441 mlir::Value negated =
1442 builder.create<mlir::arith::SubIOp>(loc, zero, signless);
1443 return hlfir::EntityWithAttributes(
1444 builder.createConvert(loc, lhs.getType(), negated));
1445 }
1446};
1447
1448template <int KIND>
1449struct UnaryOp<Fortran::evaluate::Negate<
1450 Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
1451 using Op = Fortran::evaluate::Negate<
1452 Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>;
1453 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1454 fir::FirOpBuilder &builder, const Op &,
1455 hlfir::Entity lhs) {
1456 return hlfir::EntityWithAttributes{
1457 builder.create<mlir::arith::NegFOp>(loc, lhs)};
1458 }
1459};
1460
1461template <int KIND>
1462struct UnaryOp<Fortran::evaluate::Negate<
1463 Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
1464 using Op = Fortran::evaluate::Negate<
1465 Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
1466 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1467 fir::FirOpBuilder &builder, const Op &,
1468 hlfir::Entity lhs) {
1469 return hlfir::EntityWithAttributes{builder.create<fir::NegcOp>(loc, lhs)};
1470 }
1471};
1472
1473template <int KIND>
1474struct UnaryOp<Fortran::evaluate::ComplexComponent<KIND>> {
1475 using Op = Fortran::evaluate::ComplexComponent<KIND>;
1476 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1477 fir::FirOpBuilder &builder,
1478 const Op &op, hlfir::Entity lhs) {
1479 mlir::Value res = fir::factory::Complex{builder, loc}.extractComplexPart(
1480 lhs, op.isImaginaryPart);
1481 return hlfir::EntityWithAttributes{res};
1482 }
1483};
1484
1485template <typename T>
1486struct UnaryOp<Fortran::evaluate::Parentheses<T>> {
1487 using Op = Fortran::evaluate::Parentheses<T>;
1488 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1489 fir::FirOpBuilder &builder,
1490 const Op &op, hlfir::Entity lhs) {
1491 if (lhs.isVariable())
1492 return hlfir::EntityWithAttributes{
1493 builder.create<hlfir::AsExprOp>(loc, lhs)};
1494 return hlfir::EntityWithAttributes{
1495 builder.create<hlfir::NoReassocOp>(loc, lhs.getType(), lhs)};
1496 }
1497
1498 static void
1499 genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
1500 hlfir::Entity lhs,
1501 llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
1502 hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams);
1503 }
1504};
1505
1506template <Fortran::common::TypeCategory TC1, int KIND,
1507 Fortran::common::TypeCategory TC2>
1508struct UnaryOp<
1509 Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>> {
1510 using Op =
1511 Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>;
1512 static hlfir::EntityWithAttributes gen(mlir::Location loc,
1513 fir::FirOpBuilder &builder, const Op &,
1514 hlfir::Entity lhs) {
1515 if constexpr (TC1 == Fortran::common::TypeCategory::Character &&
1516 TC2 == TC1) {
1517 return hlfir::convertCharacterKind(loc, builder, lhs, KIND);
1518 }
1519 mlir::Type type = Fortran::lower::getFIRType(builder.getContext(), TC1,
1520 KIND, /*params=*/std::nullopt);
1521 mlir::Value res = builder.convertWithSemantics(loc, type, lhs);
1522 return hlfir::EntityWithAttributes{res};
1523 }
1524
1525 static void
1526 genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
1527 hlfir::Entity lhs,
1528 llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) {
1529 hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams);
1530 }
1531};
1532
1533static bool hasDeferredCharacterLength(const Fortran::semantics::Symbol &sym) {
1534 const Fortran::semantics::DeclTypeSpec *type = sym.GetType();
1535 return type &&
1536 type->category() ==
1537 Fortran::semantics::DeclTypeSpec::Category::Character &&
1538 type->characterTypeSpec().length().isDeferred();
1539}
1540
1541/// Lower Expr to HLFIR.
1542class HlfirBuilder {
1543public:
1544 HlfirBuilder(mlir::Location loc, Fortran::lower::AbstractConverter &converter,
1545 Fortran::lower::SymMap &symMap,
1546 Fortran::lower::StatementContext &stmtCtx)
1547 : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {}
1548
1549 template <typename T>
1550 hlfir::EntityWithAttributes gen(const Fortran::evaluate::Expr<T> &expr) {
1551 if (const Fortran::lower::ExprToValueMap *map =
1552 getConverter().getExprOverrides()) {
1553 if constexpr (std::is_same_v<T, Fortran::evaluate::SomeType>) {
1554 if (auto match = map->find(&expr); match != map->end())
1555 return hlfir::EntityWithAttributes{match->second};
1556 } else {
1557 Fortran::lower::SomeExpr someExpr = toEvExpr(expr);
1558 if (auto match = map->find(&someExpr); match != map->end())
1559 return hlfir::EntityWithAttributes{match->second};
1560 }
1561 }
1562 return Fortran::common::visit([&](const auto &x) { return gen(x); },
1563 expr.u);
1564 }
1565
1566private:
1567 hlfir::EntityWithAttributes
1568 gen(const Fortran::evaluate::BOZLiteralConstant &expr) {
1569 TODO(getLoc(), "BOZ");
1570 }
1571
1572 hlfir::EntityWithAttributes gen(const Fortran::evaluate::NullPointer &expr) {
1573 auto nullop = getBuilder().create<hlfir::NullOp>(getLoc());
1574 return mlir::cast<fir::FortranVariableOpInterface>(nullop.getOperation());
1575 }
1576
1577 hlfir::EntityWithAttributes
1578 gen(const Fortran::evaluate::ProcedureDesignator &proc) {
1579 return Fortran::lower::convertProcedureDesignatorToHLFIR(
1580 getLoc(), getConverter(), proc, getSymMap(), getStmtCtx());
1581 }
1582
1583 hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) {
1584 Fortran::evaluate::ProcedureDesignator proc{expr.proc()};
1585 auto procTy{Fortran::lower::translateSignature(proc, getConverter())};
1586 auto result = Fortran::lower::convertCallToHLFIR(getLoc(), getConverter(),
1587 expr, procTy.getResult(0),
1588 getSymMap(), getStmtCtx());
1589 assert(result.has_value());
1590 return *result;
1591 }
1592
1593 template <typename T>
1594 hlfir::EntityWithAttributes
1595 gen(const Fortran::evaluate::Designator<T> &designator) {
1596 return HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(),
1597 getStmtCtx())
1598 .gen(designator.u);
1599 }
1600
1601 template <typename T>
1602 hlfir::EntityWithAttributes
1603 gen(const Fortran::evaluate::FunctionRef<T> &expr) {
1604 mlir::Type resType =
1605 Fortran::lower::TypeBuilder<T>::genType(getConverter(), expr);
1606 auto result = Fortran::lower::convertCallToHLFIR(
1607 getLoc(), getConverter(), expr, resType, getSymMap(), getStmtCtx());
1608 assert(result.has_value());
1609 return *result;
1610 }
1611
1612 template <typename T>
1613 hlfir::EntityWithAttributes gen(const Fortran::evaluate::Constant<T> &expr) {
1614 mlir::Location loc = getLoc();
1615 fir::FirOpBuilder &builder = getBuilder();
1616 fir::ExtendedValue exv = Fortran::lower::convertConstant(
1617 converter, loc, expr, /*outlineBigConstantInReadOnlyMemory=*/true);
1618 if (const auto *scalarBox = exv.getUnboxed())
1619 if (fir::isa_trivial(scalarBox->getType()))
1620 return hlfir::EntityWithAttributes(*scalarBox);
1621 if (auto addressOf = fir::getBase(exv).getDefiningOp<fir::AddrOfOp>()) {
1622 auto flags = fir::FortranVariableFlagsAttr::get(
1623 builder.getContext(), fir::FortranVariableFlagsEnum::parameter);
1624 return hlfir::genDeclare(
1625 loc, builder, exv,
1626 addressOf.getSymbol().getRootReference().getValue(), flags);
1627 }
1628 fir::emitFatalError(loc, "Constant<T> was lowered to unexpected format");
1629 }
1630
1631 template <typename T>
1632 hlfir::EntityWithAttributes
1633 gen(const Fortran::evaluate::ArrayConstructor<T> &arrayCtor) {
1634 return Fortran::lower::ArrayConstructorBuilder<T>::gen(
1635 getLoc(), getConverter(), arrayCtor, getSymMap(), getStmtCtx());
1636 }
1637
1638 template <typename D, typename R, typename O>
1639 hlfir::EntityWithAttributes
1640 gen(const Fortran::evaluate::Operation<D, R, O> &op) {
1641 auto &builder = getBuilder();
1642 mlir::Location loc = getLoc();
1643 const int rank = op.Rank();
1644 UnaryOp<D> unaryOp;
1645 auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left()));
1646 llvm::SmallVector<mlir::Value, 1> typeParams;
1647 if constexpr (R::category == Fortran::common::TypeCategory::Character) {
1648 unaryOp.genResultTypeParams(loc, builder, left, typeParams);
1649 }
1650 if (rank == 0)
1651 return unaryOp.gen(loc, builder, op.derived(), left);
1652
1653 // Elemental expression.
1654 mlir::Type elementType;
1655 if constexpr (R::category == Fortran::common::TypeCategory::Derived) {
1656 if (op.derived().GetType().IsUnlimitedPolymorphic())
1657 elementType = mlir::NoneType::get(builder.getContext());
1658 else
1659 elementType = Fortran::lower::translateDerivedTypeToFIRType(
1660 getConverter(), op.derived().GetType().GetDerivedTypeSpec());
1661 } else {
1662 elementType =
1663 Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind,
1664 /*params=*/std::nullopt);
1665 }
1666 mlir::Value shape = hlfir::genShape(loc, builder, left);
1667 auto genKernel = [&op, &left, &unaryOp](
1668 mlir::Location l, fir::FirOpBuilder &b,
1669 mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
1670 auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices);
1671 auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement);
1672 return unaryOp.gen(l, b, op.derived(), leftVal);
1673 };
1674 mlir::Value elemental = hlfir::genElementalOp(
1675 loc, builder, elementType, shape, typeParams, genKernel,
1676 /*isUnordered=*/true, left.isPolymorphic() ? left : mlir::Value{});
1677 fir::FirOpBuilder *bldr = &builder;
1678 getStmtCtx().attachCleanup(
1679 [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
1680 return hlfir::EntityWithAttributes{elemental};
1681 }
1682
1683 template <typename D, typename R, typename LO, typename RO>
1684 hlfir::EntityWithAttributes
1685 gen(const Fortran::evaluate::Operation<D, R, LO, RO> &op) {
1686 auto &builder = getBuilder();
1687 mlir::Location loc = getLoc();
1688 const int rank = op.Rank();
1689 BinaryOp<D> binaryOp;
1690 auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left()));
1691 auto right = hlfir::loadTrivialScalar(loc, builder, gen(op.right()));
1692 llvm::SmallVector<mlir::Value, 1> typeParams;
1693 if constexpr (R::category == Fortran::common::TypeCategory::Character) {
1694 binaryOp.genResultTypeParams(loc, builder, left, right, typeParams);
1695 }
1696 if (rank == 0)
1697 return binaryOp.gen(loc, builder, op.derived(), left, right);
1698
1699 // Elemental expression.
1700 mlir::Type elementType =
1701 Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind,
1702 /*params=*/std::nullopt);
1703 // TODO: "merge" shape, get cst shape from front-end if possible.
1704 mlir::Value shape;
1705 if (left.isArray()) {
1706 shape = hlfir::genShape(loc, builder, left);
1707 } else {
1708 assert(right.isArray() && "must have at least one array operand");
1709 shape = hlfir::genShape(loc, builder, right);
1710 }
1711 auto genKernel = [&op, &left, &right, &binaryOp](
1712 mlir::Location l, fir::FirOpBuilder &b,
1713 mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
1714 auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices);
1715 auto rightElement = hlfir::getElementAt(l, b, right, oneBasedIndices);
1716 auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement);
1717 auto rightVal = hlfir::loadTrivialScalar(l, b, rightElement);
1718 return binaryOp.gen(l, b, op.derived(), leftVal, rightVal);
1719 };
1720 auto iofBackup = builder.getIntegerOverflowFlags();
1721 // nsw is never added to operations on vector subscripts
1722 // even if -fno-wrapv is enabled.
1723 builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::none);
1724 mlir::Value elemental = hlfir::genElementalOp(loc, builder, elementType,
1725 shape, typeParams, genKernel,
1726 /*isUnordered=*/true);
1727 builder.setIntegerOverflowFlags(iofBackup);
1728 fir::FirOpBuilder *bldr = &builder;
1729 getStmtCtx().attachCleanup(
1730 [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
1731 return hlfir::EntityWithAttributes{elemental};
1732 }
1733
1734 hlfir::EntityWithAttributes
1735 gen(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &op) {
1736 return Fortran::common::visit([&](const auto &x) { return gen(x); }, op.u);
1737 }
1738
1739 hlfir::EntityWithAttributes gen(const Fortran::evaluate::TypeParamInquiry &) {
1740 TODO(getLoc(), "lowering type parameter inquiry to HLFIR");
1741 }
1742
1743 hlfir::EntityWithAttributes
1744 gen(const Fortran::evaluate::DescriptorInquiry &desc) {
1745 mlir::Location loc = getLoc();
1746 auto &builder = getBuilder();
1747 hlfir::EntityWithAttributes entity =
1748 HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(),
1749 getStmtCtx())
1750 .genNamedEntity(desc.base());
1751 using ResTy = Fortran::evaluate::DescriptorInquiry::Result;
1752 mlir::Type resultType =
1753 getConverter().genType(ResTy::category, ResTy::kind);
1754 auto castResult = [&](mlir::Value v) {
1755 return hlfir::EntityWithAttributes{
1756 builder.createConvert(loc, resultType, v)};
1757 };
1758 switch (desc.field()) {
1759 case Fortran::evaluate::DescriptorInquiry::Field::Len:
1760 return castResult(hlfir::genCharLength(loc, builder, entity));
1761 case Fortran::evaluate::DescriptorInquiry::Field::LowerBound:
1762 return castResult(
1763 hlfir::genLBound(loc, builder, entity, desc.dimension()));
1764 case Fortran::evaluate::DescriptorInquiry::Field::Extent:
1765 return castResult(
1766 hlfir::genExtent(loc, builder, entity, desc.dimension()));
1767 case Fortran::evaluate::DescriptorInquiry::Field::Rank:
1768 return castResult(hlfir::genRank(loc, builder, entity, resultType));
1769 case Fortran::evaluate::DescriptorInquiry::Field::Stride:
1770 // So far the front end does not generate this inquiry.
1771 TODO(loc, "stride inquiry");
1772 }
1773 llvm_unreachable("unknown descriptor inquiry");
1774 }
1775
1776 hlfir::EntityWithAttributes
1777 gen(const Fortran::evaluate::ImpliedDoIndex &var) {
1778 mlir::Value value = symMap.lookupImpliedDo(toStringRef(var.name));
1779 if (!value)
1780 fir::emitFatalError(getLoc(), "ac-do-variable has no binding");
1781 // The index value generated by the implied-do has Index type,
1782 // while computations based on it inside the loop body are using
1783 // the original data type. So we need to cast it appropriately.
1784 mlir::Type varTy = getConverter().genType(toEvExpr(var));
1785 value = getBuilder().createConvert(getLoc(), varTy, value);
1786 return hlfir::EntityWithAttributes{value};
1787 }
1788
1789 static bool
1790 isDerivedTypeWithLenParameters(const Fortran::semantics::Symbol &sym) {
1791 if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType())
1792 if (const Fortran::semantics::DerivedTypeSpec *derived =
1793 declTy->AsDerived())
1794 return Fortran::semantics::CountLenParameters(*derived) > 0;
1795 return false;
1796 }
1797
1798 // Construct an entity holding the value specified by the
1799 // StructureConstructor. The initialization of the temporary entity
1800 // is done component by component with the help of HLFIR operations
1801 // DesignateOp and AssignOp.
1802 hlfir::EntityWithAttributes
1803 gen(const Fortran::evaluate::StructureConstructor &ctor) {
1804 mlir::Location loc = getLoc();
1805 fir::FirOpBuilder &builder = getBuilder();
1806 mlir::Type ty = translateSomeExprToFIRType(converter, toEvExpr(ctor));
1807 auto recTy = mlir::cast<fir::RecordType>(ty);
1808
1809 if (recTy.isDependentType())
1810 TODO(loc, "structure constructor for derived type with length parameters "
1811 "in HLFIR");
1812
1813 // Allocate scalar temporary that will be initialized
1814 // with the values specified by the constructor.
1815 mlir::Value storagePtr = builder.createTemporary(loc, recTy);
1816 auto varOp = hlfir::EntityWithAttributes{builder.create<hlfir::DeclareOp>(
1817 loc, storagePtr, "ctor.temp", /*shape=*/nullptr,
1818 /*typeparams=*/mlir::ValueRange{}, /*dummy_scope=*/nullptr,
1819 fir::FortranVariableFlagsAttr{})};
1820
1821 // Initialize any components that need initialization.
1822 mlir::Value box = builder.createBox(loc, fir::ExtendedValue{varOp});
1823 fir::runtime::genDerivedTypeInitialize(builder, loc, box);
1824
1825 // StructureConstructor values may relate to name of components in parent
1826 // types. These components cannot be addressed directly, the parent
1827 // components must be addressed first. The loop below creates all the
1828 // required chains of hlfir.designate to address the parent components so
1829 // that the StructureConstructor can later be lowered by addressing these
1830 // parent components if needed. Note: the front-end orders the components in
1831 // structure constructors.
1832 using ValueAndParent = std::tuple<const Fortran::lower::SomeExpr &,
1833 const Fortran::semantics::Symbol &,
1834 hlfir::EntityWithAttributes>;
1835 llvm::SmallVector<ValueAndParent> valuesAndParents;
1836 for (const auto &value : llvm::reverse(ctor.values())) {
1837 const Fortran::semantics::Symbol &compSym = *value.first;
1838 hlfir::EntityWithAttributes currentParent = varOp;
1839 for (Fortran::lower::ComponentReverseIterator compIterator(
1840 ctor.result().derivedTypeSpec());
1841 !compIterator.lookup(compSym.name());) {
1842 const auto &parentType = compIterator.advanceToParentType();
1843 llvm::StringRef parentName = toStringRef(parentType.name());
1844 auto baseRecTy = mlir::cast<fir::RecordType>(
1845 hlfir::getFortranElementType(currentParent.getType()));
1846 auto parentCompType = baseRecTy.getType(parentName);
1847 assert(parentCompType && "failed to retrieve parent component type");
1848 mlir::Type designatorType = builder.getRefType(parentCompType);
1849 mlir::Value newParent = builder.create<hlfir::DesignateOp>(
1850 loc, designatorType, currentParent, parentName,
1851 /*compShape=*/mlir::Value{}, hlfir::DesignateOp::Subscripts{},
1852 /*substring=*/mlir::ValueRange{},
1853 /*complexPart=*/std::nullopt,
1854 /*shape=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{},
1855 fir::FortranVariableFlagsAttr{});
1856 currentParent = hlfir::EntityWithAttributes{newParent};
1857 }
1858 valuesAndParents.emplace_back(
1859 ValueAndParent{value.second.value(), compSym, currentParent});
1860 }
1861
1862 HlfirDesignatorBuilder designatorBuilder(loc, converter, symMap, stmtCtx);
1863 for (const auto &iter : llvm::reverse(valuesAndParents)) {
1864 auto &sym = std::get<const Fortran::semantics::Symbol &>(iter);
1865 auto &expr = std::get<const Fortran::lower::SomeExpr &>(iter);
1866 auto &baseOp = std::get<hlfir::EntityWithAttributes>(iter);
1867 std::string name = converter.getRecordTypeFieldName(sym);
1868
1869 // Generate DesignateOp for the component.
1870 // The designator's result type is just a reference to the component type,
1871 // because the whole component is being designated.
1872 auto baseRecTy = mlir::cast<fir::RecordType>(
1873 hlfir::getFortranElementType(baseOp.getType()));
1874 auto compType = baseRecTy.getType(name);
1875 assert(compType && "failed to retrieve component type");
1876 mlir::Value compShape =
1877 designatorBuilder.genComponentShape(sym, compType);
1878 const bool isDesignatorVolatile =
1879 fir::isa_volatile_type(baseOp.getType());
1880 auto [designatorType, extraAttributeFlags] =
1881 designatorBuilder.genComponentDesignatorTypeAndAttributes(
1882 sym, compType, isDesignatorVolatile);
1883
1884 mlir::Type fieldElemType = hlfir::getFortranElementType(compType);
1885 llvm::SmallVector<mlir::Value, 1> typeParams;
1886 if (auto charType = mlir::dyn_cast<fir::CharacterType>(fieldElemType)) {
1887 if (charType.hasConstantLen()) {
1888 mlir::Type idxType = builder.getIndexType();
1889 typeParams.push_back(
1890 builder.createIntegerConstant(loc, idxType, charType.getLen()));
1891 } else if (!hasDeferredCharacterLength(sym)) {
1892 // If the length is not deferred, this is a parametrized derived type
1893 // where the character length depends on the derived type length
1894 // parameters. Otherwise, this is a pointer/allocatable component and
1895 // the length will be set during the assignment.
1896 TODO(loc, "automatic character component in structure constructor");
1897 }
1898 }
1899
1900 // Convert component symbol attributes to variable attributes.
1901 fir::FortranVariableFlagsAttr attrs =
1902 Fortran::lower::translateSymbolAttributes(builder.getContext(), sym,
1903 extraAttributeFlags);
1904
1905 // Get the component designator.
1906 auto lhs = builder.create<hlfir::DesignateOp>(
1907 loc, designatorType, baseOp, name, compShape,
1908 hlfir::DesignateOp::Subscripts{},
1909 /*substring=*/mlir::ValueRange{},
1910 /*complexPart=*/std::nullopt,
1911 /*shape=*/compShape, typeParams, attrs);
1912
1913 if (attrs && bitEnumContainsAny(attrs.getFlags(),
1914 fir::FortranVariableFlagsEnum::pointer)) {
1915 if (Fortran::semantics::IsProcedure(sym)) {
1916 // Procedure pointer components.
1917 if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
1918 expr)) {
1919 auto boxTy{
1920 Fortran::lower::getUntypedBoxProcType(builder.getContext())};
1921 hlfir::Entity rhs(
1922 fir::factory::createNullBoxProc(builder, loc, boxTy));
1923 builder.createStoreWithConvert(loc, rhs, lhs);
1924 continue;
1925 }
1926 hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress(
1927 loc, converter, expr, symMap, stmtCtx)));
1928 builder.createStoreWithConvert(loc, rhs, lhs);
1929 continue;
1930 }
1931 // Pointer component construction is just a copy of the box contents.
1932 fir::ExtendedValue lhsExv =
1933 hlfir::translateToExtendedValue(loc, builder, lhs);
1934 auto *toBox = lhsExv.getBoxOf<fir::MutableBoxValue>();
1935 if (!toBox)
1936 fir::emitFatalError(loc, "pointer component designator could not be "
1937 "lowered to mutable box");
1938 Fortran::lower::associateMutableBox(converter, loc, *toBox, expr,
1939 /*lbounds=*/std::nullopt, stmtCtx);
1940 continue;
1941 }
1942
1943 // Use generic assignment for all the other cases.
1944 bool allowRealloc =
1945 attrs &&
1946 bitEnumContainsAny(attrs.getFlags(),
1947 fir::FortranVariableFlagsEnum::allocatable);
1948 // If the component is allocatable, then we have to check
1949 // whether the RHS value is allocatable or not.
1950 // If it is not allocatable, then AssignOp can be used directly.
1951 // If it is allocatable, then using AssignOp for unallocated RHS
1952 // will cause illegal dereference. When an unallocated allocatable
1953 // value is used to construct an allocatable component, the component
1954 // must just stay unallocated (see Fortran 2018 7.5.10 point 7).
1955
1956 // If the component is allocatable and RHS is NULL() expression, then
1957 // we can just skip it: the LHS must remain unallocated with its
1958 // defined rank.
1959 if (allowRealloc &&
1960 Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr))
1961 continue;
1962
1963 bool keepLhsLength = false;
1964 if (allowRealloc)
1965 if (const Fortran::semantics::DeclTypeSpec *declType = sym.GetType())
1966 keepLhsLength =
1967 declType->category() ==
1968 Fortran::semantics::DeclTypeSpec::Category::Character &&
1969 !declType->characterTypeSpec().length().isDeferred();
1970 // Handle special case when the initializer expression is
1971 // '{%SET_LENGTH(x,const_kind)}'. In structure constructor,
1972 // SET_LENGTH is used for initializers of non-allocatable character
1973 // components so that the front-end can better
1974 // fold and work with these structure constructors.
1975 // Here, they are just noise since the assignment semantics will deal
1976 // with any length mismatch, and creating an extra temp with the lhs
1977 // length is useless.
1978 // TODO: should this be moved into an hlfir.assign + hlfir.set_length
1979 // pattern rewrite?
1980 hlfir::Entity rhs = gen(expr);
1981 if (auto set_length = rhs.getDefiningOp<hlfir::SetLengthOp>())
1982 rhs = hlfir::Entity{set_length.getString()};
1983
1984 // lambda to generate `lhs = rhs` and deal with potential rhs implicit
1985 // cast
1986 auto genAssign = [&] {
1987 rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
1988 auto rhsCastAndCleanup =
1989 hlfir::genTypeAndKindConvert(loc, builder, rhs, lhs.getType(),
1990 /*preserveLowerBounds=*/allowRealloc);
1991 builder.create<hlfir::AssignOp>(loc, rhsCastAndCleanup.first, lhs,
1992 allowRealloc,
1993 allowRealloc ? keepLhsLength : false,
1994 /*temporary_lhs=*/true);
1995 if (rhsCastAndCleanup.second)
1996 (*rhsCastAndCleanup.second)();
1997 };
1998
1999 if (!allowRealloc || !rhs.isMutableBox()) {
2000 genAssign();
2001 continue;
2002 }
2003
2004 auto [rhsExv, cleanup] =
2005 hlfir::translateToExtendedValue(loc, builder, rhs);
2006 assert(!cleanup && "unexpected cleanup");
2007 auto *fromBox = rhsExv.getBoxOf<fir::MutableBoxValue>();
2008 if (!fromBox)
2009 fir::emitFatalError(loc, "allocatable entity could not be lowered "
2010 "to mutable box");
2011 mlir::Value isAlloc =
2012 fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *fromBox);
2013 builder.genIfThen(loc, isAlloc).genThen(genAssign).end();
2014 }
2015
2016 if (fir::isRecordWithAllocatableMember(recTy)) {
2017 // Deallocate allocatable components without calling final subroutines.
2018 // The Fortran 2018 section 9.7.3.2 about deallocation is not ruling
2019 // about the fate of allocatable components of structure constructors,
2020 // and there is no behavior consensus in other compilers.
2021 fir::FirOpBuilder *bldr = &builder;
2022 getStmtCtx().attachCleanup([=]() {
2023 fir::runtime::genDerivedTypeDestroyWithoutFinalization(*bldr, loc, box);
2024 });
2025 }
2026 return varOp;
2027 }
2028
2029 mlir::Location getLoc() const { return loc; }
2030 Fortran::lower::AbstractConverter &getConverter() { return converter; }
2031 fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); }
2032 Fortran::lower::SymMap &getSymMap() { return symMap; }
2033 Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; }
2034
2035 Fortran::lower::AbstractConverter &converter;
2036 Fortran::lower::SymMap &symMap;
2037 Fortran::lower::StatementContext &stmtCtx;
2038 mlir::Location loc;
2039};
2040
2041template <typename T>
2042hlfir::Entity
2043HlfirDesignatorBuilder::genSubscript(const Fortran::evaluate::Expr<T> &expr) {
2044 fir::FirOpBuilder &builder = getBuilder();
2045 mlir::arith::IntegerOverflowFlags iofBackup{};
2046 if (!getConverter().getLoweringOptions().getIntegerWrapAround()) {
2047 iofBackup = builder.getIntegerOverflowFlags();
2048 builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::nsw);
2049 }
2050 auto loweredExpr =
2051 HlfirBuilder(getLoc(), getConverter(), getSymMap(), getStmtCtx())
2052 .gen(expr);
2053 if (!getConverter().getLoweringOptions().getIntegerWrapAround())
2054 builder.setIntegerOverflowFlags(iofBackup);
2055 // Skip constant conversions that litters designators and makes generated
2056 // IR harder to read: directly use index constants for constant subscripts.
2057 mlir::Type idxTy = builder.getIndexType();
2058 if (!loweredExpr.isArray() && loweredExpr.getType() != idxTy)
2059 if (auto cstIndex = fir::getIntIfConstant(loweredExpr))
2060 return hlfir::EntityWithAttributes{
2061 builder.createIntegerConstant(getLoc(), idxTy, *cstIndex)};
2062 return hlfir::loadTrivialScalar(loc, builder, loweredExpr);
2063}
2064
2065} // namespace
2066
2067hlfir::EntityWithAttributes Fortran::lower::convertExprToHLFIR(
2068 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2069 const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2070 Fortran::lower::StatementContext &stmtCtx) {
2071 return HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2072}
2073
2074fir::ExtendedValue Fortran::lower::convertToBox(
2075 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2076 hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx,
2077 mlir::Type fortranType) {
2078 fir::FirOpBuilder &builder = converter.getFirOpBuilder();
2079 auto [exv, cleanup] = hlfir::convertToBox(loc, builder, entity, fortranType);
2080 if (cleanup)
2081 stmtCtx.attachCleanup(*cleanup);
2082 return exv;
2083}
2084
2085fir::ExtendedValue Fortran::lower::convertExprToBox(
2086 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2087 const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2088 Fortran::lower::StatementContext &stmtCtx) {
2089 hlfir::EntityWithAttributes loweredExpr =
2090 HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2091 return convertToBox(loc, converter, loweredExpr, stmtCtx,
2092 converter.genType(expr));
2093}
2094
2095fir::ExtendedValue Fortran::lower::convertToAddress(
2096 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2097 hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx,
2098 mlir::Type fortranType) {
2099 fir::FirOpBuilder &builder = converter.getFirOpBuilder();
2100 auto [exv, cleanup] =
2101 hlfir::convertToAddress(loc, builder, entity, fortranType);
2102 if (cleanup)
2103 stmtCtx.attachCleanup(*cleanup);
2104 return exv;
2105}
2106
2107fir::ExtendedValue Fortran::lower::convertExprToAddress(
2108 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2109 const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2110 Fortran::lower::StatementContext &stmtCtx) {
2111 hlfir::EntityWithAttributes loweredExpr =
2112 HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2113 return convertToAddress(loc, converter, loweredExpr, stmtCtx,
2114 converter.genType(expr));
2115}
2116
2117fir::ExtendedValue Fortran::lower::convertToValue(
2118 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2119 hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx) {
2120 auto &builder = converter.getFirOpBuilder();
2121 auto [exv, cleanup] = hlfir::convertToValue(loc, builder, entity);
2122 if (cleanup)
2123 stmtCtx.attachCleanup(*cleanup);
2124 return exv;
2125}
2126
2127fir::ExtendedValue Fortran::lower::convertExprToValue(
2128 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2129 const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2130 Fortran::lower::StatementContext &stmtCtx) {
2131 hlfir::EntityWithAttributes loweredExpr =
2132 HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
2133 return convertToValue(loc, converter, loweredExpr, stmtCtx);
2134}
2135
2136fir::ExtendedValue Fortran::lower::convertDataRefToValue(
2137 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2138 const Fortran::evaluate::DataRef &dataRef, Fortran::lower::SymMap &symMap,
2139 Fortran::lower::StatementContext &stmtCtx) {
2140 fir::FortranVariableOpInterface loweredExpr =
2141 HlfirDesignatorBuilder(loc, converter, symMap, stmtCtx).gen(dataRef);
2142 return convertToValue(loc, converter, loweredExpr, stmtCtx);
2143}
2144
2145fir::MutableBoxValue Fortran::lower::convertExprToMutableBox(
2146 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2147 const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
2148 // Pointers and Allocatable cannot be temporary expressions. Temporaries may
2149 // be created while lowering it (e.g. if any indices expression of a
2150 // designator create temporaries), but they can be destroyed before using the
2151 // lowered pointer or allocatable;
2152 Fortran::lower::StatementContext localStmtCtx;
2153 hlfir::EntityWithAttributes loweredExpr =
2154 HlfirBuilder(loc, converter, symMap, localStmtCtx).gen(expr);
2155 fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
2156 loc, converter.getFirOpBuilder(), loweredExpr, localStmtCtx);
2157 auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>();
2158 assert(mutableBox && "expression could not be lowered to mutable box");
2159 return *mutableBox;
2160}
2161
2162hlfir::ElementalAddrOp
2163Fortran::lower::convertVectorSubscriptedExprToElementalAddr(
2164 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2165 const Fortran::lower::SomeExpr &designatorExpr,
2166 Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
2167 return HlfirDesignatorBuilder(loc, converter, symMap, stmtCtx)
2168 .convertVectorSubscriptedExprToElementalAddr(designatorExpr);
2169}
2170
2171hlfir::Entity Fortran::lower::genVectorSubscriptedDesignatorFirstElementAddress(
2172 mlir::Location loc, Fortran::lower::AbstractConverter &converter,
2173 const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
2174 Fortran::lower::StatementContext &stmtCtx) {
2175 fir::FirOpBuilder &builder = converter.getFirOpBuilder();
2176
2177 // Get a hlfir.elemental_addr op describing the address of the value
2178 // indexed from the original array.
2179 // Note: the hlfir.elemental_addr op verifier requires it to be inside
2180 // of a hlfir.region_assign op. This operation is never seen by the
2181 // verifier because it is immediately inlined.
2182 hlfir::ElementalAddrOp addrOp = convertVectorSubscriptedExprToElementalAddr(
2183 loc, converter, expr, symMap, stmtCtx);
2184 if (!addrOp.getCleanup().empty())
2185 TODO(converter.getCurrentLocation(),
2186 "Vector subscript requring a cleanup region");
2187
2188 // hlfir.elemental_addr doesn't have a normal lowering because it
2189 // can't return a value. Instead we need to inline it here using
2190 // values for the first element. Similar to hlfir::inlineElementalOp.
2191
2192 mlir::Value one = builder.createIntegerConstant(
2193 converter.getCurrentLocation(), builder.getIndexType(), 1);
2194 mlir::SmallVector<mlir::Value> oneBasedIndices;
2195 oneBasedIndices.resize(addrOp.getIndices().size(), one);
2196
2197 mlir::IRMapping mapper;
2198 mapper.map(addrOp.getIndices(), oneBasedIndices);
2199 assert(addrOp.getElementalRegion().hasOneBlock());
2200 mlir::Operation *newOp;
2201 for (mlir::Operation &op : addrOp.getElementalRegion().back().getOperations())
2202 newOp = builder.clone(op, mapper);
2203 auto yield = mlir::cast<hlfir::YieldOp>(newOp);
2204
2205 addrOp->erase();
2206
2207 if (!yield.getCleanup().empty())
2208 TODO(converter.getCurrentLocation(),
2209 "Vector subscript requring element cleanup");
2210
2211 hlfir::Entity result{yield.getEntity()};
2212 yield->erase();
2213 return result;
2214}
2215

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