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