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