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