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