1c14ef2d7SJean Perier //===-- ConvertExprToHLFIR.cpp --------------------------------------------===// 2c14ef2d7SJean Perier // 3c14ef2d7SJean Perier // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4c14ef2d7SJean Perier // See https://llvm.org/LICENSE.txt for license information. 5c14ef2d7SJean Perier // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6c14ef2d7SJean Perier // 7c14ef2d7SJean Perier //===----------------------------------------------------------------------===// 8c14ef2d7SJean Perier // 9c14ef2d7SJean Perier // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ 10c14ef2d7SJean Perier // 11c14ef2d7SJean Perier //===----------------------------------------------------------------------===// 12c14ef2d7SJean Perier 13c14ef2d7SJean Perier #include "flang/Lower/ConvertExprToHLFIR.h" 1407b89273SJean Perier #include "flang/Evaluate/shape.h" 15c14ef2d7SJean Perier #include "flang/Lower/AbstractConverter.h" 161ca458f7SSlava Zakharin #include "flang/Lower/Allocatable.h" 17e78e4a17SJean Perier #include "flang/Lower/CallInterface.h" 18ffde9f17SJean Perier #include "flang/Lower/ConvertArrayConstructor.h" 19e78e4a17SJean Perier #include "flang/Lower/ConvertCall.h" 203952377fSJean Perier #include "flang/Lower/ConvertConstant.h" 21cedfd272SJean Perier #include "flang/Lower/ConvertProcedureDesignator.h" 22e78e4a17SJean Perier #include "flang/Lower/ConvertType.h" 233508f691SJean Perier #include "flang/Lower/ConvertVariable.h" 24c14ef2d7SJean Perier #include "flang/Lower/StatementContext.h" 25c14ef2d7SJean Perier #include "flang/Lower/SymbolMap.h" 2626ceeee7SJean Perier #include "flang/Optimizer/Builder/Complex.h" 276dcb31deSTom Eccles #include "flang/Optimizer/Builder/IntrinsicCall.h" 284e78f885SJean Perier #include "flang/Optimizer/Builder/MutableBox.h" 2912530711SJean Perier #include "flang/Optimizer/Builder/Runtime/Character.h" 301ca458f7SSlava Zakharin #include "flang/Optimizer/Builder/Runtime/Derived.h" 31f8843efbSSlava Zakharin #include "flang/Optimizer/Builder/Runtime/Pointer.h" 32c14ef2d7SJean Perier #include "flang/Optimizer/Builder/Todo.h" 3307b89273SJean Perier #include "flang/Optimizer/HLFIR/HLFIROps.h" 34d0018c95SJean Perier #include "llvm/ADT/TypeSwitch.h" 354d4d4785SKazu Hirata #include <optional> 36c14ef2d7SJean Perier 37c14ef2d7SJean Perier namespace { 38c14ef2d7SJean Perier 39c14ef2d7SJean Perier /// Lower Designators to HLFIR. 40c14ef2d7SJean Perier class HlfirDesignatorBuilder { 41583d492cSJean Perier private: 42583d492cSJean Perier /// Internal entry point on the rightest part of a evaluate::Designator. 43583d492cSJean Perier template <typename T> 44583d492cSJean Perier hlfir::EntityWithAttributes 45583d492cSJean Perier genLeafPartRef(const T &designatorNode, 46583d492cSJean Perier bool vectorSubscriptDesignatorToValue) { 47583d492cSJean Perier hlfir::EntityWithAttributes result = gen(designatorNode); 48583d492cSJean Perier if (vectorSubscriptDesignatorToValue) 49583d492cSJean Perier return turnVectorSubscriptedDesignatorIntoValue(result); 50583d492cSJean Perier return result; 51583d492cSJean Perier } 52583d492cSJean Perier 53c7ff45a5SJean Perier hlfir::EntityWithAttributes 54c7ff45a5SJean Perier genDesignatorExpr(const Fortran::lower::SomeExpr &designatorExpr, 55c7ff45a5SJean Perier bool vectorSubscriptDesignatorToValue = true); 56c7ff45a5SJean Perier 57c14ef2d7SJean Perier public: 58c14ef2d7SJean Perier HlfirDesignatorBuilder(mlir::Location loc, 59c14ef2d7SJean Perier Fortran::lower::AbstractConverter &converter, 60c14ef2d7SJean Perier Fortran::lower::SymMap &symMap, 61c14ef2d7SJean Perier Fortran::lower::StatementContext &stmtCtx) 62c14ef2d7SJean Perier : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {} 63c14ef2d7SJean Perier 64583d492cSJean Perier /// Public entry points to lower a Designator<T> (given its .u member, to 65583d492cSJean Perier /// avoid the template arguments which does not matter here). 66583d492cSJean Perier /// This lowers a designator to an hlfir variable SSA value (that can be 67583d492cSJean Perier /// assigned to), except for vector subscripted designators that are 68583d492cSJean Perier /// lowered by default to hlfir.expr value since they cannot be 69583d492cSJean Perier /// represented as HLFIR variable SSA values. 70583d492cSJean Perier 71c14ef2d7SJean Perier // Character designators variant contains substrings 72c14ef2d7SJean Perier using CharacterDesignators = 73c14ef2d7SJean Perier decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type< 74c14ef2d7SJean Perier Fortran::evaluate::TypeCategory::Character, 1>>::u); 75fcfb620dSJean Perier hlfir::EntityWithAttributes 76583d492cSJean Perier gen(const CharacterDesignators &designatorVariant, 77583d492cSJean Perier bool vectorSubscriptDesignatorToValue = true) { 7877d8cfb3SAlexander Shaposhnikov return Fortran::common::visit( 79583d492cSJean Perier [&](const auto &x) -> hlfir::EntityWithAttributes { 80583d492cSJean Perier return genLeafPartRef(x, vectorSubscriptDesignatorToValue); 81583d492cSJean Perier }, 8207b89273SJean Perier designatorVariant); 83c14ef2d7SJean Perier } 84c14ef2d7SJean Perier // Character designators variant contains complex parts 85c14ef2d7SJean Perier using RealDesignators = 86c14ef2d7SJean Perier decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type< 87c14ef2d7SJean Perier Fortran::evaluate::TypeCategory::Real, 4>>::u); 88583d492cSJean Perier hlfir::EntityWithAttributes 89583d492cSJean Perier gen(const RealDesignators &designatorVariant, 90583d492cSJean Perier bool vectorSubscriptDesignatorToValue = true) { 9177d8cfb3SAlexander Shaposhnikov return Fortran::common::visit( 92583d492cSJean Perier [&](const auto &x) -> hlfir::EntityWithAttributes { 93583d492cSJean Perier return genLeafPartRef(x, vectorSubscriptDesignatorToValue); 94583d492cSJean Perier }, 9507b89273SJean Perier designatorVariant); 96c14ef2d7SJean Perier } 97c14ef2d7SJean Perier // All other designators are similar 98c14ef2d7SJean Perier using OtherDesignators = 99c14ef2d7SJean Perier decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type< 100c14ef2d7SJean Perier Fortran::evaluate::TypeCategory::Integer, 4>>::u); 101583d492cSJean Perier hlfir::EntityWithAttributes 102583d492cSJean Perier gen(const OtherDesignators &designatorVariant, 103583d492cSJean Perier bool vectorSubscriptDesignatorToValue = true) { 10477d8cfb3SAlexander Shaposhnikov return Fortran::common::visit( 105583d492cSJean Perier [&](const auto &x) -> hlfir::EntityWithAttributes { 106583d492cSJean Perier return genLeafPartRef(x, vectorSubscriptDesignatorToValue); 107583d492cSJean Perier }, 10807b89273SJean Perier designatorVariant); 109c14ef2d7SJean Perier } 110c14ef2d7SJean Perier 111d0018c95SJean Perier hlfir::EntityWithAttributes 112583d492cSJean Perier genNamedEntity(const Fortran::evaluate::NamedEntity &namedEntity, 113583d492cSJean Perier bool vectorSubscriptDesignatorToValue = true) { 114d0018c95SJean Perier if (namedEntity.IsSymbol()) 115583d492cSJean Perier return genLeafPartRef( 116583d492cSJean Perier Fortran::evaluate::SymbolRef{namedEntity.GetLastSymbol()}, 117583d492cSJean Perier vectorSubscriptDesignatorToValue); 118583d492cSJean Perier return genLeafPartRef(namedEntity.GetComponent(), 119583d492cSJean Perier vectorSubscriptDesignatorToValue); 120d0018c95SJean Perier } 121d0018c95SJean Perier 122c7ff45a5SJean Perier /// Public entry point to lower a vector subscripted designator to 123c7ff45a5SJean Perier /// an hlfir::ElementalAddrOp. 124c7ff45a5SJean Perier hlfir::ElementalAddrOp convertVectorSubscriptedExprToElementalAddr( 125c7ff45a5SJean Perier const Fortran::lower::SomeExpr &designatorExpr); 126c7ff45a5SJean Perier 1271ca458f7SSlava Zakharin mlir::Value genComponentShape(const Fortran::semantics::Symbol &componentSym, 1281ca458f7SSlava Zakharin mlir::Type fieldType) { 1291ca458f7SSlava Zakharin // For pointers and allocatable components, the 1301ca458f7SSlava Zakharin // shape is deferred and should not be loaded now to preserve 1311ca458f7SSlava Zakharin // pointer/allocatable aspects. 1321ca458f7SSlava Zakharin if (componentSym.Rank() == 0 || 1334998587eSDaniel Chen Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym) || 1344998587eSDaniel Chen Fortran::semantics::IsProcedurePointer(&componentSym)) 1351ca458f7SSlava Zakharin return mlir::Value{}; 1361ca458f7SSlava Zakharin 1371ca458f7SSlava Zakharin fir::FirOpBuilder &builder = getBuilder(); 1381ca458f7SSlava Zakharin mlir::Location loc = getLoc(); 1391ca458f7SSlava Zakharin mlir::Type idxTy = builder.getIndexType(); 1401ca458f7SSlava Zakharin llvm::SmallVector<mlir::Value> extents; 141fac349a1SChristian Sigg auto seqTy = mlir::cast<fir::SequenceType>( 142fac349a1SChristian Sigg hlfir::getFortranElementOrSequenceType(fieldType)); 1431ca458f7SSlava Zakharin for (auto extent : seqTy.getShape()) { 1441ca458f7SSlava Zakharin if (extent == fir::SequenceType::getUnknownExtent()) { 1451ca458f7SSlava Zakharin // We have already generated invalid hlfir.declare 1461ca458f7SSlava Zakharin // without the type parameters and probably invalid storage 1471ca458f7SSlava Zakharin // for the variable (e.g. fir.alloca without type parameters). 1481ca458f7SSlava Zakharin // So this TODO here is a little bit late, but it matches 1491ca458f7SSlava Zakharin // the non-HLFIR path. 1501ca458f7SSlava Zakharin TODO(loc, "array component shape depending on length parameters"); 1511ca458f7SSlava Zakharin } 1521ca458f7SSlava Zakharin extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); 1531ca458f7SSlava Zakharin } 154f917c396SjeanPerier if (!mayHaveNonDefaultLowerBounds(componentSym)) 1551ca458f7SSlava Zakharin return builder.create<fir::ShapeOp>(loc, extents); 1561ca458f7SSlava Zakharin 1571ca458f7SSlava Zakharin llvm::SmallVector<mlir::Value> lbounds; 1581ca458f7SSlava Zakharin if (const auto *objDetails = 1591ca458f7SSlava Zakharin componentSym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) 1601ca458f7SSlava Zakharin for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape()) 1611ca458f7SSlava Zakharin if (auto lb = bounds.lbound().GetExplicit()) 1621ca458f7SSlava Zakharin if (auto constant = Fortran::evaluate::ToInt64(*lb)) 1631ca458f7SSlava Zakharin lbounds.push_back( 1641ca458f7SSlava Zakharin builder.createIntegerConstant(loc, idxTy, *constant)); 1651ca458f7SSlava Zakharin assert(extents.size() == lbounds.size() && 1661ca458f7SSlava Zakharin "extents and lower bounds must match"); 1671ca458f7SSlava Zakharin return builder.genShape(loc, lbounds, extents); 1681ca458f7SSlava Zakharin } 1691ca458f7SSlava Zakharin 17067f9b5aeSValentin Clement (バレンタイン クレメン) fir::FortranVariableOpInterface 17167f9b5aeSValentin Clement (バレンタイン クレメン) gen(const Fortran::evaluate::DataRef &dataRef) { 17277d8cfb3SAlexander Shaposhnikov return Fortran::common::visit( 17367f9b5aeSValentin Clement (バレンタイン クレメン) Fortran::common::visitors{[&](const auto &x) { return gen(x); }}, 17467f9b5aeSValentin Clement (バレンタイン クレメン) dataRef.u); 17567f9b5aeSValentin Clement (バレンタイン クレメン) } 17667f9b5aeSValentin Clement (バレンタイン クレメン) 177c14ef2d7SJean Perier private: 17807b89273SJean Perier /// Struct that is filled while visiting a part-ref (in the "visit" member 17907b89273SJean Perier /// function) before the top level "gen" generates an hlfir.declare for the 18007b89273SJean Perier /// part ref. It contains the lowered pieces of the part-ref that will 18107b89273SJean Perier /// become the operands of an hlfir.declare. 18207b89273SJean Perier struct PartInfo { 183b3bb4dd3SJean Perier std::optional<hlfir::Entity> base; 184ffc3051dSJean Perier std::string componentName{}; 185ffc3051dSJean Perier mlir::Value componentShape; 1863191e8e1SJean Perier hlfir::DesignateOp::Subscripts subscripts; 187ba45f637SEthan Luis McDonough std::optional<bool> complexPart; 18807b89273SJean Perier mlir::Value resultShape; 18907b89273SJean Perier llvm::SmallVector<mlir::Value> typeParams; 190d0018c95SJean Perier llvm::SmallVector<mlir::Value, 2> substring; 19107b89273SJean Perier }; 19207b89273SJean Perier 193ffc3051dSJean Perier // Given the value type of a designator (T or fir.array<T>) and the front-end 194ffc3051dSJean Perier // node for the designator, compute the memory type (fir.class, fir.ref, or 195ffc3051dSJean Perier // fir.box)... 196ffc3051dSJean Perier template <typename T> 197ffc3051dSJean Perier mlir::Type computeDesignatorType(mlir::Type resultValueType, 198ba45f637SEthan Luis McDonough PartInfo &partInfo, 199ffc3051dSJean Perier const T &designatorNode) { 200ba45f637SEthan Luis McDonough // Get base's shape if its a sequence type with no previously computed 201ba45f637SEthan Luis McDonough // result shape 202fac349a1SChristian Sigg if (partInfo.base && mlir::isa<fir::SequenceType>(resultValueType) && 203ba45f637SEthan Luis McDonough !partInfo.resultShape) 204ba45f637SEthan Luis McDonough partInfo.resultShape = 205ba45f637SEthan Luis McDonough hlfir::genShape(getLoc(), getBuilder(), *partInfo.base); 206ffc3051dSJean Perier // Dynamic type of polymorphic base must be kept if the designator is 207ffc3051dSJean Perier // polymorphic. 208ffc3051dSJean Perier if (isPolymorphic(designatorNode)) 209ffc3051dSJean Perier return fir::ClassType::get(resultValueType); 210ffc3051dSJean Perier // Character scalar with dynamic length needs a fir.boxchar to hold the 211ffc3051dSJean Perier // designator length. 212fac349a1SChristian Sigg auto charType = mlir::dyn_cast<fir::CharacterType>(resultValueType); 21307b89273SJean Perier if (charType && charType.hasDynamicLen()) 214ffc3051dSJean Perier return fir::BoxCharType::get(charType.getContext(), charType.getFKind()); 215ffc3051dSJean Perier // Arrays with non default lower bounds or dynamic length or dynamic extent 216ffc3051dSJean Perier // need a fir.box to hold the dynamic or lower bound information. 217ffc3051dSJean Perier if (fir::hasDynamicSize(resultValueType) || 218f917c396SjeanPerier mayHaveNonDefaultLowerBounds(partInfo)) 219ffc3051dSJean Perier return fir::BoxType::get(resultValueType); 220ffc3051dSJean Perier // Non simply contiguous ref require a fir.box to carry the byte stride. 221fac349a1SChristian Sigg if (mlir::isa<fir::SequenceType>(resultValueType) && 222ffc3051dSJean Perier !Fortran::evaluate::IsSimplyContiguous( 223ffc3051dSJean Perier designatorNode, getConverter().getFoldingContext())) 224ffc3051dSJean Perier return fir::BoxType::get(resultValueType); 225ffc3051dSJean Perier // Other designators can be handled as raw addresses. 226ffc3051dSJean Perier return fir::ReferenceType::get(resultValueType); 227ffc3051dSJean Perier } 22807b89273SJean Perier 229ffc3051dSJean Perier template <typename T> 230ffc3051dSJean Perier static bool isPolymorphic(const T &designatorNode) { 231ffc3051dSJean Perier if constexpr (!std::is_same_v<T, Fortran::evaluate::Substring>) { 232ffc3051dSJean Perier return Fortran::semantics::IsPolymorphic(designatorNode.GetLastSymbol()); 233ffc3051dSJean Perier } 234ffc3051dSJean Perier return false; 235ffc3051dSJean Perier } 236ffc3051dSJean Perier 237ffc3051dSJean Perier template <typename T> 238ffc3051dSJean Perier /// Generate an hlfir.designate for a part-ref given a filled PartInfo and the 239ffc3051dSJean Perier /// FIR type for this part-ref. 240ffc3051dSJean Perier fir::FortranVariableOpInterface genDesignate(mlir::Type resultValueType, 241ffc3051dSJean Perier PartInfo &partInfo, 242ffc3051dSJean Perier const T &designatorNode) { 243ffc3051dSJean Perier mlir::Type designatorType = 244ffc3051dSJean Perier computeDesignatorType(resultValueType, partInfo, designatorNode); 2453508f691SJean Perier return genDesignate(designatorType, partInfo, /*attributes=*/{}); 2463508f691SJean Perier } 2473508f691SJean Perier fir::FortranVariableOpInterface 2483508f691SJean Perier genDesignate(mlir::Type designatorType, PartInfo &partInfo, 2493508f691SJean Perier fir::FortranVariableFlagsAttr attributes) { 250583d492cSJean Perier fir::FirOpBuilder &builder = getBuilder(); 251583d492cSJean Perier // Once a part with vector subscripts has been lowered, the following 252583d492cSJean Perier // hlfir.designator (for the parts on the right of the designator) must 253583d492cSJean Perier // be lowered inside the hlfir.elemental_addr because they depend on the 254583d492cSJean Perier // hlfir.elemental_addr indices. 255583d492cSJean Perier // All the subsequent Fortran indices however, should be lowered before 256583d492cSJean Perier // the hlfir.elemental_addr because they should only be evaluated once, 257583d492cSJean Perier // hence, the insertion point is restored outside of the 258583d492cSJean Perier // hlfir.elemental_addr after generating the hlfir.designate. Example: in 259583d492cSJean Perier // "X(VECTOR)%COMP(FOO(), BAR())", the calls to bar() and foo() must be 260583d492cSJean Perier // generated outside of the hlfir.elemental, but the related hlfir.designate 261583d492cSJean Perier // that depends on the scalar hlfir.designate of X(VECTOR) that was 262583d492cSJean Perier // generated inside the hlfir.elemental_addr should be generated in the 263583d492cSJean Perier // hlfir.elemental_addr. 264583d492cSJean Perier if (auto elementalAddrOp = getVectorSubscriptElementAddrOp()) 265583d492cSJean Perier builder.setInsertionPointToEnd(&elementalAddrOp->getBody().front()); 266583d492cSJean Perier auto designate = builder.create<hlfir::DesignateOp>( 267b3bb4dd3SJean Perier getLoc(), designatorType, partInfo.base.value().getBase(), 268ffc3051dSJean Perier partInfo.componentName, partInfo.componentShape, partInfo.subscripts, 269ba45f637SEthan Luis McDonough partInfo.substring, partInfo.complexPart, partInfo.resultShape, 2703508f691SJean Perier partInfo.typeParams, attributes); 271583d492cSJean Perier if (auto elementalAddrOp = getVectorSubscriptElementAddrOp()) 272583d492cSJean Perier builder.setInsertionPoint(*elementalAddrOp); 27307b89273SJean Perier return mlir::cast<fir::FortranVariableOpInterface>( 27407b89273SJean Perier designate.getOperation()); 27507b89273SJean Perier } 27607b89273SJean Perier 27707b89273SJean Perier fir::FortranVariableOpInterface 278fcfb620dSJean Perier gen(const Fortran::evaluate::SymbolRef &symbolRef) { 279c0921586SKazu Hirata if (std::optional<fir::FortranVariableOpInterface> varDef = 280f8843efbSSlava Zakharin getSymMap().lookupVariableDefinition(symbolRef)) { 281f8843efbSSlava Zakharin if (symbolRef->test(Fortran::semantics::Symbol::Flag::CrayPointee)) { 282f8843efbSSlava Zakharin // The pointee is represented with a descriptor inheriting 283f8843efbSSlava Zakharin // the shape and type parameters of the pointee. 284f8843efbSSlava Zakharin // We have to update the base_addr to point to the current 285f8843efbSSlava Zakharin // value of the Cray pointer variable. 286f8843efbSSlava Zakharin fir::FirOpBuilder &builder = getBuilder(); 287f8843efbSSlava Zakharin fir::FortranVariableOpInterface ptrVar = 288de7a50fbSjeanPerier gen(Fortran::semantics::GetCrayPointer(symbolRef)); 289f8843efbSSlava Zakharin mlir::Value ptrAddr = ptrVar.getBase(); 290f8843efbSSlava Zakharin 291f8843efbSSlava Zakharin // Reinterpret the reference to a Cray pointer so that 292f8843efbSSlava Zakharin // we have a pointer-compatible value after loading 293f8843efbSSlava Zakharin // the Cray pointer value. 294f8843efbSSlava Zakharin mlir::Type refPtrType = builder.getRefType( 295f8843efbSSlava Zakharin fir::PointerType::get(fir::dyn_cast_ptrEleTy(ptrAddr.getType()))); 296f8843efbSSlava Zakharin mlir::Value cast = builder.createConvert(loc, refPtrType, ptrAddr); 297f8843efbSSlava Zakharin mlir::Value ptrVal = builder.create<fir::LoadOp>(loc, cast); 298f8843efbSSlava Zakharin 299f8843efbSSlava Zakharin // Update the base_addr to the value of the Cray pointer. 300f8843efbSSlava Zakharin // This is a hacky way to do the update, and it may harm 301f8843efbSSlava Zakharin // performance around Cray pointer references. 302f8843efbSSlava Zakharin // TODO: we should introduce an operation that updates 303f8843efbSSlava Zakharin // just the base_addr of the given box. The CodeGen 304f8843efbSSlava Zakharin // will just convert it into a single store. 305f8843efbSSlava Zakharin fir::runtime::genPointerAssociateScalar(builder, loc, varDef->getBase(), 306f8843efbSSlava Zakharin ptrVal); 307f8843efbSSlava Zakharin } 308c14ef2d7SJean Perier return *varDef; 309f8843efbSSlava Zakharin } 310de7a50fbSjeanPerier llvm::errs() << *symbolRef << "\n"; 311c14ef2d7SJean Perier TODO(getLoc(), "lowering symbol to HLFIR"); 312c14ef2d7SJean Perier } 31307b89273SJean Perier 314ffc3051dSJean Perier fir::FortranVariableOpInterface 315de7a50fbSjeanPerier gen(const Fortran::semantics::Symbol &symbol) { 316de7a50fbSjeanPerier Fortran::evaluate::SymbolRef symref{symbol}; 317de7a50fbSjeanPerier return gen(symref); 318de7a50fbSjeanPerier } 319de7a50fbSjeanPerier 320de7a50fbSjeanPerier fir::FortranVariableOpInterface 321e45f6e93SjeanPerier gen(const Fortran::evaluate::Component &component) { 322b3bb4dd3SJean Perier if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol())) 323b3bb4dd3SJean Perier return genWholeAllocatableOrPointerComponent(component); 324ffc3051dSJean Perier PartInfo partInfo; 325ffc3051dSJean Perier mlir::Type resultType = visit(component, partInfo); 326ffc3051dSJean Perier return genDesignate(resultType, partInfo, component); 327c14ef2d7SJean Perier } 32807b89273SJean Perier 329ffc3051dSJean Perier fir::FortranVariableOpInterface 330ffc3051dSJean Perier gen(const Fortran::evaluate::ArrayRef &arrayRef) { 33107b89273SJean Perier PartInfo partInfo; 33207b89273SJean Perier mlir::Type resultType = visit(arrayRef, partInfo); 333ffc3051dSJean Perier return genDesignate(resultType, partInfo, arrayRef); 334c14ef2d7SJean Perier } 33507b89273SJean Perier 336ffc3051dSJean Perier fir::FortranVariableOpInterface 337fcfb620dSJean Perier gen(const Fortran::evaluate::CoarrayRef &coarrayRef) { 3385db4779cSPete Steinfeld TODO(getLoc(), "coarray: lowering a reference to a coarray object"); 339c14ef2d7SJean Perier } 340ffc3051dSJean Perier 341d0018c95SJean Perier mlir::Type visit(const Fortran::evaluate::CoarrayRef &, PartInfo &) { 3425db4779cSPete Steinfeld TODO(getLoc(), "coarray: lowering a reference to a coarray object"); 343d0018c95SJean Perier } 34407b89273SJean Perier 345ffc3051dSJean Perier fir::FortranVariableOpInterface 346fcfb620dSJean Perier gen(const Fortran::evaluate::ComplexPart &complexPart) { 347ba45f637SEthan Luis McDonough PartInfo partInfo; 348ba45f637SEthan Luis McDonough fir::factory::Complex cmplxHelper(getBuilder(), getLoc()); 349ba45f637SEthan Luis McDonough 350ba45f637SEthan Luis McDonough bool complexBit = 351ba45f637SEthan Luis McDonough complexPart.part() == Fortran::evaluate::ComplexPart::Part::IM; 352ba45f637SEthan Luis McDonough partInfo.complexPart = {complexBit}; 353ba45f637SEthan Luis McDonough 354ba45f637SEthan Luis McDonough mlir::Type resultType = visit(complexPart.complex(), partInfo); 355ba45f637SEthan Luis McDonough 356ba45f637SEthan Luis McDonough // Determine complex part type 357ba45f637SEthan Luis McDonough mlir::Type base = hlfir::getFortranElementType(resultType); 358ba45f637SEthan Luis McDonough mlir::Type cmplxValueType = cmplxHelper.getComplexPartType(base); 359ba45f637SEthan Luis McDonough mlir::Type designatorType = changeElementType(resultType, cmplxValueType); 360ba45f637SEthan Luis McDonough 361ba45f637SEthan Luis McDonough return genDesignate(designatorType, partInfo, complexPart); 362c14ef2d7SJean Perier } 36307b89273SJean Perier 364ffc3051dSJean Perier fir::FortranVariableOpInterface 365fcfb620dSJean Perier gen(const Fortran::evaluate::Substring &substring) { 366d0018c95SJean Perier PartInfo partInfo; 36777d8cfb3SAlexander Shaposhnikov mlir::Type baseStringType = Fortran::common::visit( 368d0018c95SJean Perier [&](const auto &x) { return visit(x, partInfo); }, substring.parent()); 369d0018c95SJean Perier assert(partInfo.typeParams.size() == 1 && "expect base string length"); 370d0018c95SJean Perier // Compute the substring lower and upper bound. 371d0018c95SJean Perier partInfo.substring.push_back(genSubscript(substring.lower())); 372d0018c95SJean Perier if (Fortran::evaluate::MaybeExtentExpr upperBound = substring.upper()) 373d0018c95SJean Perier partInfo.substring.push_back(genSubscript(*upperBound)); 374d0018c95SJean Perier else 375d0018c95SJean Perier partInfo.substring.push_back(partInfo.typeParams[0]); 376d0018c95SJean Perier fir::FirOpBuilder &builder = getBuilder(); 377d0018c95SJean Perier mlir::Location loc = getLoc(); 378d0018c95SJean Perier mlir::Type idxTy = builder.getIndexType(); 379d0018c95SJean Perier partInfo.substring[0] = 380d0018c95SJean Perier builder.createConvert(loc, idxTy, partInfo.substring[0]); 381d0018c95SJean Perier partInfo.substring[1] = 382d0018c95SJean Perier builder.createConvert(loc, idxTy, partInfo.substring[1]); 383d0018c95SJean Perier // Try using constant length if available. mlir::arith folding would 384d0018c95SJean Perier // most likely be able to fold "max(ub-lb+1,0)" too, but getting 385d0018c95SJean Perier // the constant length in the FIR types would be harder. 386d0018c95SJean Perier std::optional<int64_t> cstLen = 387d0018c95SJean Perier Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( 388d0018c95SJean Perier getConverter().getFoldingContext(), substring.LEN())); 389d0018c95SJean Perier if (cstLen) { 390d0018c95SJean Perier partInfo.typeParams[0] = 391d0018c95SJean Perier builder.createIntegerConstant(loc, idxTy, *cstLen); 392d0018c95SJean Perier } else { 393d0018c95SJean Perier // Compute "len = max(ub-lb+1,0)" (Fortran 2018 9.4.1). 394d0018c95SJean Perier mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); 395d0018c95SJean Perier auto boundsDiff = builder.create<mlir::arith::SubIOp>( 396d0018c95SJean Perier loc, partInfo.substring[1], partInfo.substring[0]); 397d0018c95SJean Perier auto rawLen = builder.create<mlir::arith::AddIOp>(loc, boundsDiff, one); 398d0018c95SJean Perier partInfo.typeParams[0] = 399d0018c95SJean Perier fir::factory::genMaxWithZero(builder, loc, rawLen); 400d0018c95SJean Perier } 401fac349a1SChristian Sigg auto kind = mlir::cast<fir::CharacterType>( 402fac349a1SChristian Sigg hlfir::getFortranElementType(baseStringType)) 403ffc3051dSJean Perier .getFKind(); 404ffc3051dSJean Perier auto newCharTy = fir::CharacterType::get( 405ffc3051dSJean Perier baseStringType.getContext(), kind, 406d0018c95SJean Perier cstLen ? *cstLen : fir::CharacterType::unknownLen()); 407ffc3051dSJean Perier mlir::Type resultType = changeElementType(baseStringType, newCharTy); 408ffc3051dSJean Perier return genDesignate(resultType, partInfo, substring); 409d0018c95SJean Perier } 410d0018c95SJean Perier 411ffc3051dSJean Perier static mlir::Type changeElementType(mlir::Type type, mlir::Type newEleTy) { 412d0018c95SJean Perier return llvm::TypeSwitch<mlir::Type, mlir::Type>(type) 413d0018c95SJean Perier .Case<fir::SequenceType>([&](fir::SequenceType seqTy) -> mlir::Type { 414ffc3051dSJean Perier return fir::SequenceType::get(seqTy.getShape(), newEleTy); 415d0018c95SJean Perier }) 416a49f630cSjeanPerier .Case<fir::PointerType, fir::HeapType, fir::ReferenceType, fir::BoxType, 417a49f630cSjeanPerier fir::ClassType>([&](auto t) -> mlir::Type { 418d0018c95SJean Perier using FIRT = decltype(t); 419ffc3051dSJean Perier return FIRT::get(changeElementType(t.getEleTy(), newEleTy)); 420d0018c95SJean Perier }) 421ffc3051dSJean Perier .Default([newEleTy](mlir::Type t) -> mlir::Type { return newEleTy; }); 422d0018c95SJean Perier } 423d0018c95SJean Perier 424b3bb4dd3SJean Perier fir::FortranVariableOpInterface genWholeAllocatableOrPointerComponent( 425b3bb4dd3SJean Perier const Fortran::evaluate::Component &component) { 426b3bb4dd3SJean Perier // Generate whole allocatable or pointer component reference. The 427b3bb4dd3SJean Perier // hlfir.designate result will be a pointer/allocatable. 428b3bb4dd3SJean Perier PartInfo partInfo; 429b3bb4dd3SJean Perier mlir::Type componentType = visitComponentImpl(component, partInfo).second; 430b3bb4dd3SJean Perier mlir::Type designatorType = fir::ReferenceType::get(componentType); 431b3bb4dd3SJean Perier fir::FortranVariableFlagsAttr attributes = 432b3bb4dd3SJean Perier Fortran::lower::translateSymbolAttributes(getBuilder().getContext(), 433b3bb4dd3SJean Perier component.GetLastSymbol()); 434b3bb4dd3SJean Perier return genDesignate(designatorType, partInfo, attributes); 435b3bb4dd3SJean Perier } 436b3bb4dd3SJean Perier 437d0018c95SJean Perier mlir::Type visit(const Fortran::evaluate::DataRef &dataRef, 438d0018c95SJean Perier PartInfo &partInfo) { 43977d8cfb3SAlexander Shaposhnikov return Fortran::common::visit( 44077d8cfb3SAlexander Shaposhnikov [&](const auto &x) { return visit(x, partInfo); }, dataRef.u); 441d0018c95SJean Perier } 442d0018c95SJean Perier 443d0018c95SJean Perier mlir::Type 444d0018c95SJean Perier visit(const Fortran::evaluate::StaticDataObject::Pointer &staticObject, 445d0018c95SJean Perier PartInfo &partInfo) { 446d0018c95SJean Perier fir::FirOpBuilder &builder = getBuilder(); 447d0018c95SJean Perier mlir::Location loc = getLoc(); 448d0018c95SJean Perier std::optional<std::string> string = staticObject->AsString(); 449d0018c95SJean Perier // TODO: see if StaticDataObject can be replaced by something based on 450d0018c95SJean Perier // Constant<T> to avoid dealing with endianness here for KIND>1. 451d0018c95SJean Perier // This will also avoid making string copies here. 452d0018c95SJean Perier if (!string) 453d0018c95SJean Perier TODO(loc, "StaticDataObject::Pointer substring with kind > 1"); 454d0018c95SJean Perier fir::ExtendedValue exv = 455d0018c95SJean Perier fir::factory::createStringLiteral(builder, getLoc(), *string); 456d0018c95SJean Perier auto flags = fir::FortranVariableFlagsAttr::get( 457d0018c95SJean Perier builder.getContext(), fir::FortranVariableFlagsEnum::parameter); 458d0018c95SJean Perier partInfo.base = hlfir::genDeclare(loc, builder, exv, ".stringlit", flags); 459d0018c95SJean Perier partInfo.typeParams.push_back(fir::getLen(exv)); 460b3bb4dd3SJean Perier return partInfo.base->getElementOrSequenceType(); 461c14ef2d7SJean Perier } 462c14ef2d7SJean Perier 46307b89273SJean Perier mlir::Type visit(const Fortran::evaluate::SymbolRef &symbolRef, 46407b89273SJean Perier PartInfo &partInfo) { 465b3bb4dd3SJean Perier // A symbol is only visited if there is a following array, substring, or 466b3bb4dd3SJean Perier // complex reference. If the entity is a pointer or allocatable, this 467b3bb4dd3SJean Perier // reference designates the target, so the pointer, allocatable must be 468b3bb4dd3SJean Perier // dereferenced here. 469b3bb4dd3SJean Perier partInfo.base = 470b3bb4dd3SJean Perier hlfir::derefPointersAndAllocatables(loc, getBuilder(), gen(symbolRef)); 471b3bb4dd3SJean Perier hlfir::genLengthParameters(loc, getBuilder(), *partInfo.base, 47207b89273SJean Perier partInfo.typeParams); 473b3bb4dd3SJean Perier return partInfo.base->getElementOrSequenceType(); 47407b89273SJean Perier } 47507b89273SJean Perier 47607b89273SJean Perier mlir::Type visit(const Fortran::evaluate::ArrayRef &arrayRef, 47707b89273SJean Perier PartInfo &partInfo) { 47807b89273SJean Perier mlir::Type baseType; 479b3bb4dd3SJean Perier if (const auto *component = arrayRef.base().UnwrapComponent()) { 480b3bb4dd3SJean Perier // Pointers and allocatable components must be dereferenced since the 481b3bb4dd3SJean Perier // array ref designates the target (this is done in "visit"). Other 482b3bb4dd3SJean Perier // components need special care to deal with the array%array_comp(indices) 483b3bb4dd3SJean Perier // case. 484031b4e5eSPeter Klausler if (Fortran::semantics::IsAllocatableOrObjectPointer( 485031b4e5eSPeter Klausler &component->GetLastSymbol())) 486b3bb4dd3SJean Perier baseType = visit(*component, partInfo); 487b3bb4dd3SJean Perier else 4883508f691SJean Perier baseType = hlfir::getFortranElementOrSequenceType( 4893508f691SJean Perier visitComponentImpl(*component, partInfo).second); 490b3bb4dd3SJean Perier } else { 49107b89273SJean Perier baseType = visit(arrayRef.base().GetLastSymbol(), partInfo); 492b3bb4dd3SJean Perier } 49307b89273SJean Perier 49407b89273SJean Perier fir::FirOpBuilder &builder = getBuilder(); 49507b89273SJean Perier mlir::Location loc = getLoc(); 49607b89273SJean Perier mlir::Type idxTy = builder.getIndexType(); 49707b89273SJean Perier llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> bounds; 498ffc3051dSJean Perier auto getBaseBounds = [&](unsigned i) { 499ffc3051dSJean Perier if (bounds.empty()) { 500ffc3051dSJean Perier if (partInfo.componentName.empty()) { 501b3bb4dd3SJean Perier bounds = hlfir::genBounds(loc, builder, partInfo.base.value()); 502ffc3051dSJean Perier } else { 503ffc3051dSJean Perier assert( 504ffc3051dSJean Perier partInfo.componentShape && 505ffc3051dSJean Perier "implicit array section bounds must come from component shape"); 506ffc3051dSJean Perier bounds = hlfir::genBounds(loc, builder, partInfo.componentShape); 507ffc3051dSJean Perier } 508ffc3051dSJean Perier assert(!bounds.empty() && 509ffc3051dSJean Perier "failed to compute implicit array section bounds"); 510ffc3051dSJean Perier } 51107b89273SJean Perier return bounds[i]; 51207b89273SJean Perier }; 51307b89273SJean Perier auto frontEndResultShape = 51407b89273SJean Perier Fortran::evaluate::GetShape(converter.getFoldingContext(), arrayRef); 515583d492cSJean Perier auto tryGettingExtentFromFrontEnd = 516583d492cSJean Perier [&](unsigned dim) -> std::pair<mlir::Value, fir::SequenceType::Extent> { 517583d492cSJean Perier // Use constant extent if possible. The main advantage to do this now 518583d492cSJean Perier // is to get the best FIR array types as possible while lowering. 519583d492cSJean Perier if (frontEndResultShape) 520583d492cSJean Perier if (auto maybeI64 = 521583d492cSJean Perier Fortran::evaluate::ToInt64(frontEndResultShape->at(dim))) 522583d492cSJean Perier return {builder.createIntegerConstant(loc, idxTy, *maybeI64), 523583d492cSJean Perier *maybeI64}; 524583d492cSJean Perier return {mlir::Value{}, fir::SequenceType::getUnknownExtent()}; 525583d492cSJean Perier }; 52607b89273SJean Perier llvm::SmallVector<mlir::Value> resultExtents; 52707b89273SJean Perier fir::SequenceType::Shape resultTypeShape; 528583d492cSJean Perier bool sawVectorSubscripts = false; 52907b89273SJean Perier for (auto subscript : llvm::enumerate(arrayRef.subscript())) { 53007b89273SJean Perier if (const auto *triplet = 53107b89273SJean Perier std::get_if<Fortran::evaluate::Triplet>(&subscript.value().u)) { 53207b89273SJean Perier mlir::Value lb, ub; 53307b89273SJean Perier if (const auto &lbExpr = triplet->lower()) 53407b89273SJean Perier lb = genSubscript(*lbExpr); 53507b89273SJean Perier else 536ffc3051dSJean Perier lb = getBaseBounds(subscript.index()).first; 53707b89273SJean Perier if (const auto &ubExpr = triplet->upper()) 53807b89273SJean Perier ub = genSubscript(*ubExpr); 53907b89273SJean Perier else 540ffc3051dSJean Perier ub = getBaseBounds(subscript.index()).second; 54107b89273SJean Perier lb = builder.createConvert(loc, idxTy, lb); 54207b89273SJean Perier ub = builder.createConvert(loc, idxTy, ub); 54307b89273SJean Perier mlir::Value stride = genSubscript(triplet->stride()); 54407b89273SJean Perier stride = builder.createConvert(loc, idxTy, stride); 545583d492cSJean Perier auto [extentValue, shapeExtent] = 546583d492cSJean Perier tryGettingExtentFromFrontEnd(resultExtents.size()); 547583d492cSJean Perier resultTypeShape.push_back(shapeExtent); 548583d492cSJean Perier if (!extentValue) 549583d492cSJean Perier extentValue = 550583d492cSJean Perier builder.genExtentFromTriplet(loc, lb, ub, stride, idxTy); 551583d492cSJean Perier resultExtents.push_back(extentValue); 55207b89273SJean Perier partInfo.subscripts.emplace_back( 55307b89273SJean Perier hlfir::DesignateOp::Triplet{lb, ub, stride}); 55407b89273SJean Perier } else { 55507b89273SJean Perier const auto &expr = 55607b89273SJean Perier std::get<Fortran::evaluate::IndirectSubscriptIntegerExpr>( 55707b89273SJean Perier subscript.value().u) 55807b89273SJean Perier .value(); 559583d492cSJean Perier hlfir::Entity subscript = genSubscript(expr); 560583d492cSJean Perier partInfo.subscripts.push_back(subscript); 561583d492cSJean Perier if (expr.Rank() > 0) { 562583d492cSJean Perier sawVectorSubscripts = true; 563583d492cSJean Perier auto [extentValue, shapeExtent] = 564583d492cSJean Perier tryGettingExtentFromFrontEnd(resultExtents.size()); 565583d492cSJean Perier resultTypeShape.push_back(shapeExtent); 566583d492cSJean Perier if (!extentValue) 567583d492cSJean Perier extentValue = hlfir::genExtent(loc, builder, subscript, /*dim=*/0); 568583d492cSJean Perier resultExtents.push_back(extentValue); 56907b89273SJean Perier } 57007b89273SJean Perier } 571583d492cSJean Perier } 57207b89273SJean Perier assert(resultExtents.size() == resultTypeShape.size() && 57307b89273SJean Perier "inconsistent hlfir.designate shape"); 574583d492cSJean Perier 575583d492cSJean Perier // For vector subscripts, create an hlfir.elemental_addr and continue 576583d492cSJean Perier // lowering the designator inside it as if it was addressing an element of 577583d492cSJean Perier // the vector subscripts. 578583d492cSJean Perier if (sawVectorSubscripts) 579583d492cSJean Perier return createVectorSubscriptElementAddrOp(partInfo, baseType, 580583d492cSJean Perier resultExtents); 581583d492cSJean Perier 582e6a4346bSScott Manley mlir::Type resultType = 583e6a4346bSScott Manley mlir::cast<fir::SequenceType>(baseType).getElementType(); 58407b89273SJean Perier if (!resultTypeShape.empty()) { 585ffc3051dSJean Perier // Ranked array section. The result shape comes from the array section 586ffc3051dSJean Perier // subscripts. 58707b89273SJean Perier resultType = fir::SequenceType::get(resultTypeShape, resultType); 588ffc3051dSJean Perier assert(!partInfo.resultShape && 589ffc3051dSJean Perier "Fortran designator can only have one ranked part"); 59007b89273SJean Perier partInfo.resultShape = builder.genShape(loc, resultExtents); 591b3bb4dd3SJean Perier } else if (!partInfo.componentName.empty() && 592b3bb4dd3SJean Perier partInfo.base.value().isArray()) { 593ffc3051dSJean Perier // This is an array%array_comp(indices) reference. Keep the 594ffc3051dSJean Perier // shape of the base array and not the array_comp. 595b3bb4dd3SJean Perier auto compBaseTy = partInfo.base->getElementOrSequenceType(); 596ffc3051dSJean Perier resultType = changeElementType(compBaseTy, resultType); 597ffc3051dSJean Perier assert(!partInfo.resultShape && "should not have been computed already"); 598b3bb4dd3SJean Perier partInfo.resultShape = hlfir::genShape(loc, builder, *partInfo.base); 59907b89273SJean Perier } 60007b89273SJean Perier return resultType; 60107b89273SJean Perier } 60207b89273SJean Perier 603ffc3051dSJean Perier static bool 604f917c396SjeanPerier mayHaveNonDefaultLowerBounds(const Fortran::semantics::Symbol &componentSym) { 605ffc3051dSJean Perier if (const auto *objDetails = 606ffc3051dSJean Perier componentSym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) 607ffc3051dSJean Perier for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape()) 608ffc3051dSJean Perier if (auto lb = bounds.lbound().GetExplicit()) 609ffc3051dSJean Perier if (auto constant = Fortran::evaluate::ToInt64(*lb)) 610ffc3051dSJean Perier if (!constant || *constant != 1) 611ffc3051dSJean Perier return true; 612ffc3051dSJean Perier return false; 613ffc3051dSJean Perier } 614f917c396SjeanPerier static bool mayHaveNonDefaultLowerBounds(const PartInfo &partInfo) { 615ffc3051dSJean Perier return partInfo.resultShape && 616fac349a1SChristian Sigg mlir::isa<fir::ShiftType, fir::ShapeShiftType>( 617fac349a1SChristian Sigg partInfo.resultShape.getType()); 618ffc3051dSJean Perier } 619ffc3051dSJean Perier 62007b89273SJean Perier mlir::Type visit(const Fortran::evaluate::Component &component, 62107b89273SJean Perier PartInfo &partInfo) { 622b3bb4dd3SJean Perier if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol())) { 623b3bb4dd3SJean Perier // In a visit, the following reference will address the target. Insert 624b3bb4dd3SJean Perier // the dereference here. 625b3bb4dd3SJean Perier partInfo.base = genWholeAllocatableOrPointerComponent(component); 626b3bb4dd3SJean Perier partInfo.base = hlfir::derefPointersAndAllocatables(loc, getBuilder(), 627b3bb4dd3SJean Perier *partInfo.base); 628b3bb4dd3SJean Perier hlfir::genLengthParameters(loc, getBuilder(), *partInfo.base, 629b3bb4dd3SJean Perier partInfo.typeParams); 630b3bb4dd3SJean Perier return partInfo.base->getElementOrSequenceType(); 631b3bb4dd3SJean Perier } 632b3bb4dd3SJean Perier // This function must be called from contexts where the component is not the 633b3bb4dd3SJean Perier // base of an ArrayRef. In these cases, the component cannot be an array 634b3bb4dd3SJean Perier // if the base is an array. The code below determines the shape of the 635b3bb4dd3SJean Perier // component reference if any. 636ffc3051dSJean Perier auto [baseType, componentType] = visitComponentImpl(component, partInfo); 6373508f691SJean Perier mlir::Type componentBaseType = 6383508f691SJean Perier hlfir::getFortranElementOrSequenceType(componentType); 639b3bb4dd3SJean Perier if (partInfo.base.value().isArray()) { 640ffc3051dSJean Perier // For array%scalar_comp, the result shape is 641ffc3051dSJean Perier // the one of the base. Compute it here. Note that the lower bounds of the 642ffc3051dSJean Perier // base are not the ones of the resulting reference (that are default 643ffc3051dSJean Perier // ones). 644b3bb4dd3SJean Perier partInfo.resultShape = hlfir::genShape(loc, getBuilder(), *partInfo.base); 645ffc3051dSJean Perier assert(!partInfo.componentShape && 646ffc3051dSJean Perier "Fortran designators can only have one ranked part"); 6473508f691SJean Perier return changeElementType(baseType, componentBaseType); 648ffc3051dSJean Perier } 649f809bf2bSSlava Zakharin 650f809bf2bSSlava Zakharin if (partInfo.complexPart && partInfo.componentShape) { 651f809bf2bSSlava Zakharin // Treat ...array_comp%im/re as ...array_comp(:,:,...)%im/re 652f809bf2bSSlava Zakharin // so that the codegen has the full slice triples for the component 653f809bf2bSSlava Zakharin // readily available. 654f809bf2bSSlava Zakharin fir::FirOpBuilder &builder = getBuilder(); 655f809bf2bSSlava Zakharin mlir::Type idxTy = builder.getIndexType(); 656f809bf2bSSlava Zakharin mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); 657f809bf2bSSlava Zakharin 658f809bf2bSSlava Zakharin llvm::SmallVector<mlir::Value> resultExtents; 659f809bf2bSSlava Zakharin // Collect <lb, ub> pairs from the component shape. 660f809bf2bSSlava Zakharin auto bounds = hlfir::genBounds(loc, builder, partInfo.componentShape); 661f809bf2bSSlava Zakharin for (auto &boundPair : bounds) { 662f809bf2bSSlava Zakharin // The default subscripts are <lb, ub, 1>: 663f809bf2bSSlava Zakharin partInfo.subscripts.emplace_back(hlfir::DesignateOp::Triplet{ 664f809bf2bSSlava Zakharin boundPair.first, boundPair.second, one}); 665f809bf2bSSlava Zakharin auto extentValue = builder.genExtentFromTriplet( 666f809bf2bSSlava Zakharin loc, boundPair.first, boundPair.second, one, idxTy); 667f809bf2bSSlava Zakharin resultExtents.push_back(extentValue); 668f809bf2bSSlava Zakharin } 669f809bf2bSSlava Zakharin // The result shape is: <max((ub - lb + 1) / 1, 0), ...>. 670f809bf2bSSlava Zakharin partInfo.resultShape = builder.genShape(loc, resultExtents); 671f809bf2bSSlava Zakharin return componentBaseType; 672f809bf2bSSlava Zakharin } 673f809bf2bSSlava Zakharin 674ffc3051dSJean Perier // scalar%array_comp or scalar%scalar. In any case the shape of this 675ffc3051dSJean Perier // part-ref is coming from the component. 676ffc3051dSJean Perier partInfo.resultShape = partInfo.componentShape; 677ffc3051dSJean Perier partInfo.componentShape = {}; 6783508f691SJean Perier return componentBaseType; 679ffc3051dSJean Perier } 680ffc3051dSJean Perier 681ffc3051dSJean Perier // Returns the <BaseType, ComponentType> pair, computes partInfo.base, 682ffc3051dSJean Perier // partInfo.componentShape and partInfo.typeParams, but does not set the 683ffc3051dSJean Perier // partInfo.resultShape yet. The result shape will be computed after 684ffc3051dSJean Perier // processing a following ArrayRef, if any, and in "visit" otherwise. 685ffc3051dSJean Perier std::pair<mlir::Type, mlir::Type> 686ffc3051dSJean Perier visitComponentImpl(const Fortran::evaluate::Component &component, 687b3bb4dd3SJean Perier PartInfo &partInfo) { 688ffc3051dSJean Perier fir::FirOpBuilder &builder = getBuilder(); 689ffc3051dSJean Perier // Break the Designator visit here: if the base is an array-ref, a 690ffc3051dSJean Perier // coarray-ref, or another component, this creates another hlfir.designate 691ffc3051dSJean Perier // for it. hlfir.designate is not meant to represent more than one 692ffc3051dSJean Perier // part-ref. 693e45f6e93SjeanPerier partInfo.base = gen(component.base()); 694b3bb4dd3SJean Perier // If the base is an allocatable/pointer, dereference it here since the 695b3bb4dd3SJean Perier // component ref designates its target. 696b3bb4dd3SJean Perier partInfo.base = 697b3bb4dd3SJean Perier hlfir::derefPointersAndAllocatables(loc, builder, *partInfo.base); 698ffc3051dSJean Perier assert(partInfo.typeParams.empty() && "should not have been computed yet"); 699b3bb4dd3SJean Perier 700b3bb4dd3SJean Perier hlfir::genLengthParameters(getLoc(), getBuilder(), *partInfo.base, 701ffc3051dSJean Perier partInfo.typeParams); 702b3bb4dd3SJean Perier mlir::Type baseType = partInfo.base->getElementOrSequenceType(); 703ffc3051dSJean Perier 704ffc3051dSJean Perier // Lower the information about the component (type, length parameters and 705ffc3051dSJean Perier // shape). 706ffc3051dSJean Perier const Fortran::semantics::Symbol &componentSym = component.GetLastSymbol(); 70799a54b83SjeanPerier partInfo.componentName = converter.getRecordTypeFieldName(componentSym); 708ffc3051dSJean Perier auto recordType = 709fac349a1SChristian Sigg mlir::cast<fir::RecordType>(hlfir::getFortranElementType(baseType)); 710ffc3051dSJean Perier if (recordType.isDependentType()) 711ffc3051dSJean Perier TODO(getLoc(), "Designate derived type with length parameters in HLFIR"); 712ffc3051dSJean Perier mlir::Type fieldType = recordType.getType(partInfo.componentName); 7132d46264cSJean Perier assert(fieldType && "component name is not known"); 7143508f691SJean Perier mlir::Type fieldBaseType = 7153508f691SJean Perier hlfir::getFortranElementOrSequenceType(fieldType); 7163508f691SJean Perier partInfo.componentShape = genComponentShape(componentSym, fieldBaseType); 717ffc3051dSJean Perier 7183508f691SJean Perier mlir::Type fieldEleType = hlfir::getFortranElementType(fieldBaseType); 719ffc3051dSJean Perier if (fir::isRecordWithTypeParameters(fieldEleType)) 720ffc3051dSJean Perier TODO(loc, 721ffc3051dSJean Perier "lower a component that is a parameterized derived type to HLFIR"); 722fac349a1SChristian Sigg if (auto charTy = mlir::dyn_cast<fir::CharacterType>(fieldEleType)) { 723ffc3051dSJean Perier mlir::Location loc = getLoc(); 724ffc3051dSJean Perier mlir::Type idxTy = builder.getIndexType(); 725ffc3051dSJean Perier if (charTy.hasConstantLen()) 726ffc3051dSJean Perier partInfo.typeParams.push_back( 727ffc3051dSJean Perier builder.createIntegerConstant(loc, idxTy, charTy.getLen())); 728031b4e5eSPeter Klausler else if (!Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym)) 729ffc3051dSJean Perier TODO(loc, "compute character length of automatic character component " 730ffc3051dSJean Perier "in a PDT"); 731ffc3051dSJean Perier // Otherwise, the length of the component is deferred and will only 732ffc3051dSJean Perier // be read when the component is dereferenced. 733ffc3051dSJean Perier } 734ffc3051dSJean Perier return {baseType, fieldType}; 73507b89273SJean Perier } 73607b89273SJean Perier 737583d492cSJean Perier // Compute: "lb + (i-1)*step". 738583d492cSJean Perier mlir::Value computeTripletPosition(mlir::Location loc, 739583d492cSJean Perier fir::FirOpBuilder &builder, 740583d492cSJean Perier hlfir::DesignateOp::Triplet &triplet, 741583d492cSJean Perier mlir::Value oneBasedIndex) { 742583d492cSJean Perier mlir::Type idxTy = builder.getIndexType(); 743583d492cSJean Perier mlir::Value lb = builder.createConvert(loc, idxTy, std::get<0>(triplet)); 744583d492cSJean Perier mlir::Value step = builder.createConvert(loc, idxTy, std::get<2>(triplet)); 745583d492cSJean Perier mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); 746583d492cSJean Perier oneBasedIndex = builder.createConvert(loc, idxTy, oneBasedIndex); 747583d492cSJean Perier mlir::Value zeroBased = 748583d492cSJean Perier builder.create<mlir::arith::SubIOp>(loc, oneBasedIndex, one); 749583d492cSJean Perier mlir::Value offset = 750583d492cSJean Perier builder.create<mlir::arith::MulIOp>(loc, zeroBased, step); 751583d492cSJean Perier return builder.create<mlir::arith::AddIOp>(loc, lb, offset); 752583d492cSJean Perier } 753583d492cSJean Perier 754583d492cSJean Perier /// Create an hlfir.element_addr operation to deal with vector subscripted 755583d492cSJean Perier /// entities. This transforms the current vector subscripted array-ref into a 756583d492cSJean Perier /// a scalar array-ref that is addressing the vector subscripted part given 757583d492cSJean Perier /// the one based indices of the hlfir.element_addr. 758583d492cSJean Perier /// The rest of the designator lowering will continue lowering any further 759583d492cSJean Perier /// parts inside the hlfir.elemental as a scalar reference. 760583d492cSJean Perier /// At the end of the designator lowering, the hlfir.elemental_addr will 761583d492cSJean Perier /// be turned into an hlfir.elemental value, unless the caller of this 762583d492cSJean Perier /// utility requested to get the hlfir.elemental_addr instead of lowering 763583d492cSJean Perier /// the designator to an mlir::Value. 764583d492cSJean Perier mlir::Type createVectorSubscriptElementAddrOp( 765583d492cSJean Perier PartInfo &partInfo, mlir::Type baseType, 766583d492cSJean Perier llvm::ArrayRef<mlir::Value> resultExtents) { 767583d492cSJean Perier fir::FirOpBuilder &builder = getBuilder(); 768583d492cSJean Perier mlir::Value shape = builder.genShape(loc, resultExtents); 769583d492cSJean Perier // The type parameters to be added on the hlfir.elemental_addr are the ones 770583d492cSJean Perier // of the whole designator (not the ones of the vector subscripted part). 771583d492cSJean Perier // These are not yet known and will be added when finalizing the designator 772583d492cSJean Perier // lowering. 773939f0382SjeanPerier // The resulting designator may be polymorphic, in which case the resulting 774939f0382SjeanPerier // type is the base of the vector subscripted part because 775939f0382SjeanPerier // allocatable/pointer components cannot be referenced after a vector 776939f0382SjeanPerier // subscripted part. Set the mold to the current base. It will be erased if 777939f0382SjeanPerier // the resulting designator is not polymorphic. 778939f0382SjeanPerier assert(partInfo.base.has_value() && 779939f0382SjeanPerier "vector subscripted part must have a base"); 780939f0382SjeanPerier mlir::Value mold = *partInfo.base; 781939f0382SjeanPerier auto elementalAddrOp = builder.create<hlfir::ElementalAddrOp>( 782939f0382SjeanPerier loc, shape, mold, mlir::ValueRange{}, 7837b4aa95dSSlava Zakharin /*isUnordered=*/true); 784583d492cSJean Perier setVectorSubscriptElementAddrOp(elementalAddrOp); 785583d492cSJean Perier builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front()); 786583d492cSJean Perier mlir::Region::BlockArgListType indices = elementalAddrOp.getIndices(); 787583d492cSJean Perier auto indicesIterator = indices.begin(); 788583d492cSJean Perier auto getNextOneBasedIndex = [&]() -> mlir::Value { 789583d492cSJean Perier assert(indicesIterator != indices.end() && "ill formed ElementalAddrOp"); 790583d492cSJean Perier return *(indicesIterator++); 791583d492cSJean Perier }; 792583d492cSJean Perier // Transform the designator into a scalar designator computing the vector 793583d492cSJean Perier // subscripted entity element address given one based indices (for the shape 794583d492cSJean Perier // of the vector subscripted designator). 795583d492cSJean Perier for (hlfir::DesignateOp::Subscript &subscript : partInfo.subscripts) { 796583d492cSJean Perier if (auto *triplet = 797583d492cSJean Perier std::get_if<hlfir::DesignateOp::Triplet>(&subscript)) { 798583d492cSJean Perier // subscript = (lb + (i-1)*step) 799583d492cSJean Perier mlir::Value scalarSubscript = computeTripletPosition( 800583d492cSJean Perier loc, builder, *triplet, getNextOneBasedIndex()); 801583d492cSJean Perier subscript = scalarSubscript; 802583d492cSJean Perier } else { 803583d492cSJean Perier hlfir::Entity valueSubscript{std::get<mlir::Value>(subscript)}; 804583d492cSJean Perier if (valueSubscript.isScalar()) 805583d492cSJean Perier continue; 806583d492cSJean Perier // subscript = vector(i + (vector_lb-1)) 807583d492cSJean Perier hlfir::Entity scalarSubscript = hlfir::getElementAt( 808583d492cSJean Perier loc, builder, valueSubscript, {getNextOneBasedIndex()}); 809583d492cSJean Perier scalarSubscript = 810583d492cSJean Perier hlfir::loadTrivialScalar(loc, builder, scalarSubscript); 811583d492cSJean Perier subscript = scalarSubscript; 812583d492cSJean Perier } 813583d492cSJean Perier } 814583d492cSJean Perier builder.setInsertionPoint(elementalAddrOp); 815e6a4346bSScott Manley return mlir::cast<fir::SequenceType>(baseType).getElementType(); 816583d492cSJean Perier } 817583d492cSJean Perier 818583d492cSJean Perier /// Yield the designator for the final part-ref inside the 819583d492cSJean Perier /// hlfir.elemental_addr. 820583d492cSJean Perier void finalizeElementAddrOp(hlfir::ElementalAddrOp elementalAddrOp, 821583d492cSJean Perier hlfir::EntityWithAttributes elementAddr) { 822583d492cSJean Perier fir::FirOpBuilder &builder = getBuilder(); 823583d492cSJean Perier builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front()); 824939f0382SjeanPerier if (!elementAddr.isPolymorphic()) 825939f0382SjeanPerier elementalAddrOp.getMoldMutable().clear(); 826583d492cSJean Perier builder.create<hlfir::YieldOp>(loc, elementAddr); 827583d492cSJean Perier builder.setInsertionPointAfter(elementalAddrOp); 828583d492cSJean Perier } 829583d492cSJean Perier 830583d492cSJean Perier /// If the lowered designator has vector subscripts turn it into an 831583d492cSJean Perier /// ElementalOp, otherwise, return the lowered designator. This should 832583d492cSJean Perier /// only be called if the user did not request to get the 833583d492cSJean Perier /// hlfir.elemental_addr. In Fortran, vector subscripted designators are only 834583d492cSJean Perier /// writable on the left-hand side of an assignment and in input IO 835583d492cSJean Perier /// statements. Otherwise, they are not variables (cannot be modified, their 836583d492cSJean Perier /// value is taken at the place they appear). 837583d492cSJean Perier hlfir::EntityWithAttributes turnVectorSubscriptedDesignatorIntoValue( 838583d492cSJean Perier hlfir::EntityWithAttributes loweredDesignator) { 839583d492cSJean Perier std::optional<hlfir::ElementalAddrOp> elementalAddrOp = 840583d492cSJean Perier getVectorSubscriptElementAddrOp(); 841583d492cSJean Perier if (!elementalAddrOp) 842583d492cSJean Perier return loweredDesignator; 843583d492cSJean Perier finalizeElementAddrOp(*elementalAddrOp, loweredDesignator); 844583d492cSJean Perier // This vector subscript designator is only being read, transform the 845583d492cSJean Perier // hlfir.elemental_addr into an hlfir.elemental. The content of the 846583d492cSJean Perier // hlfir.elemental_addr is cloned, and the resulting address is loaded to 847583d492cSJean Perier // get the new element value. 848583d492cSJean Perier fir::FirOpBuilder &builder = getBuilder(); 849583d492cSJean Perier mlir::Location loc = getLoc(); 850583d492cSJean Perier mlir::Value elemental = 851583d492cSJean Perier hlfir::cloneToElementalOp(loc, builder, *elementalAddrOp); 852583d492cSJean Perier (*elementalAddrOp)->erase(); 853583d492cSJean Perier setVectorSubscriptElementAddrOp(std::nullopt); 854583d492cSJean Perier fir::FirOpBuilder *bldr = &builder; 855583d492cSJean Perier getStmtCtx().attachCleanup( 856583d492cSJean Perier [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); }); 857583d492cSJean Perier return hlfir::EntityWithAttributes{elemental}; 858583d492cSJean Perier } 859583d492cSJean Perier 860583d492cSJean Perier /// Lower a subscript expression. If it is a scalar subscript that is a 861583d492cSJean Perier /// variable, it is loaded into an integer value. If it is an array (for 862583d492cSJean Perier /// vector subscripts) it is dereferenced if this is an allocatable or 863583d492cSJean Perier /// pointer. 86407b89273SJean Perier template <typename T> 865583d492cSJean Perier hlfir::Entity genSubscript(const Fortran::evaluate::Expr<T> &expr); 866583d492cSJean Perier 867583d492cSJean Perier const std::optional<hlfir::ElementalAddrOp> & 868583d492cSJean Perier getVectorSubscriptElementAddrOp() const { 869583d492cSJean Perier return vectorSubscriptElementAddrOp; 870583d492cSJean Perier } 871583d492cSJean Perier void setVectorSubscriptElementAddrOp( 872583d492cSJean Perier std::optional<hlfir::ElementalAddrOp> elementalAddrOp) { 873583d492cSJean Perier vectorSubscriptElementAddrOp = elementalAddrOp; 874583d492cSJean Perier } 87507b89273SJean Perier 876c14ef2d7SJean Perier mlir::Location getLoc() const { return loc; } 877c14ef2d7SJean Perier Fortran::lower::AbstractConverter &getConverter() { return converter; } 878c14ef2d7SJean Perier fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); } 879c14ef2d7SJean Perier Fortran::lower::SymMap &getSymMap() { return symMap; } 880c14ef2d7SJean Perier Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; } 881c14ef2d7SJean Perier 882c14ef2d7SJean Perier Fortran::lower::AbstractConverter &converter; 883c14ef2d7SJean Perier Fortran::lower::SymMap &symMap; 884c14ef2d7SJean Perier Fortran::lower::StatementContext &stmtCtx; 885583d492cSJean Perier // If there is a vector subscript, an elementalAddrOp is created 886583d492cSJean Perier // to compute the address of the designator elements. 887583d492cSJean Perier std::optional<hlfir::ElementalAddrOp> vectorSubscriptElementAddrOp{}; 888c14ef2d7SJean Perier mlir::Location loc; 889c14ef2d7SJean Perier }; 890c14ef2d7SJean Perier 891c7ff45a5SJean Perier hlfir::EntityWithAttributes HlfirDesignatorBuilder::genDesignatorExpr( 892c7ff45a5SJean Perier const Fortran::lower::SomeExpr &designatorExpr, 893c7ff45a5SJean Perier bool vectorSubscriptDesignatorToValue) { 894c7ff45a5SJean Perier // Expr<SomeType> plumbing to unwrap Designator<T> and call 895c7ff45a5SJean Perier // gen(Designator<T>.u). 89677d8cfb3SAlexander Shaposhnikov return Fortran::common::visit( 897c7ff45a5SJean Perier [&](const auto &x) -> hlfir::EntityWithAttributes { 898c7ff45a5SJean Perier using T = std::decay_t<decltype(x)>; 899c7ff45a5SJean Perier if constexpr (Fortran::common::HasMember< 900c7ff45a5SJean Perier T, Fortran::lower::CategoryExpression>) { 901c7ff45a5SJean Perier if constexpr (T::Result::category == 902c7ff45a5SJean Perier Fortran::common::TypeCategory::Derived) { 903c7ff45a5SJean Perier return gen(std::get<Fortran::evaluate::Designator< 904c7ff45a5SJean Perier Fortran::evaluate::SomeDerived>>(x.u) 905c7ff45a5SJean Perier .u, 906c7ff45a5SJean Perier vectorSubscriptDesignatorToValue); 907c7ff45a5SJean Perier } else { 90877d8cfb3SAlexander Shaposhnikov return Fortran::common::visit( 909c7ff45a5SJean Perier [&](const auto &preciseKind) { 910c7ff45a5SJean Perier using TK = 911c7ff45a5SJean Perier typename std::decay_t<decltype(preciseKind)>::Result; 912c7ff45a5SJean Perier return gen( 913c7ff45a5SJean Perier std::get<Fortran::evaluate::Designator<TK>>(preciseKind.u) 914c7ff45a5SJean Perier .u, 915c7ff45a5SJean Perier vectorSubscriptDesignatorToValue); 916c7ff45a5SJean Perier }, 917c7ff45a5SJean Perier x.u); 918c7ff45a5SJean Perier } 919c7ff45a5SJean Perier } else { 920c7ff45a5SJean Perier fir::emitFatalError(loc, "unexpected typeless Designator"); 921c7ff45a5SJean Perier } 922c7ff45a5SJean Perier }, 923c7ff45a5SJean Perier designatorExpr.u); 924c7ff45a5SJean Perier } 925c7ff45a5SJean Perier 926c7ff45a5SJean Perier hlfir::ElementalAddrOp 927c7ff45a5SJean Perier HlfirDesignatorBuilder::convertVectorSubscriptedExprToElementalAddr( 928c7ff45a5SJean Perier const Fortran::lower::SomeExpr &designatorExpr) { 929c7ff45a5SJean Perier 930c7ff45a5SJean Perier hlfir::EntityWithAttributes elementAddrEntity = genDesignatorExpr( 931c7ff45a5SJean Perier designatorExpr, /*vectorSubscriptDesignatorToValue=*/false); 932c7ff45a5SJean Perier assert(getVectorSubscriptElementAddrOp().has_value() && 933c7ff45a5SJean Perier "expected vector subscripts"); 934c7ff45a5SJean Perier hlfir::ElementalAddrOp elementalAddrOp = *getVectorSubscriptElementAddrOp(); 935c7ff45a5SJean Perier // Now that the type parameters have been computed, add then to the 936c7ff45a5SJean Perier // hlfir.elemental_addr. 937c7ff45a5SJean Perier fir::FirOpBuilder &builder = getBuilder(); 938c7ff45a5SJean Perier llvm::SmallVector<mlir::Value, 1> lengths; 939c7ff45a5SJean Perier hlfir::genLengthParameters(loc, builder, elementAddrEntity, lengths); 940c7ff45a5SJean Perier if (!lengths.empty()) 941c7ff45a5SJean Perier elementalAddrOp.getTypeparamsMutable().assign(lengths); 942939f0382SjeanPerier if (!elementAddrEntity.isPolymorphic()) 943939f0382SjeanPerier elementalAddrOp.getMoldMutable().clear(); 944c7ff45a5SJean Perier // Create the hlfir.yield terminator inside the hlfir.elemental_body. 945c7ff45a5SJean Perier builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front()); 946c7ff45a5SJean Perier builder.create<hlfir::YieldOp>(loc, elementAddrEntity); 947c7ff45a5SJean Perier builder.setInsertionPointAfter(elementalAddrOp); 948c7ff45a5SJean Perier // Reset the HlfirDesignatorBuilder state, in case it is used on a new 949c7ff45a5SJean Perier // designator. 950c7ff45a5SJean Perier setVectorSubscriptElementAddrOp(std::nullopt); 951c7ff45a5SJean Perier return elementalAddrOp; 952c7ff45a5SJean Perier } 953c7ff45a5SJean Perier 954440e9baaSJean Perier //===--------------------------------------------------------------------===// 955440e9baaSJean Perier // Binary Operation implementation 956440e9baaSJean Perier //===--------------------------------------------------------------------===// 957440e9baaSJean Perier 958440e9baaSJean Perier template <typename T> 959fed3d272SJean Perier struct BinaryOp {}; 960440e9baaSJean Perier 961440e9baaSJean Perier #undef GENBIN 962440e9baaSJean Perier #define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp) \ 963440e9baaSJean Perier template <int KIND> \ 964440e9baaSJean Perier struct BinaryOp<Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type< \ 965440e9baaSJean Perier Fortran::common::TypeCategory::GenBinTyCat, KIND>>> { \ 966991a90a0SJean Perier using Op = Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type< \ 967991a90a0SJean Perier Fortran::common::TypeCategory::GenBinTyCat, KIND>>; \ 968440e9baaSJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, \ 969440e9baaSJean Perier fir::FirOpBuilder &builder, \ 970991a90a0SJean Perier const Op &, hlfir::Entity lhs, \ 971440e9baaSJean Perier hlfir::Entity rhs) { \ 972*fc97d2e6SPeter Klausler if constexpr (Fortran::common::TypeCategory::GenBinTyCat == \ 973*fc97d2e6SPeter Klausler Fortran::common::TypeCategory::Unsigned) { \ 974*fc97d2e6SPeter Klausler return hlfir::EntityWithAttributes{ \ 975*fc97d2e6SPeter Klausler builder.createUnsigned<GenBinFirOp>(loc, lhs.getType(), lhs, \ 976*fc97d2e6SPeter Klausler rhs)}; \ 977*fc97d2e6SPeter Klausler } else { \ 978440e9baaSJean Perier return hlfir::EntityWithAttributes{ \ 979440e9baaSJean Perier builder.create<GenBinFirOp>(loc, lhs, rhs)}; \ 980440e9baaSJean Perier } \ 981*fc97d2e6SPeter Klausler } \ 982440e9baaSJean Perier }; 983440e9baaSJean Perier 984440e9baaSJean Perier GENBIN(Add, Integer, mlir::arith::AddIOp) 985*fc97d2e6SPeter Klausler GENBIN(Add, Unsigned, mlir::arith::AddIOp) 986440e9baaSJean Perier GENBIN(Add, Real, mlir::arith::AddFOp) 987440e9baaSJean Perier GENBIN(Add, Complex, fir::AddcOp) 988440e9baaSJean Perier GENBIN(Subtract, Integer, mlir::arith::SubIOp) 989*fc97d2e6SPeter Klausler GENBIN(Subtract, Unsigned, mlir::arith::SubIOp) 990440e9baaSJean Perier GENBIN(Subtract, Real, mlir::arith::SubFOp) 991440e9baaSJean Perier GENBIN(Subtract, Complex, fir::SubcOp) 992440e9baaSJean Perier GENBIN(Multiply, Integer, mlir::arith::MulIOp) 993*fc97d2e6SPeter Klausler GENBIN(Multiply, Unsigned, mlir::arith::MulIOp) 994440e9baaSJean Perier GENBIN(Multiply, Real, mlir::arith::MulFOp) 995440e9baaSJean Perier GENBIN(Multiply, Complex, fir::MulcOp) 996440e9baaSJean Perier GENBIN(Divide, Integer, mlir::arith::DivSIOp) 997*fc97d2e6SPeter Klausler GENBIN(Divide, Unsigned, mlir::arith::DivUIOp) 998440e9baaSJean Perier GENBIN(Divide, Real, mlir::arith::DivFOp) 999c3a0df19SKiran Chandramohan 1000c3a0df19SKiran Chandramohan template <int KIND> 1001c3a0df19SKiran Chandramohan struct BinaryOp<Fortran::evaluate::Divide< 1002c3a0df19SKiran Chandramohan Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> { 1003c3a0df19SKiran Chandramohan using Op = Fortran::evaluate::Divide< 1004c3a0df19SKiran Chandramohan Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>; 1005c3a0df19SKiran Chandramohan static hlfir::EntityWithAttributes gen(mlir::Location loc, 1006c3a0df19SKiran Chandramohan fir::FirOpBuilder &builder, const Op &, 1007c3a0df19SKiran Chandramohan hlfir::Entity lhs, hlfir::Entity rhs) { 1008c3a0df19SKiran Chandramohan mlir::Type ty = Fortran::lower::getFIRType( 1009c3a0df19SKiran Chandramohan builder.getContext(), Fortran::common::TypeCategory::Complex, KIND, 1010c3a0df19SKiran Chandramohan /*params=*/std::nullopt); 1011c3a0df19SKiran Chandramohan return hlfir::EntityWithAttributes{ 1012c3a0df19SKiran Chandramohan fir::genDivC(builder, loc, ty, lhs, rhs)}; 1013c3a0df19SKiran Chandramohan } 1014c3a0df19SKiran Chandramohan }; 1015440e9baaSJean Perier 101689af7de9SJean Perier template <Fortran::common::TypeCategory TC, int KIND> 101789af7de9SJean Perier struct BinaryOp<Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>> { 1018991a90a0SJean Perier using Op = Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>; 101989af7de9SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1020655d994aSJean Perier fir::FirOpBuilder &builder, const Op &, 1021655d994aSJean Perier hlfir::Entity lhs, hlfir::Entity rhs) { 102289af7de9SJean Perier mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND, 10239a417395SKazu Hirata /*params=*/std::nullopt); 10246dcb31deSTom Eccles return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)}; 102589af7de9SJean Perier } 102689af7de9SJean Perier }; 102789af7de9SJean Perier 102889af7de9SJean Perier template <Fortran::common::TypeCategory TC, int KIND> 102989af7de9SJean Perier struct BinaryOp< 103089af7de9SJean Perier Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>> { 1031991a90a0SJean Perier using Op = 1032991a90a0SJean Perier Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>; 103389af7de9SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1034655d994aSJean Perier fir::FirOpBuilder &builder, const Op &, 1035655d994aSJean Perier hlfir::Entity lhs, hlfir::Entity rhs) { 103689af7de9SJean Perier mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND, 10379a417395SKazu Hirata /*params=*/std::nullopt); 10386dcb31deSTom Eccles return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)}; 103989af7de9SJean Perier } 104089af7de9SJean Perier }; 104189af7de9SJean Perier 1042991a90a0SJean Perier template <Fortran::common::TypeCategory TC, int KIND> 1043991a90a0SJean Perier struct BinaryOp< 1044991a90a0SJean Perier Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>> { 1045991a90a0SJean Perier using Op = Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>; 1046991a90a0SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1047991a90a0SJean Perier fir::FirOpBuilder &builder, 1048991a90a0SJean Perier const Op &op, hlfir::Entity lhs, 1049991a90a0SJean Perier hlfir::Entity rhs) { 1050991a90a0SJean Perier llvm::SmallVector<mlir::Value, 2> args{lhs, rhs}; 1051991a90a0SJean Perier fir::ExtendedValue res = op.ordering == Fortran::evaluate::Ordering::Greater 10526dcb31deSTom Eccles ? fir::genMax(builder, loc, args) 10536dcb31deSTom Eccles : fir::genMin(builder, loc, args); 1054991a90a0SJean Perier return hlfir::EntityWithAttributes{fir::getBase(res)}; 1055991a90a0SJean Perier } 1056991a90a0SJean Perier }; 1057991a90a0SJean Perier 10583191e8e1SJean Perier // evaluate::Extremum is only created by the front-end when building compiler 10593191e8e1SJean Perier // generated expressions (like when folding LEN() or shape/bounds inquiries). 10603191e8e1SJean Perier // MIN and MAX are represented as evaluate::ProcedureRef and are not going 10613191e8e1SJean Perier // through here. So far the frontend does not generate character Extremum so 10623191e8e1SJean Perier // there is no way to test it. 10633191e8e1SJean Perier template <int KIND> 10643191e8e1SJean Perier struct BinaryOp<Fortran::evaluate::Extremum< 10653191e8e1SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> { 10663191e8e1SJean Perier using Op = Fortran::evaluate::Extremum< 10673191e8e1SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>; 10683191e8e1SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 10693191e8e1SJean Perier fir::FirOpBuilder &, const Op &, 10703191e8e1SJean Perier hlfir::Entity, hlfir::Entity) { 10713191e8e1SJean Perier fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected"); 10723191e8e1SJean Perier } 10733191e8e1SJean Perier static void genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &, 10743191e8e1SJean Perier hlfir::Entity, hlfir::Entity, 10753191e8e1SJean Perier llvm::SmallVectorImpl<mlir::Value> &) { 10763191e8e1SJean Perier fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected"); 10773191e8e1SJean Perier } 10783191e8e1SJean Perier }; 10793191e8e1SJean Perier 108012530711SJean Perier /// Convert parser's INTEGER relational operators to MLIR. 108112530711SJean Perier static mlir::arith::CmpIPredicate 1082*fc97d2e6SPeter Klausler translateSignedRelational(Fortran::common::RelationalOperator rop) { 108312530711SJean Perier switch (rop) { 108412530711SJean Perier case Fortran::common::RelationalOperator::LT: 108512530711SJean Perier return mlir::arith::CmpIPredicate::slt; 108612530711SJean Perier case Fortran::common::RelationalOperator::LE: 108712530711SJean Perier return mlir::arith::CmpIPredicate::sle; 108812530711SJean Perier case Fortran::common::RelationalOperator::EQ: 108912530711SJean Perier return mlir::arith::CmpIPredicate::eq; 109012530711SJean Perier case Fortran::common::RelationalOperator::NE: 109112530711SJean Perier return mlir::arith::CmpIPredicate::ne; 109212530711SJean Perier case Fortran::common::RelationalOperator::GT: 109312530711SJean Perier return mlir::arith::CmpIPredicate::sgt; 109412530711SJean Perier case Fortran::common::RelationalOperator::GE: 109512530711SJean Perier return mlir::arith::CmpIPredicate::sge; 109612530711SJean Perier } 109712530711SJean Perier llvm_unreachable("unhandled INTEGER relational operator"); 109812530711SJean Perier } 109912530711SJean Perier 1100*fc97d2e6SPeter Klausler static mlir::arith::CmpIPredicate 1101*fc97d2e6SPeter Klausler translateUnsignedRelational(Fortran::common::RelationalOperator rop) { 1102*fc97d2e6SPeter Klausler switch (rop) { 1103*fc97d2e6SPeter Klausler case Fortran::common::RelationalOperator::LT: 1104*fc97d2e6SPeter Klausler return mlir::arith::CmpIPredicate::ult; 1105*fc97d2e6SPeter Klausler case Fortran::common::RelationalOperator::LE: 1106*fc97d2e6SPeter Klausler return mlir::arith::CmpIPredicate::ule; 1107*fc97d2e6SPeter Klausler case Fortran::common::RelationalOperator::EQ: 1108*fc97d2e6SPeter Klausler return mlir::arith::CmpIPredicate::eq; 1109*fc97d2e6SPeter Klausler case Fortran::common::RelationalOperator::NE: 1110*fc97d2e6SPeter Klausler return mlir::arith::CmpIPredicate::ne; 1111*fc97d2e6SPeter Klausler case Fortran::common::RelationalOperator::GT: 1112*fc97d2e6SPeter Klausler return mlir::arith::CmpIPredicate::ugt; 1113*fc97d2e6SPeter Klausler case Fortran::common::RelationalOperator::GE: 1114*fc97d2e6SPeter Klausler return mlir::arith::CmpIPredicate::uge; 1115*fc97d2e6SPeter Klausler } 1116*fc97d2e6SPeter Klausler llvm_unreachable("unhandled UNSIGNED relational operator"); 1117*fc97d2e6SPeter Klausler } 1118*fc97d2e6SPeter Klausler 111912530711SJean Perier /// Convert parser's REAL relational operators to MLIR. 112012530711SJean Perier /// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018 112112530711SJean Perier /// requirements in the IEEE context (table 17.1 of F2018). This choice is 112212530711SJean Perier /// also applied in other contexts because it is easier and in line with 112312530711SJean Perier /// other Fortran compilers. 112412530711SJean Perier /// FIXME: The signaling/quiet aspect of the table 17.1 requirement is not 112512530711SJean Perier /// fully enforced. FIR and LLVM `fcmp` instructions do not give any guarantee 112612530711SJean Perier /// whether the comparison will signal or not in case of quiet NaN argument. 112712530711SJean Perier static mlir::arith::CmpFPredicate 112812530711SJean Perier translateFloatRelational(Fortran::common::RelationalOperator rop) { 112912530711SJean Perier switch (rop) { 113012530711SJean Perier case Fortran::common::RelationalOperator::LT: 113112530711SJean Perier return mlir::arith::CmpFPredicate::OLT; 113212530711SJean Perier case Fortran::common::RelationalOperator::LE: 113312530711SJean Perier return mlir::arith::CmpFPredicate::OLE; 113412530711SJean Perier case Fortran::common::RelationalOperator::EQ: 113512530711SJean Perier return mlir::arith::CmpFPredicate::OEQ; 113612530711SJean Perier case Fortran::common::RelationalOperator::NE: 113712530711SJean Perier return mlir::arith::CmpFPredicate::UNE; 113812530711SJean Perier case Fortran::common::RelationalOperator::GT: 113912530711SJean Perier return mlir::arith::CmpFPredicate::OGT; 114012530711SJean Perier case Fortran::common::RelationalOperator::GE: 114112530711SJean Perier return mlir::arith::CmpFPredicate::OGE; 114212530711SJean Perier } 114312530711SJean Perier llvm_unreachable("unhandled REAL relational operator"); 114412530711SJean Perier } 114512530711SJean Perier 114612530711SJean Perier template <int KIND> 114712530711SJean Perier struct BinaryOp<Fortran::evaluate::Relational< 114812530711SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> { 114912530711SJean Perier using Op = Fortran::evaluate::Relational< 115012530711SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>; 115112530711SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 115212530711SJean Perier fir::FirOpBuilder &builder, 115312530711SJean Perier const Op &op, hlfir::Entity lhs, 115412530711SJean Perier hlfir::Entity rhs) { 115512530711SJean Perier auto cmp = builder.create<mlir::arith::CmpIOp>( 1156*fc97d2e6SPeter Klausler loc, translateSignedRelational(op.opr), lhs, rhs); 1157*fc97d2e6SPeter Klausler return hlfir::EntityWithAttributes{cmp}; 1158*fc97d2e6SPeter Klausler } 1159*fc97d2e6SPeter Klausler }; 1160*fc97d2e6SPeter Klausler 1161*fc97d2e6SPeter Klausler template <int KIND> 1162*fc97d2e6SPeter Klausler struct BinaryOp<Fortran::evaluate::Relational< 1163*fc97d2e6SPeter Klausler Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> { 1164*fc97d2e6SPeter Klausler using Op = Fortran::evaluate::Relational< 1165*fc97d2e6SPeter Klausler Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>; 1166*fc97d2e6SPeter Klausler static hlfir::EntityWithAttributes gen(mlir::Location loc, 1167*fc97d2e6SPeter Klausler fir::FirOpBuilder &builder, 1168*fc97d2e6SPeter Klausler const Op &op, hlfir::Entity lhs, 1169*fc97d2e6SPeter Klausler hlfir::Entity rhs) { 1170*fc97d2e6SPeter Klausler int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 1171*fc97d2e6SPeter Klausler KIND>::Scalar::bits; 1172*fc97d2e6SPeter Klausler auto signlessType = mlir::IntegerType::get( 1173*fc97d2e6SPeter Klausler builder.getContext(), bits, 1174*fc97d2e6SPeter Klausler mlir::IntegerType::SignednessSemantics::Signless); 1175*fc97d2e6SPeter Klausler mlir::Value lhsSL = builder.createConvert(loc, signlessType, lhs); 1176*fc97d2e6SPeter Klausler mlir::Value rhsSL = builder.createConvert(loc, signlessType, rhs); 1177*fc97d2e6SPeter Klausler auto cmp = builder.create<mlir::arith::CmpIOp>( 1178*fc97d2e6SPeter Klausler loc, translateUnsignedRelational(op.opr), lhsSL, rhsSL); 117912530711SJean Perier return hlfir::EntityWithAttributes{cmp}; 118012530711SJean Perier } 118112530711SJean Perier }; 118212530711SJean Perier 118312530711SJean Perier template <int KIND> 118412530711SJean Perier struct BinaryOp<Fortran::evaluate::Relational< 118512530711SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> { 118612530711SJean Perier using Op = Fortran::evaluate::Relational< 118712530711SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>; 118812530711SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 118912530711SJean Perier fir::FirOpBuilder &builder, 119012530711SJean Perier const Op &op, hlfir::Entity lhs, 119112530711SJean Perier hlfir::Entity rhs) { 119212530711SJean Perier auto cmp = builder.create<mlir::arith::CmpFOp>( 119312530711SJean Perier loc, translateFloatRelational(op.opr), lhs, rhs); 119412530711SJean Perier return hlfir::EntityWithAttributes{cmp}; 119512530711SJean Perier } 119612530711SJean Perier }; 119712530711SJean Perier 119812530711SJean Perier template <int KIND> 119912530711SJean Perier struct BinaryOp<Fortran::evaluate::Relational< 120012530711SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> { 120112530711SJean Perier using Op = Fortran::evaluate::Relational< 120212530711SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>; 120312530711SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 120412530711SJean Perier fir::FirOpBuilder &builder, 120512530711SJean Perier const Op &op, hlfir::Entity lhs, 120612530711SJean Perier hlfir::Entity rhs) { 120712530711SJean Perier auto cmp = builder.create<fir::CmpcOp>( 120812530711SJean Perier loc, translateFloatRelational(op.opr), lhs, rhs); 120912530711SJean Perier return hlfir::EntityWithAttributes{cmp}; 121012530711SJean Perier } 121112530711SJean Perier }; 121212530711SJean Perier 121312530711SJean Perier template <int KIND> 121412530711SJean Perier struct BinaryOp<Fortran::evaluate::Relational< 121512530711SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> { 121612530711SJean Perier using Op = Fortran::evaluate::Relational< 121712530711SJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>; 121812530711SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 121912530711SJean Perier fir::FirOpBuilder &builder, 122012530711SJean Perier const Op &op, hlfir::Entity lhs, 122112530711SJean Perier hlfir::Entity rhs) { 122212530711SJean Perier auto [lhsExv, lhsCleanUp] = 122312530711SJean Perier hlfir::translateToExtendedValue(loc, builder, lhs); 122412530711SJean Perier auto [rhsExv, rhsCleanUp] = 122512530711SJean Perier hlfir::translateToExtendedValue(loc, builder, rhs); 122612530711SJean Perier auto cmp = fir::runtime::genCharCompare( 1227*fc97d2e6SPeter Klausler builder, loc, translateSignedRelational(op.opr), lhsExv, rhsExv); 122812530711SJean Perier if (lhsCleanUp) 122915a9a72eSFangrui Song (*lhsCleanUp)(); 123012530711SJean Perier if (rhsCleanUp) 123115a9a72eSFangrui Song (*rhsCleanUp)(); 123212530711SJean Perier return hlfir::EntityWithAttributes{cmp}; 123312530711SJean Perier } 123412530711SJean Perier }; 123512530711SJean Perier 1236248fcb13SJean Perier template <int KIND> 1237248fcb13SJean Perier struct BinaryOp<Fortran::evaluate::LogicalOperation<KIND>> { 1238248fcb13SJean Perier using Op = Fortran::evaluate::LogicalOperation<KIND>; 1239248fcb13SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1240248fcb13SJean Perier fir::FirOpBuilder &builder, 1241248fcb13SJean Perier const Op &op, hlfir::Entity lhs, 1242248fcb13SJean Perier hlfir::Entity rhs) { 1243248fcb13SJean Perier mlir::Type i1Type = builder.getI1Type(); 1244248fcb13SJean Perier mlir::Value i1Lhs = builder.createConvert(loc, i1Type, lhs); 1245248fcb13SJean Perier mlir::Value i1Rhs = builder.createConvert(loc, i1Type, rhs); 1246248fcb13SJean Perier switch (op.logicalOperator) { 1247248fcb13SJean Perier case Fortran::evaluate::LogicalOperator::And: 1248248fcb13SJean Perier return hlfir::EntityWithAttributes{ 1249248fcb13SJean Perier builder.create<mlir::arith::AndIOp>(loc, i1Lhs, i1Rhs)}; 1250248fcb13SJean Perier case Fortran::evaluate::LogicalOperator::Or: 1251248fcb13SJean Perier return hlfir::EntityWithAttributes{ 1252248fcb13SJean Perier builder.create<mlir::arith::OrIOp>(loc, i1Lhs, i1Rhs)}; 1253248fcb13SJean Perier case Fortran::evaluate::LogicalOperator::Eqv: 1254248fcb13SJean Perier return hlfir::EntityWithAttributes{builder.create<mlir::arith::CmpIOp>( 1255248fcb13SJean Perier loc, mlir::arith::CmpIPredicate::eq, i1Lhs, i1Rhs)}; 1256248fcb13SJean Perier case Fortran::evaluate::LogicalOperator::Neqv: 1257248fcb13SJean Perier return hlfir::EntityWithAttributes{builder.create<mlir::arith::CmpIOp>( 1258248fcb13SJean Perier loc, mlir::arith::CmpIPredicate::ne, i1Lhs, i1Rhs)}; 1259248fcb13SJean Perier case Fortran::evaluate::LogicalOperator::Not: 1260248fcb13SJean Perier // lib/evaluate expression for .NOT. is Fortran::evaluate::Not<KIND>. 1261248fcb13SJean Perier llvm_unreachable(".NOT. is not a binary operator"); 1262248fcb13SJean Perier } 1263ffdb5f95SJean Perier llvm_unreachable("unhandled logical operation"); 1264248fcb13SJean Perier } 1265248fcb13SJean Perier }; 1266248fcb13SJean Perier 126726ceeee7SJean Perier template <int KIND> 126826ceeee7SJean Perier struct BinaryOp<Fortran::evaluate::ComplexConstructor<KIND>> { 126926ceeee7SJean Perier using Op = Fortran::evaluate::ComplexConstructor<KIND>; 127026ceeee7SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1271655d994aSJean Perier fir::FirOpBuilder &builder, const Op &, 1272655d994aSJean Perier hlfir::Entity lhs, hlfir::Entity rhs) { 127326ceeee7SJean Perier mlir::Value res = 1274c4204c0bSjeanPerier fir::factory::Complex{builder, loc}.createComplex(lhs, rhs); 127526ceeee7SJean Perier return hlfir::EntityWithAttributes{res}; 127626ceeee7SJean Perier } 127726ceeee7SJean Perier }; 127826ceeee7SJean Perier 1279fed3d272SJean Perier template <int KIND> 1280fed3d272SJean Perier struct BinaryOp<Fortran::evaluate::SetLength<KIND>> { 1281fed3d272SJean Perier using Op = Fortran::evaluate::SetLength<KIND>; 1282fed3d272SJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 12838febe678SJean Perier fir::FirOpBuilder &builder, const Op &, 12848febe678SJean Perier hlfir::Entity string, 12858febe678SJean Perier hlfir::Entity length) { 12867a4570acSjeanPerier // The input length may be a user input and needs to be sanitized as per 12877a4570acSjeanPerier // Fortran 2018 7.4.4.2 point 5. 12887a4570acSjeanPerier mlir::Value safeLength = fir::factory::genMaxWithZero(builder, loc, length); 12898febe678SJean Perier return hlfir::EntityWithAttributes{ 12907a4570acSjeanPerier builder.create<hlfir::SetLengthOp>(loc, string, safeLength)}; 1291fed3d272SJean Perier } 12923191e8e1SJean Perier static void 12938febe678SJean Perier genResultTypeParams(mlir::Location, fir::FirOpBuilder &, hlfir::Entity, 12948febe678SJean Perier hlfir::Entity rhs, 12953191e8e1SJean Perier llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) { 12963191e8e1SJean Perier resultTypeParams.push_back(rhs); 12973191e8e1SJean Perier } 12983191e8e1SJean Perier }; 12993191e8e1SJean Perier 13003191e8e1SJean Perier template <int KIND> 13013191e8e1SJean Perier struct BinaryOp<Fortran::evaluate::Concat<KIND>> { 13023191e8e1SJean Perier using Op = Fortran::evaluate::Concat<KIND>; 13033191e8e1SJean Perier hlfir::EntityWithAttributes gen(mlir::Location loc, 13043191e8e1SJean Perier fir::FirOpBuilder &builder, const Op &, 13053191e8e1SJean Perier hlfir::Entity lhs, hlfir::Entity rhs) { 13063191e8e1SJean Perier assert(len && "genResultTypeParams must have been called"); 13073191e8e1SJean Perier auto concat = 13083191e8e1SJean Perier builder.create<hlfir::ConcatOp>(loc, mlir::ValueRange{lhs, rhs}, len); 13093191e8e1SJean Perier return hlfir::EntityWithAttributes{concat.getResult()}; 13103191e8e1SJean Perier } 13113191e8e1SJean Perier void 13123191e8e1SJean Perier genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder, 13133191e8e1SJean Perier hlfir::Entity lhs, hlfir::Entity rhs, 13143191e8e1SJean Perier llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) { 13153191e8e1SJean Perier llvm::SmallVector<mlir::Value> lengths; 13163191e8e1SJean Perier hlfir::genLengthParameters(loc, builder, lhs, lengths); 13173191e8e1SJean Perier hlfir::genLengthParameters(loc, builder, rhs, lengths); 13183191e8e1SJean Perier assert(lengths.size() == 2 && "lacks rhs or lhs length"); 13193191e8e1SJean Perier mlir::Type idxType = builder.getIndexType(); 13203191e8e1SJean Perier mlir::Value lhsLen = builder.createConvert(loc, idxType, lengths[0]); 13213191e8e1SJean Perier mlir::Value rhsLen = builder.createConvert(loc, idxType, lengths[1]); 13223191e8e1SJean Perier len = builder.create<mlir::arith::AddIOp>(loc, lhsLen, rhsLen); 13233191e8e1SJean Perier resultTypeParams.push_back(len); 13243191e8e1SJean Perier } 13253191e8e1SJean Perier 13263191e8e1SJean Perier private: 13273191e8e1SJean Perier mlir::Value len{}; 1328fed3d272SJean Perier }; 1329fed3d272SJean Perier 133012c8797fSJean Perier //===--------------------------------------------------------------------===// 133112c8797fSJean Perier // Unary Operation implementation 133212c8797fSJean Perier //===--------------------------------------------------------------------===// 133312c8797fSJean Perier 133412c8797fSJean Perier template <typename T> 133512c8797fSJean Perier struct UnaryOp {}; 133612c8797fSJean Perier 133712c8797fSJean Perier template <int KIND> 133812c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Not<KIND>> { 133912c8797fSJean Perier using Op = Fortran::evaluate::Not<KIND>; 134012c8797fSJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1341655d994aSJean Perier fir::FirOpBuilder &builder, const Op &, 1342655d994aSJean Perier hlfir::Entity lhs) { 134312c8797fSJean Perier mlir::Value one = builder.createBool(loc, true); 134412c8797fSJean Perier mlir::Value val = builder.createConvert(loc, builder.getI1Type(), lhs); 134512c8797fSJean Perier return hlfir::EntityWithAttributes{ 134612c8797fSJean Perier builder.create<mlir::arith::XOrIOp>(loc, val, one)}; 134712c8797fSJean Perier } 134812c8797fSJean Perier }; 134912c8797fSJean Perier 135012c8797fSJean Perier template <int KIND> 135112c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Negate< 135212c8797fSJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> { 135312c8797fSJean Perier using Op = Fortran::evaluate::Negate< 135412c8797fSJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>; 135512c8797fSJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1356655d994aSJean Perier fir::FirOpBuilder &builder, const Op &, 1357655d994aSJean Perier hlfir::Entity lhs) { 135812c8797fSJean Perier // Like LLVM, integer negation is the binary op "0 - value" 135912c8797fSJean Perier mlir::Type type = Fortran::lower::getFIRType( 136012c8797fSJean Perier builder.getContext(), Fortran::common::TypeCategory::Integer, KIND, 13619a417395SKazu Hirata /*params=*/std::nullopt); 136212c8797fSJean Perier mlir::Value zero = builder.createIntegerConstant(loc, type, 0); 136312c8797fSJean Perier return hlfir::EntityWithAttributes{ 136412c8797fSJean Perier builder.create<mlir::arith::SubIOp>(loc, zero, lhs)}; 136512c8797fSJean Perier } 136612c8797fSJean Perier }; 136712c8797fSJean Perier 136812c8797fSJean Perier template <int KIND> 136912c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Negate< 1370*fc97d2e6SPeter Klausler Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> { 1371*fc97d2e6SPeter Klausler using Op = Fortran::evaluate::Negate< 1372*fc97d2e6SPeter Klausler Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>; 1373*fc97d2e6SPeter Klausler static hlfir::EntityWithAttributes gen(mlir::Location loc, 1374*fc97d2e6SPeter Klausler fir::FirOpBuilder &builder, const Op &, 1375*fc97d2e6SPeter Klausler hlfir::Entity lhs) { 1376*fc97d2e6SPeter Klausler int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 1377*fc97d2e6SPeter Klausler KIND>::Scalar::bits; 1378*fc97d2e6SPeter Klausler mlir::Type signlessType = mlir::IntegerType::get( 1379*fc97d2e6SPeter Klausler builder.getContext(), bits, 1380*fc97d2e6SPeter Klausler mlir::IntegerType::SignednessSemantics::Signless); 1381*fc97d2e6SPeter Klausler mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0); 1382*fc97d2e6SPeter Klausler mlir::Value signless = builder.createConvert(loc, signlessType, lhs); 1383*fc97d2e6SPeter Klausler mlir::Value negated = 1384*fc97d2e6SPeter Klausler builder.create<mlir::arith::SubIOp>(loc, zero, signless); 1385*fc97d2e6SPeter Klausler return hlfir::EntityWithAttributes( 1386*fc97d2e6SPeter Klausler builder.createConvert(loc, lhs.getType(), negated)); 1387*fc97d2e6SPeter Klausler } 1388*fc97d2e6SPeter Klausler }; 1389*fc97d2e6SPeter Klausler 1390*fc97d2e6SPeter Klausler template <int KIND> 1391*fc97d2e6SPeter Klausler struct UnaryOp<Fortran::evaluate::Negate< 139212c8797fSJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> { 139312c8797fSJean Perier using Op = Fortran::evaluate::Negate< 139412c8797fSJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>; 139512c8797fSJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1396655d994aSJean Perier fir::FirOpBuilder &builder, const Op &, 1397655d994aSJean Perier hlfir::Entity lhs) { 139812c8797fSJean Perier return hlfir::EntityWithAttributes{ 139912c8797fSJean Perier builder.create<mlir::arith::NegFOp>(loc, lhs)}; 140012c8797fSJean Perier } 140112c8797fSJean Perier }; 140212c8797fSJean Perier 140312c8797fSJean Perier template <int KIND> 140412c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Negate< 140512c8797fSJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> { 140612c8797fSJean Perier using Op = Fortran::evaluate::Negate< 140712c8797fSJean Perier Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>; 140812c8797fSJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1409655d994aSJean Perier fir::FirOpBuilder &builder, const Op &, 1410655d994aSJean Perier hlfir::Entity lhs) { 141112c8797fSJean Perier return hlfir::EntityWithAttributes{builder.create<fir::NegcOp>(loc, lhs)}; 141212c8797fSJean Perier } 141312c8797fSJean Perier }; 141412c8797fSJean Perier 141512c8797fSJean Perier template <int KIND> 141612c8797fSJean Perier struct UnaryOp<Fortran::evaluate::ComplexComponent<KIND>> { 141712c8797fSJean Perier using Op = Fortran::evaluate::ComplexComponent<KIND>; 141812c8797fSJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 141912c8797fSJean Perier fir::FirOpBuilder &builder, 142012c8797fSJean Perier const Op &op, hlfir::Entity lhs) { 142112c8797fSJean Perier mlir::Value res = fir::factory::Complex{builder, loc}.extractComplexPart( 142212c8797fSJean Perier lhs, op.isImaginaryPart); 142312c8797fSJean Perier return hlfir::EntityWithAttributes{res}; 142412c8797fSJean Perier } 142512c8797fSJean Perier }; 142612c8797fSJean Perier 142712c8797fSJean Perier template <typename T> 142812c8797fSJean Perier struct UnaryOp<Fortran::evaluate::Parentheses<T>> { 142912c8797fSJean Perier using Op = Fortran::evaluate::Parentheses<T>; 14306e3292fbSJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 14316e3292fbSJean Perier fir::FirOpBuilder &builder, 14326e3292fbSJean Perier const Op &op, hlfir::Entity lhs) { 14336e3292fbSJean Perier if (lhs.isVariable()) 14346e3292fbSJean Perier return hlfir::EntityWithAttributes{ 14356e3292fbSJean Perier builder.create<hlfir::AsExprOp>(loc, lhs)}; 14366e3292fbSJean Perier return hlfir::EntityWithAttributes{ 14376e3292fbSJean Perier builder.create<hlfir::NoReassocOp>(loc, lhs.getType(), lhs)}; 143812c8797fSJean Perier } 14393191e8e1SJean Perier 14403191e8e1SJean Perier static void 14413191e8e1SJean Perier genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder, 14423191e8e1SJean Perier hlfir::Entity lhs, 14433191e8e1SJean Perier llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) { 14443191e8e1SJean Perier hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams); 14453191e8e1SJean Perier } 144612c8797fSJean Perier }; 144712c8797fSJean Perier 1448f24466cfSJean Perier template <Fortran::common::TypeCategory TC1, int KIND, 1449f24466cfSJean Perier Fortran::common::TypeCategory TC2> 1450f24466cfSJean Perier struct UnaryOp< 1451f24466cfSJean Perier Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>> { 1452f24466cfSJean Perier using Op = 1453f24466cfSJean Perier Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>; 1454f24466cfSJean Perier static hlfir::EntityWithAttributes gen(mlir::Location loc, 1455655d994aSJean Perier fir::FirOpBuilder &builder, const Op &, 1456655d994aSJean Perier hlfir::Entity lhs) { 1457f24466cfSJean Perier if constexpr (TC1 == Fortran::common::TypeCategory::Character && 1458f24466cfSJean Perier TC2 == TC1) { 14597046202cSjeanPerier return hlfir::convertCharacterKind(loc, builder, lhs, KIND); 1460655d994aSJean Perier } 1461f24466cfSJean Perier mlir::Type type = Fortran::lower::getFIRType(builder.getContext(), TC1, 14629a417395SKazu Hirata KIND, /*params=*/std::nullopt); 1463f24466cfSJean Perier mlir::Value res = builder.convertWithSemantics(loc, type, lhs); 1464f24466cfSJean Perier return hlfir::EntityWithAttributes{res}; 1465f24466cfSJean Perier } 14663191e8e1SJean Perier 14673191e8e1SJean Perier static void 14683191e8e1SJean Perier genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder, 14693191e8e1SJean Perier hlfir::Entity lhs, 14703191e8e1SJean Perier llvm::SmallVectorImpl<mlir::Value> &resultTypeParams) { 14713191e8e1SJean Perier hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams); 14723191e8e1SJean Perier } 1473f24466cfSJean Perier }; 1474f24466cfSJean Perier 14758252137bSjeanPerier static bool hasDeferredCharacterLength(const Fortran::semantics::Symbol &sym) { 14768252137bSjeanPerier const Fortran::semantics::DeclTypeSpec *type = sym.GetType(); 14778252137bSjeanPerier return type && 14788252137bSjeanPerier type->category() == 14798252137bSjeanPerier Fortran::semantics::DeclTypeSpec::Category::Character && 14808252137bSjeanPerier type->characterTypeSpec().length().isDeferred(); 14818252137bSjeanPerier } 14828252137bSjeanPerier 1483c14ef2d7SJean Perier /// Lower Expr to HLFIR. 1484c14ef2d7SJean Perier class HlfirBuilder { 1485c14ef2d7SJean Perier public: 1486c14ef2d7SJean Perier HlfirBuilder(mlir::Location loc, Fortran::lower::AbstractConverter &converter, 1487c14ef2d7SJean Perier Fortran::lower::SymMap &symMap, 1488c14ef2d7SJean Perier Fortran::lower::StatementContext &stmtCtx) 1489c14ef2d7SJean Perier : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {} 1490c14ef2d7SJean Perier 1491c14ef2d7SJean Perier template <typename T> 1492fcfb620dSJean Perier hlfir::EntityWithAttributes gen(const Fortran::evaluate::Expr<T> &expr) { 1493b6b0756cSjeanPerier if (const Fortran::lower::ExprToValueMap *map = 1494b6b0756cSjeanPerier getConverter().getExprOverrides()) { 1495b6b0756cSjeanPerier if constexpr (std::is_same_v<T, Fortran::evaluate::SomeType>) { 1496b6b0756cSjeanPerier if (auto match = map->find(&expr); match != map->end()) 1497b6b0756cSjeanPerier return hlfir::EntityWithAttributes{match->second}; 1498b6b0756cSjeanPerier } else { 1499b6b0756cSjeanPerier Fortran::lower::SomeExpr someExpr = toEvExpr(expr); 1500b6b0756cSjeanPerier if (auto match = map->find(&someExpr); match != map->end()) 1501b6b0756cSjeanPerier return hlfir::EntityWithAttributes{match->second}; 1502b6b0756cSjeanPerier } 1503b6b0756cSjeanPerier } 150477d8cfb3SAlexander Shaposhnikov return Fortran::common::visit([&](const auto &x) { return gen(x); }, 150577d8cfb3SAlexander Shaposhnikov expr.u); 1506c14ef2d7SJean Perier } 1507c14ef2d7SJean Perier 1508c14ef2d7SJean Perier private: 1509fcfb620dSJean Perier hlfir::EntityWithAttributes 1510fcfb620dSJean Perier gen(const Fortran::evaluate::BOZLiteralConstant &expr) { 1511ca2ec4b7SSlava Zakharin TODO(getLoc(), "BOZ"); 1512c14ef2d7SJean Perier } 15134e78f885SJean Perier 1514fcfb620dSJean Perier hlfir::EntityWithAttributes gen(const Fortran::evaluate::NullPointer &expr) { 15154e78f885SJean Perier auto nullop = getBuilder().create<hlfir::NullOp>(getLoc()); 15164e78f885SJean Perier return mlir::cast<fir::FortranVariableOpInterface>(nullop.getOperation()); 1517c14ef2d7SJean Perier } 15184e78f885SJean Perier 1519fcfb620dSJean Perier hlfir::EntityWithAttributes 1520cedfd272SJean Perier gen(const Fortran::evaluate::ProcedureDesignator &proc) { 1521cedfd272SJean Perier return Fortran::lower::convertProcedureDesignatorToHLFIR( 1522cedfd272SJean Perier getLoc(), getConverter(), proc, getSymMap(), getStmtCtx()); 1523c14ef2d7SJean Perier } 1524cedfd272SJean Perier 1525fcfb620dSJean Perier hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) { 1526cdb320b4SDaniel Chen Fortran::evaluate::ProcedureDesignator proc{expr.proc()}; 1527cdb320b4SDaniel Chen auto procTy{Fortran::lower::translateSignature(proc, getConverter())}; 1528cdb320b4SDaniel Chen auto result = Fortran::lower::convertCallToHLFIR(getLoc(), getConverter(), 1529cdb320b4SDaniel Chen expr, procTy.getResult(0), 1530cdb320b4SDaniel Chen getSymMap(), getStmtCtx()); 1531cdb320b4SDaniel Chen assert(result.has_value()); 1532cdb320b4SDaniel Chen return *result; 1533c14ef2d7SJean Perier } 1534c14ef2d7SJean Perier 1535c14ef2d7SJean Perier template <typename T> 1536fcfb620dSJean Perier hlfir::EntityWithAttributes 1537fcfb620dSJean Perier gen(const Fortran::evaluate::Designator<T> &designator) { 1538c14ef2d7SJean Perier return HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(), 1539c14ef2d7SJean Perier getStmtCtx()) 1540c14ef2d7SJean Perier .gen(designator.u); 1541c14ef2d7SJean Perier } 1542c14ef2d7SJean Perier 1543c14ef2d7SJean Perier template <typename T> 1544fcfb620dSJean Perier hlfir::EntityWithAttributes 1545fcfb620dSJean Perier gen(const Fortran::evaluate::FunctionRef<T> &expr) { 1546e78e4a17SJean Perier mlir::Type resType = 1547e78e4a17SJean Perier Fortran::lower::TypeBuilder<T>::genType(getConverter(), expr); 1548a8234196SPeter Klausler auto result = Fortran::lower::convertCallToHLFIR( 154915a9a72eSFangrui Song getLoc(), getConverter(), expr, resType, getSymMap(), getStmtCtx()); 1550a8234196SPeter Klausler assert(result.has_value()); 1551a8234196SPeter Klausler return *result; 1552c14ef2d7SJean Perier } 1553c14ef2d7SJean Perier 1554c14ef2d7SJean Perier template <typename T> 1555fcfb620dSJean Perier hlfir::EntityWithAttributes gen(const Fortran::evaluate::Constant<T> &expr) { 15563952377fSJean Perier mlir::Location loc = getLoc(); 15573952377fSJean Perier fir::FirOpBuilder &builder = getBuilder(); 15582d9b4a50SJean Perier fir::ExtendedValue exv = Fortran::lower::convertConstant( 15592d9b4a50SJean Perier converter, loc, expr, /*outlineBigConstantInReadOnlyMemory=*/true); 15603952377fSJean Perier if (const auto *scalarBox = exv.getUnboxed()) 15613952377fSJean Perier if (fir::isa_trivial(scalarBox->getType())) 1562fcfb620dSJean Perier return hlfir::EntityWithAttributes(*scalarBox); 15633952377fSJean Perier if (auto addressOf = fir::getBase(exv).getDefiningOp<fir::AddrOfOp>()) { 15643952377fSJean Perier auto flags = fir::FortranVariableFlagsAttr::get( 15653952377fSJean Perier builder.getContext(), fir::FortranVariableFlagsEnum::parameter); 15663952377fSJean Perier return hlfir::genDeclare( 15673952377fSJean Perier loc, builder, exv, 15683952377fSJean Perier addressOf.getSymbol().getRootReference().getValue(), flags); 15693952377fSJean Perier } 15703952377fSJean Perier fir::emitFatalError(loc, "Constant<T> was lowered to unexpected format"); 15713952377fSJean Perier } 1572c14ef2d7SJean Perier 1573c14ef2d7SJean Perier template <typename T> 1574fcfb620dSJean Perier hlfir::EntityWithAttributes 1575ffde9f17SJean Perier gen(const Fortran::evaluate::ArrayConstructor<T> &arrayCtor) { 1576ffde9f17SJean Perier return Fortran::lower::ArrayConstructorBuilder<T>::gen( 1577ffde9f17SJean Perier getLoc(), getConverter(), arrayCtor, getSymMap(), getStmtCtx()); 1578c14ef2d7SJean Perier } 1579c14ef2d7SJean Perier 1580c14ef2d7SJean Perier template <typename D, typename R, typename O> 1581fcfb620dSJean Perier hlfir::EntityWithAttributes 1582fcfb620dSJean Perier gen(const Fortran::evaluate::Operation<D, R, O> &op) { 158312c8797fSJean Perier auto &builder = getBuilder(); 158412c8797fSJean Perier mlir::Location loc = getLoc(); 15853191e8e1SJean Perier const int rank = op.Rank(); 15863191e8e1SJean Perier UnaryOp<D> unaryOp; 158712c8797fSJean Perier auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left())); 15883191e8e1SJean Perier llvm::SmallVector<mlir::Value, 1> typeParams; 15893191e8e1SJean Perier if constexpr (R::category == Fortran::common::TypeCategory::Character) { 15903191e8e1SJean Perier unaryOp.genResultTypeParams(loc, builder, left, typeParams); 15913191e8e1SJean Perier } 15923191e8e1SJean Perier if (rank == 0) 15933191e8e1SJean Perier return unaryOp.gen(loc, builder, op.derived(), left); 15943191e8e1SJean Perier 15953191e8e1SJean Perier // Elemental expression. 15963191e8e1SJean Perier mlir::Type elementType; 15973191e8e1SJean Perier if constexpr (R::category == Fortran::common::TypeCategory::Derived) { 15989184eb84SSlava Zakharin if (op.derived().GetType().IsUnlimitedPolymorphic()) 15999184eb84SSlava Zakharin elementType = mlir::NoneType::get(builder.getContext()); 16009184eb84SSlava Zakharin else 16013191e8e1SJean Perier elementType = Fortran::lower::translateDerivedTypeToFIRType( 16023191e8e1SJean Perier getConverter(), op.derived().GetType().GetDerivedTypeSpec()); 16033191e8e1SJean Perier } else { 16043191e8e1SJean Perier elementType = 16053191e8e1SJean Perier Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind, 16063191e8e1SJean Perier /*params=*/std::nullopt); 16073191e8e1SJean Perier } 16083191e8e1SJean Perier mlir::Value shape = hlfir::genShape(loc, builder, left); 16093191e8e1SJean Perier auto genKernel = [&op, &left, &unaryOp]( 16103191e8e1SJean Perier mlir::Location l, fir::FirOpBuilder &b, 16113191e8e1SJean Perier mlir::ValueRange oneBasedIndices) -> hlfir::Entity { 16123191e8e1SJean Perier auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices); 16133191e8e1SJean Perier auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement); 16143191e8e1SJean Perier return unaryOp.gen(l, b, op.derived(), leftVal); 16153191e8e1SJean Perier }; 16165a4c5c86SSlava Zakharin mlir::Value elemental = hlfir::genElementalOp( 16175a4c5c86SSlava Zakharin loc, builder, elementType, shape, typeParams, genKernel, 16185a4c5c86SSlava Zakharin /*isUnordered=*/true, left.isPolymorphic() ? left : mlir::Value{}); 1619c0b45fefSJean Perier fir::FirOpBuilder *bldr = &builder; 1620c0b45fefSJean Perier getStmtCtx().attachCleanup( 1621c0b45fefSJean Perier [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); }); 1622c0b45fefSJean Perier return hlfir::EntityWithAttributes{elemental}; 1623c14ef2d7SJean Perier } 1624c14ef2d7SJean Perier 1625c14ef2d7SJean Perier template <typename D, typename R, typename LO, typename RO> 1626fcfb620dSJean Perier hlfir::EntityWithAttributes 1627c14ef2d7SJean Perier gen(const Fortran::evaluate::Operation<D, R, LO, RO> &op) { 1628440e9baaSJean Perier auto &builder = getBuilder(); 1629440e9baaSJean Perier mlir::Location loc = getLoc(); 16303191e8e1SJean Perier const int rank = op.Rank(); 16313191e8e1SJean Perier BinaryOp<D> binaryOp; 1632440e9baaSJean Perier auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left())); 1633440e9baaSJean Perier auto right = hlfir::loadTrivialScalar(loc, builder, gen(op.right())); 16343191e8e1SJean Perier llvm::SmallVector<mlir::Value, 1> typeParams; 16353191e8e1SJean Perier if constexpr (R::category == Fortran::common::TypeCategory::Character) { 16363191e8e1SJean Perier binaryOp.genResultTypeParams(loc, builder, left, right, typeParams); 1637c14ef2d7SJean Perier } 16383191e8e1SJean Perier if (rank == 0) 16393191e8e1SJean Perier return binaryOp.gen(loc, builder, op.derived(), left, right); 1640c14ef2d7SJean Perier 16413191e8e1SJean Perier // Elemental expression. 16423191e8e1SJean Perier mlir::Type elementType = 16433191e8e1SJean Perier Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind, 16443191e8e1SJean Perier /*params=*/std::nullopt); 16453191e8e1SJean Perier // TODO: "merge" shape, get cst shape from front-end if possible. 16463191e8e1SJean Perier mlir::Value shape; 16473191e8e1SJean Perier if (left.isArray()) { 16483191e8e1SJean Perier shape = hlfir::genShape(loc, builder, left); 16493191e8e1SJean Perier } else { 16503191e8e1SJean Perier assert(right.isArray() && "must have at least one array operand"); 16513191e8e1SJean Perier shape = hlfir::genShape(loc, builder, right); 16523191e8e1SJean Perier } 16533191e8e1SJean Perier auto genKernel = [&op, &left, &right, &binaryOp]( 16543191e8e1SJean Perier mlir::Location l, fir::FirOpBuilder &b, 16553191e8e1SJean Perier mlir::ValueRange oneBasedIndices) -> hlfir::Entity { 16563191e8e1SJean Perier auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices); 16573191e8e1SJean Perier auto rightElement = hlfir::getElementAt(l, b, right, oneBasedIndices); 16583191e8e1SJean Perier auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement); 16593191e8e1SJean Perier auto rightVal = hlfir::loadTrivialScalar(l, b, rightElement); 16603191e8e1SJean Perier return binaryOp.gen(l, b, op.derived(), leftVal, rightVal); 16613191e8e1SJean Perier }; 1662b91a25efSYusuke MINATO auto iofBackup = builder.getIntegerOverflowFlags(); 1663b91a25efSYusuke MINATO // nsw is never added to operations on vector subscripts 1664b91a25efSYusuke MINATO // even if -fno-wrapv is enabled. 1665b91a25efSYusuke MINATO builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::none); 1666c0b45fefSJean Perier mlir::Value elemental = hlfir::genElementalOp(loc, builder, elementType, 16677b4aa95dSSlava Zakharin shape, typeParams, genKernel, 16687b4aa95dSSlava Zakharin /*isUnordered=*/true); 1669b91a25efSYusuke MINATO builder.setIntegerOverflowFlags(iofBackup); 1670c0b45fefSJean Perier fir::FirOpBuilder *bldr = &builder; 1671c0b45fefSJean Perier getStmtCtx().attachCleanup( 1672c0b45fefSJean Perier [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); }); 1673c0b45fefSJean Perier return hlfir::EntityWithAttributes{elemental}; 167494b9fbabSJean Perier } 167594b9fbabSJean Perier 1676fcfb620dSJean Perier hlfir::EntityWithAttributes 1677c14ef2d7SJean Perier gen(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &op) { 167877d8cfb3SAlexander Shaposhnikov return Fortran::common::visit([&](const auto &x) { return gen(x); }, op.u); 1679c14ef2d7SJean Perier } 1680c14ef2d7SJean Perier 1681fcfb620dSJean Perier hlfir::EntityWithAttributes gen(const Fortran::evaluate::TypeParamInquiry &) { 1682c14ef2d7SJean Perier TODO(getLoc(), "lowering type parameter inquiry to HLFIR"); 1683c14ef2d7SJean Perier } 1684c14ef2d7SJean Perier 1685fcfb620dSJean Perier hlfir::EntityWithAttributes 1686fcfb620dSJean Perier gen(const Fortran::evaluate::DescriptorInquiry &desc) { 1687d0018c95SJean Perier mlir::Location loc = getLoc(); 1688d0018c95SJean Perier auto &builder = getBuilder(); 1689d0018c95SJean Perier hlfir::EntityWithAttributes entity = 1690d0018c95SJean Perier HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(), 1691d0018c95SJean Perier getStmtCtx()) 1692583d492cSJean Perier .genNamedEntity(desc.base()); 1693d0018c95SJean Perier using ResTy = Fortran::evaluate::DescriptorInquiry::Result; 1694d0018c95SJean Perier mlir::Type resultType = 1695d0018c95SJean Perier getConverter().genType(ResTy::category, ResTy::kind); 1696d0018c95SJean Perier auto castResult = [&](mlir::Value v) { 1697d0018c95SJean Perier return hlfir::EntityWithAttributes{ 1698d0018c95SJean Perier builder.createConvert(loc, resultType, v)}; 1699d0018c95SJean Perier }; 1700d0018c95SJean Perier switch (desc.field()) { 1701d0018c95SJean Perier case Fortran::evaluate::DescriptorInquiry::Field::Len: 1702d0018c95SJean Perier return castResult(hlfir::genCharLength(loc, builder, entity)); 1703d0018c95SJean Perier case Fortran::evaluate::DescriptorInquiry::Field::LowerBound: 170492e5234fSJean Perier return castResult( 170592e5234fSJean Perier hlfir::genLBound(loc, builder, entity, desc.dimension())); 1706d0018c95SJean Perier case Fortran::evaluate::DescriptorInquiry::Field::Extent: 170792e5234fSJean Perier return castResult( 170892e5234fSJean Perier hlfir::genExtent(loc, builder, entity, desc.dimension())); 1709d0018c95SJean Perier case Fortran::evaluate::DescriptorInquiry::Field::Rank: 1710fd8b2d20SjeanPerier return castResult(hlfir::genRank(loc, builder, entity, resultType)); 1711d0018c95SJean Perier case Fortran::evaluate::DescriptorInquiry::Field::Stride: 1712d0018c95SJean Perier // So far the front end does not generate this inquiry. 1713d0018c95SJean Perier TODO(loc, "stride inquiry"); 1714d0018c95SJean Perier } 1715d0018c95SJean Perier llvm_unreachable("unknown descriptor inquiry"); 1716c14ef2d7SJean Perier } 1717c14ef2d7SJean Perier 1718fcfb620dSJean Perier hlfir::EntityWithAttributes 1719fcfb620dSJean Perier gen(const Fortran::evaluate::ImpliedDoIndex &var) { 1720ffde9f17SJean Perier mlir::Value value = symMap.lookupImpliedDo(toStringRef(var.name)); 17219a7b363eSSlava Zakharin if (!value) 17229a7b363eSSlava Zakharin fir::emitFatalError(getLoc(), "ac-do-variable has no binding"); 17239a7b363eSSlava Zakharin // The index value generated by the implied-do has Index type, 17249a7b363eSSlava Zakharin // while computations based on it inside the loop body are using 17259a7b363eSSlava Zakharin // the original data type. So we need to cast it appropriately. 17269a7b363eSSlava Zakharin mlir::Type varTy = getConverter().genType(toEvExpr(var)); 17279a7b363eSSlava Zakharin value = getBuilder().createConvert(getLoc(), varTy, value); 1728ffde9f17SJean Perier return hlfir::EntityWithAttributes{value}; 1729c14ef2d7SJean Perier } 1730c14ef2d7SJean Perier 17311ca458f7SSlava Zakharin static bool 17321ca458f7SSlava Zakharin isDerivedTypeWithLenParameters(const Fortran::semantics::Symbol &sym) { 17331ca458f7SSlava Zakharin if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) 17341ca458f7SSlava Zakharin if (const Fortran::semantics::DerivedTypeSpec *derived = 17351ca458f7SSlava Zakharin declTy->AsDerived()) 17361ca458f7SSlava Zakharin return Fortran::semantics::CountLenParameters(*derived) > 0; 17371ca458f7SSlava Zakharin return false; 17381ca458f7SSlava Zakharin } 17391ca458f7SSlava Zakharin 17401ca458f7SSlava Zakharin // Construct an entity holding the value specified by the 17411ca458f7SSlava Zakharin // StructureConstructor. The initialization of the temporary entity 17421ca458f7SSlava Zakharin // is done component by component with the help of HLFIR operations 1743e45f6e93SjeanPerier // DesignateOp and AssignOp. 1744fcfb620dSJean Perier hlfir::EntityWithAttributes 17451ca458f7SSlava Zakharin gen(const Fortran::evaluate::StructureConstructor &ctor) { 17461ca458f7SSlava Zakharin mlir::Location loc = getLoc(); 17471ca458f7SSlava Zakharin fir::FirOpBuilder &builder = getBuilder(); 17481ca458f7SSlava Zakharin mlir::Type ty = translateSomeExprToFIRType(converter, toEvExpr(ctor)); 1749fac349a1SChristian Sigg auto recTy = mlir::cast<fir::RecordType>(ty); 17501ca458f7SSlava Zakharin 17511ca458f7SSlava Zakharin if (recTy.isDependentType()) 17521ca458f7SSlava Zakharin TODO(loc, "structure constructor for derived type with length parameters " 17531ca458f7SSlava Zakharin "in HLFIR"); 17541ca458f7SSlava Zakharin 17551ca458f7SSlava Zakharin // Allocate scalar temporary that will be initialized 17561ca458f7SSlava Zakharin // with the values specified by the constructor. 17571ca458f7SSlava Zakharin mlir::Value storagePtr = builder.createTemporary(loc, recTy); 17581ca458f7SSlava Zakharin auto varOp = hlfir::EntityWithAttributes{builder.create<hlfir::DeclareOp>( 17591ca458f7SSlava Zakharin loc, storagePtr, "ctor.temp", /*shape=*/nullptr, 17601710c8cfSSlava Zakharin /*typeparams=*/mlir::ValueRange{}, /*dummy_scope=*/nullptr, 17611710c8cfSSlava Zakharin fir::FortranVariableFlagsAttr{})}; 17621ca458f7SSlava Zakharin 17631ca458f7SSlava Zakharin // Initialize any components that need initialization. 17641ca458f7SSlava Zakharin mlir::Value box = builder.createBox(loc, fir::ExtendedValue{varOp}); 17651ca458f7SSlava Zakharin fir::runtime::genDerivedTypeInitialize(builder, loc, box); 17661ca458f7SSlava Zakharin 1767e45f6e93SjeanPerier // StructureConstructor values may relate to name of components in parent 1768e45f6e93SjeanPerier // types. These components cannot be addressed directly, the parent 1769e45f6e93SjeanPerier // components must be addressed first. The loop below creates all the 1770e45f6e93SjeanPerier // required chains of hlfir.designate to address the parent components so 1771e45f6e93SjeanPerier // that the StructureConstructor can later be lowered by addressing these 1772e45f6e93SjeanPerier // parent components if needed. Note: the front-end orders the components in 17732d57333dSPeter Klausler // structure constructors. 1774e45f6e93SjeanPerier using ValueAndParent = std::tuple<const Fortran::lower::SomeExpr &, 1775e45f6e93SjeanPerier const Fortran::semantics::Symbol &, 1776e45f6e93SjeanPerier hlfir::EntityWithAttributes>; 1777e45f6e93SjeanPerier llvm::SmallVector<ValueAndParent> valuesAndParents; 1778e45f6e93SjeanPerier for (const auto &value : llvm::reverse(ctor.values())) { 1779e45f6e93SjeanPerier const Fortran::semantics::Symbol &compSym = *value.first; 17802d57333dSPeter Klausler hlfir::EntityWithAttributes currentParent = varOp; 17812d57333dSPeter Klausler for (Fortran::lower::ComponentReverseIterator compIterator( 17822d57333dSPeter Klausler ctor.result().derivedTypeSpec()); 17832d57333dSPeter Klausler !compIterator.lookup(compSym.name());) { 1784e45f6e93SjeanPerier const auto &parentType = compIterator.advanceToParentType(); 1785e45f6e93SjeanPerier llvm::StringRef parentName = toStringRef(parentType.name()); 1786e45f6e93SjeanPerier auto baseRecTy = mlir::cast<fir::RecordType>( 1787e45f6e93SjeanPerier hlfir::getFortranElementType(currentParent.getType())); 1788e45f6e93SjeanPerier auto parentCompType = baseRecTy.getType(parentName); 1789e45f6e93SjeanPerier assert(parentCompType && "failed to retrieve parent component type"); 1790e45f6e93SjeanPerier mlir::Type designatorType = builder.getRefType(parentCompType); 1791e45f6e93SjeanPerier mlir::Value newParent = builder.create<hlfir::DesignateOp>( 1792e45f6e93SjeanPerier loc, designatorType, currentParent, parentName, 1793e45f6e93SjeanPerier /*compShape=*/mlir::Value{}, hlfir::DesignateOp::Subscripts{}, 1794e45f6e93SjeanPerier /*substring=*/mlir::ValueRange{}, 1795e45f6e93SjeanPerier /*complexPart=*/std::nullopt, 1796e45f6e93SjeanPerier /*shape=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{}, 1797e45f6e93SjeanPerier fir::FortranVariableFlagsAttr{}); 1798e45f6e93SjeanPerier currentParent = hlfir::EntityWithAttributes{newParent}; 17991ca458f7SSlava Zakharin } 1800e45f6e93SjeanPerier valuesAndParents.emplace_back( 1801e45f6e93SjeanPerier ValueAndParent{value.second.value(), compSym, currentParent}); 1802e45f6e93SjeanPerier } 1803e45f6e93SjeanPerier 1804e45f6e93SjeanPerier HlfirDesignatorBuilder designatorBuilder(loc, converter, symMap, stmtCtx); 1805e45f6e93SjeanPerier for (const auto &iter : llvm::reverse(valuesAndParents)) { 1806e45f6e93SjeanPerier auto &sym = std::get<const Fortran::semantics::Symbol &>(iter); 1807e45f6e93SjeanPerier auto &expr = std::get<const Fortran::lower::SomeExpr &>(iter); 1808e45f6e93SjeanPerier auto &baseOp = std::get<hlfir::EntityWithAttributes>(iter); 1809e45f6e93SjeanPerier std::string name = converter.getRecordTypeFieldName(sym); 18101ca458f7SSlava Zakharin 18111ca458f7SSlava Zakharin // Generate DesignateOp for the component. 18121ca458f7SSlava Zakharin // The designator's result type is just a reference to the component type, 18131ca458f7SSlava Zakharin // because the whole component is being designated. 1814e45f6e93SjeanPerier auto baseRecTy = mlir::cast<fir::RecordType>( 1815e45f6e93SjeanPerier hlfir::getFortranElementType(baseOp.getType())); 1816e45f6e93SjeanPerier auto compType = baseRecTy.getType(name); 1817e45f6e93SjeanPerier assert(compType && "failed to retrieve component type"); 18181ca458f7SSlava Zakharin mlir::Value compShape = 18191ca458f7SSlava Zakharin designatorBuilder.genComponentShape(sym, compType); 18201ca458f7SSlava Zakharin mlir::Type designatorType = builder.getRefType(compType); 18211ca458f7SSlava Zakharin 18221ca458f7SSlava Zakharin mlir::Type fieldElemType = hlfir::getFortranElementType(compType); 18231ca458f7SSlava Zakharin llvm::SmallVector<mlir::Value, 1> typeParams; 18241ca458f7SSlava Zakharin if (auto charType = mlir::dyn_cast<fir::CharacterType>(fieldElemType)) { 18251ca458f7SSlava Zakharin if (charType.hasConstantLen()) { 18261ca458f7SSlava Zakharin mlir::Type idxType = builder.getIndexType(); 18271ca458f7SSlava Zakharin typeParams.push_back( 18281ca458f7SSlava Zakharin builder.createIntegerConstant(loc, idxType, charType.getLen())); 18298252137bSjeanPerier } else if (!hasDeferredCharacterLength(sym)) { 18308252137bSjeanPerier // If the length is not deferred, this is a parametrized derived type 18318252137bSjeanPerier // where the character length depends on the derived type length 18328252137bSjeanPerier // parameters. Otherwise, this is a pointer/allocatable component and 18338252137bSjeanPerier // the length will be set during the assignment. 18348252137bSjeanPerier TODO(loc, "automatic character component in structure constructor"); 18351ca458f7SSlava Zakharin } 18361ca458f7SSlava Zakharin } 18371ca458f7SSlava Zakharin 18381ca458f7SSlava Zakharin // Convert component symbol attributes to variable attributes. 18391ca458f7SSlava Zakharin fir::FortranVariableFlagsAttr attrs = 18401ca458f7SSlava Zakharin Fortran::lower::translateSymbolAttributes(builder.getContext(), sym); 18411ca458f7SSlava Zakharin 18421ca458f7SSlava Zakharin // Get the component designator. 18431ca458f7SSlava Zakharin auto lhs = builder.create<hlfir::DesignateOp>( 1844e45f6e93SjeanPerier loc, designatorType, baseOp, name, compShape, 18451ca458f7SSlava Zakharin hlfir::DesignateOp::Subscripts{}, 18461ca458f7SSlava Zakharin /*substring=*/mlir::ValueRange{}, 18471ca458f7SSlava Zakharin /*complexPart=*/std::nullopt, 18481ca458f7SSlava Zakharin /*shape=*/compShape, typeParams, attrs); 18491ca458f7SSlava Zakharin 18501ca458f7SSlava Zakharin if (attrs && bitEnumContainsAny(attrs.getFlags(), 18511ca458f7SSlava Zakharin fir::FortranVariableFlagsEnum::pointer)) { 18524998587eSDaniel Chen if (Fortran::semantics::IsProcedure(sym)) { 18534998587eSDaniel Chen // Procedure pointer components. 18544998587eSDaniel Chen if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>( 18554998587eSDaniel Chen expr)) { 18564998587eSDaniel Chen auto boxTy{ 18574998587eSDaniel Chen Fortran::lower::getUntypedBoxProcType(builder.getContext())}; 18584998587eSDaniel Chen hlfir::Entity rhs( 18594998587eSDaniel Chen fir::factory::createNullBoxProc(builder, loc, boxTy)); 18604998587eSDaniel Chen builder.createStoreWithConvert(loc, rhs, lhs); 18614998587eSDaniel Chen continue; 18624998587eSDaniel Chen } 18634998587eSDaniel Chen hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress( 18644998587eSDaniel Chen loc, converter, expr, symMap, stmtCtx))); 18654998587eSDaniel Chen builder.createStoreWithConvert(loc, rhs, lhs); 18664998587eSDaniel Chen continue; 18674998587eSDaniel Chen } 18681ca458f7SSlava Zakharin // Pointer component construction is just a copy of the box contents. 18691ca458f7SSlava Zakharin fir::ExtendedValue lhsExv = 18701ca458f7SSlava Zakharin hlfir::translateToExtendedValue(loc, builder, lhs); 18711ca458f7SSlava Zakharin auto *toBox = lhsExv.getBoxOf<fir::MutableBoxValue>(); 18721ca458f7SSlava Zakharin if (!toBox) 18731ca458f7SSlava Zakharin fir::emitFatalError(loc, "pointer component designator could not be " 18741ca458f7SSlava Zakharin "lowered to mutable box"); 18751ca458f7SSlava Zakharin Fortran::lower::associateMutableBox(converter, loc, *toBox, expr, 18761ca458f7SSlava Zakharin /*lbounds=*/std::nullopt, stmtCtx); 18771ca458f7SSlava Zakharin continue; 18781ca458f7SSlava Zakharin } 18791ca458f7SSlava Zakharin 18801ca458f7SSlava Zakharin // Use generic assignment for all the other cases. 18811ca458f7SSlava Zakharin bool allowRealloc = 18821ca458f7SSlava Zakharin attrs && 18831ca458f7SSlava Zakharin bitEnumContainsAny(attrs.getFlags(), 18841ca458f7SSlava Zakharin fir::FortranVariableFlagsEnum::allocatable); 18853a4e9f7aSSlava Zakharin // If the component is allocatable, then we have to check 18863a4e9f7aSSlava Zakharin // whether the RHS value is allocatable or not. 18873a4e9f7aSSlava Zakharin // If it is not allocatable, then AssignOp can be used directly. 18883a4e9f7aSSlava Zakharin // If it is allocatable, then using AssignOp for unallocated RHS 18893a4e9f7aSSlava Zakharin // will cause illegal dereference. When an unallocated allocatable 18903a4e9f7aSSlava Zakharin // value is used to construct an allocatable component, the component 18917046202cSjeanPerier // must just stay unallocated (see Fortran 2018 7.5.10 point 7). 189207593a39SSlava Zakharin 189307593a39SSlava Zakharin // If the component is allocatable and RHS is NULL() expression, then 189407593a39SSlava Zakharin // we can just skip it: the LHS must remain unallocated with its 189507593a39SSlava Zakharin // defined rank. 189607593a39SSlava Zakharin if (allowRealloc && 189707593a39SSlava Zakharin Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr)) 189807593a39SSlava Zakharin continue; 189907593a39SSlava Zakharin 19007046202cSjeanPerier bool keepLhsLength = false; 19017046202cSjeanPerier if (allowRealloc) 19027046202cSjeanPerier if (const Fortran::semantics::DeclTypeSpec *declType = sym.GetType()) 19037046202cSjeanPerier keepLhsLength = 19047046202cSjeanPerier declType->category() == 19057046202cSjeanPerier Fortran::semantics::DeclTypeSpec::Category::Character && 19067046202cSjeanPerier !declType->characterTypeSpec().length().isDeferred(); 19071fa4a0a0SSlava Zakharin // Handle special case when the initializer expression is 19081fa4a0a0SSlava Zakharin // '{%SET_LENGTH(x,const_kind)}'. In structure constructor, 19097046202cSjeanPerier // SET_LENGTH is used for initializers of non-allocatable character 19107046202cSjeanPerier // components so that the front-end can better 19117046202cSjeanPerier // fold and work with these structure constructors. 19127046202cSjeanPerier // Here, they are just noise since the assignment semantics will deal 19137046202cSjeanPerier // with any length mismatch, and creating an extra temp with the lhs 19147046202cSjeanPerier // length is useless. 19157046202cSjeanPerier // TODO: should this be moved into an hlfir.assign + hlfir.set_length 19167046202cSjeanPerier // pattern rewrite? 19177046202cSjeanPerier hlfir::Entity rhs = gen(expr); 19187046202cSjeanPerier if (auto set_length = rhs.getDefiningOp<hlfir::SetLengthOp>()) 19197046202cSjeanPerier rhs = hlfir::Entity{set_length.getString()}; 19201fa4a0a0SSlava Zakharin 19217046202cSjeanPerier // lambda to generate `lhs = rhs` and deal with potential rhs implicit 19227046202cSjeanPerier // cast 19237046202cSjeanPerier auto genAssign = [&] { 19243a4e9f7aSSlava Zakharin rhs = hlfir::loadTrivialScalar(loc, builder, rhs); 19257046202cSjeanPerier auto rhsCastAndCleanup = 19267046202cSjeanPerier hlfir::genTypeAndKindConvert(loc, builder, rhs, lhs.getType(), 19277046202cSjeanPerier /*preserveLowerBounds=*/allowRealloc); 19287046202cSjeanPerier builder.create<hlfir::AssignOp>(loc, rhsCastAndCleanup.first, lhs, 19297046202cSjeanPerier allowRealloc, 19301fa4a0a0SSlava Zakharin allowRealloc ? keepLhsLength : false, 1931ebd0b8a0SSlava Zakharin /*temporary_lhs=*/true); 19327046202cSjeanPerier if (rhsCastAndCleanup.second) 19337046202cSjeanPerier (*rhsCastAndCleanup.second)(); 19347046202cSjeanPerier }; 19357046202cSjeanPerier 19367046202cSjeanPerier if (!allowRealloc || !rhs.isMutableBox()) { 19377046202cSjeanPerier genAssign(); 19383a4e9f7aSSlava Zakharin continue; 19393a4e9f7aSSlava Zakharin } 19403a4e9f7aSSlava Zakharin 19413a4e9f7aSSlava Zakharin auto [rhsExv, cleanup] = 19423a4e9f7aSSlava Zakharin hlfir::translateToExtendedValue(loc, builder, rhs); 19433a4e9f7aSSlava Zakharin assert(!cleanup && "unexpected cleanup"); 19443a4e9f7aSSlava Zakharin auto *fromBox = rhsExv.getBoxOf<fir::MutableBoxValue>(); 19453a4e9f7aSSlava Zakharin if (!fromBox) 19463a4e9f7aSSlava Zakharin fir::emitFatalError(loc, "allocatable entity could not be lowered " 19473a4e9f7aSSlava Zakharin "to mutable box"); 19483a4e9f7aSSlava Zakharin mlir::Value isAlloc = 19493a4e9f7aSSlava Zakharin fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *fromBox); 19507046202cSjeanPerier builder.genIfThen(loc, isAlloc).genThen(genAssign).end(); 19511ca458f7SSlava Zakharin } 19521ca458f7SSlava Zakharin 195374dfded4SjeanPerier if (fir::isRecordWithAllocatableMember(recTy)) { 195474dfded4SjeanPerier // Deallocate allocatable components without calling final subroutines. 195574dfded4SjeanPerier // The Fortran 2018 section 9.7.3.2 about deallocation is not ruling 195674dfded4SjeanPerier // about the fate of allocatable components of structure constructors, 195774dfded4SjeanPerier // and there is no behavior consensus in other compilers. 195874dfded4SjeanPerier fir::FirOpBuilder *bldr = &builder; 195974dfded4SjeanPerier getStmtCtx().attachCleanup([=]() { 196074dfded4SjeanPerier fir::runtime::genDerivedTypeDestroyWithoutFinalization(*bldr, loc, box); 196174dfded4SjeanPerier }); 196274dfded4SjeanPerier } 19631ca458f7SSlava Zakharin return varOp; 1964c14ef2d7SJean Perier } 1965c14ef2d7SJean Perier 1966c14ef2d7SJean Perier mlir::Location getLoc() const { return loc; } 1967c14ef2d7SJean Perier Fortran::lower::AbstractConverter &getConverter() { return converter; } 1968c14ef2d7SJean Perier fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); } 1969c14ef2d7SJean Perier Fortran::lower::SymMap &getSymMap() { return symMap; } 1970c14ef2d7SJean Perier Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; } 1971c14ef2d7SJean Perier 1972c14ef2d7SJean Perier Fortran::lower::AbstractConverter &converter; 1973c14ef2d7SJean Perier Fortran::lower::SymMap &symMap; 1974c14ef2d7SJean Perier Fortran::lower::StatementContext &stmtCtx; 1975c14ef2d7SJean Perier mlir::Location loc; 1976c14ef2d7SJean Perier }; 1977c14ef2d7SJean Perier 197807b89273SJean Perier template <typename T> 1979583d492cSJean Perier hlfir::Entity 198007b89273SJean Perier HlfirDesignatorBuilder::genSubscript(const Fortran::evaluate::Expr<T> &expr) { 1981b91a25efSYusuke MINATO fir::FirOpBuilder &builder = getBuilder(); 1982b91a25efSYusuke MINATO mlir::arith::IntegerOverflowFlags iofBackup{}; 1983b91a25efSYusuke MINATO if (!getConverter().getLoweringOptions().getIntegerWrapAround()) { 1984b91a25efSYusuke MINATO iofBackup = builder.getIntegerOverflowFlags(); 1985b91a25efSYusuke MINATO builder.setIntegerOverflowFlags(mlir::arith::IntegerOverflowFlags::nsw); 1986b91a25efSYusuke MINATO } 198707b89273SJean Perier auto loweredExpr = 198807b89273SJean Perier HlfirBuilder(getLoc(), getConverter(), getSymMap(), getStmtCtx()) 198907b89273SJean Perier .gen(expr); 1990b91a25efSYusuke MINATO if (!getConverter().getLoweringOptions().getIntegerWrapAround()) 1991b91a25efSYusuke MINATO builder.setIntegerOverflowFlags(iofBackup); 199207b89273SJean Perier // Skip constant conversions that litters designators and makes generated 199307b89273SJean Perier // IR harder to read: directly use index constants for constant subscripts. 199407b89273SJean Perier mlir::Type idxTy = builder.getIndexType(); 1995583d492cSJean Perier if (!loweredExpr.isArray() && loweredExpr.getType() != idxTy) 1996a1fae71fSJean Perier if (auto cstIndex = fir::getIntIfConstant(loweredExpr)) 199707b89273SJean Perier return hlfir::EntityWithAttributes{ 199807b89273SJean Perier builder.createIntegerConstant(getLoc(), idxTy, *cstIndex)}; 1999583d492cSJean Perier return hlfir::loadTrivialScalar(loc, builder, loweredExpr); 200007b89273SJean Perier } 200107b89273SJean Perier 2002c14ef2d7SJean Perier } // namespace 2003c14ef2d7SJean Perier 2004fcfb620dSJean Perier hlfir::EntityWithAttributes Fortran::lower::convertExprToHLFIR( 2005c14ef2d7SJean Perier mlir::Location loc, Fortran::lower::AbstractConverter &converter, 2006c14ef2d7SJean Perier const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, 2007c14ef2d7SJean Perier Fortran::lower::StatementContext &stmtCtx) { 2008c14ef2d7SJean Perier return HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); 2009c14ef2d7SJean Perier } 20104e78f885SJean Perier 2011cedfd272SJean Perier fir::ExtendedValue Fortran::lower::convertToBox( 2012199e4974SJean Perier mlir::Location loc, Fortran::lower::AbstractConverter &converter, 2013ff2912a0SJean Perier hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx, 2014ff2912a0SJean Perier mlir::Type fortranType) { 201561c5c597STom Eccles fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 201661c5c597STom Eccles auto [exv, cleanup] = hlfir::convertToBox(loc, builder, entity, fortranType); 201761c5c597STom Eccles if (cleanup) 201861c5c597STom Eccles stmtCtx.attachCleanup(*cleanup); 201961c5c597STom Eccles return exv; 2020199e4974SJean Perier } 2021cedfd272SJean Perier 2022cedfd272SJean Perier fir::ExtendedValue Fortran::lower::convertExprToBox( 20234e78f885SJean Perier mlir::Location loc, Fortran::lower::AbstractConverter &converter, 20244e78f885SJean Perier const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, 20254e78f885SJean Perier Fortran::lower::StatementContext &stmtCtx) { 20264e78f885SJean Perier hlfir::EntityWithAttributes loweredExpr = 20274e78f885SJean Perier HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); 2028ff2912a0SJean Perier return convertToBox(loc, converter, loweredExpr, stmtCtx, 2029ff2912a0SJean Perier converter.genType(expr)); 20304e78f885SJean Perier } 20314e78f885SJean Perier 20327531c871SJean Perier fir::ExtendedValue Fortran::lower::convertToAddress( 20337531c871SJean Perier mlir::Location loc, Fortran::lower::AbstractConverter &converter, 2034ff2912a0SJean Perier hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx, 2035ff2912a0SJean Perier mlir::Type fortranType) { 20367531c871SJean Perier fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 203761c5c597STom Eccles auto [exv, cleanup] = 203861c5c597STom Eccles hlfir::convertToAddress(loc, builder, entity, fortranType); 203961c5c597STom Eccles if (cleanup) 204061c5c597STom Eccles stmtCtx.attachCleanup(*cleanup); 20414e78f885SJean Perier return exv; 20424e78f885SJean Perier } 2043ff2912a0SJean Perier 2044199e4974SJean Perier fir::ExtendedValue Fortran::lower::convertExprToAddress( 2045199e4974SJean Perier mlir::Location loc, Fortran::lower::AbstractConverter &converter, 2046199e4974SJean Perier const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, 2047199e4974SJean Perier Fortran::lower::StatementContext &stmtCtx) { 2048199e4974SJean Perier hlfir::EntityWithAttributes loweredExpr = 2049199e4974SJean Perier HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); 2050ff2912a0SJean Perier return convertToAddress(loc, converter, loweredExpr, stmtCtx, 2051ff2912a0SJean Perier converter.genType(expr)); 2052199e4974SJean Perier } 2053199e4974SJean Perier 2054199e4974SJean Perier fir::ExtendedValue Fortran::lower::convertToValue( 2055199e4974SJean Perier mlir::Location loc, Fortran::lower::AbstractConverter &converter, 2056199e4974SJean Perier hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx) { 2057199e4974SJean Perier auto &builder = converter.getFirOpBuilder(); 205861c5c597STom Eccles auto [exv, cleanup] = hlfir::convertToValue(loc, builder, entity); 205961c5c597STom Eccles if (cleanup) 206061c5c597STom Eccles stmtCtx.attachCleanup(*cleanup); 206161c5c597STom Eccles return exv; 2062199e4974SJean Perier } 2063199e4974SJean Perier 2064199e4974SJean Perier fir::ExtendedValue Fortran::lower::convertExprToValue( 2065199e4974SJean Perier mlir::Location loc, Fortran::lower::AbstractConverter &converter, 2066199e4974SJean Perier const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, 2067199e4974SJean Perier Fortran::lower::StatementContext &stmtCtx) { 2068199e4974SJean Perier hlfir::EntityWithAttributes loweredExpr = 2069199e4974SJean Perier HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); 2070199e4974SJean Perier return convertToValue(loc, converter, loweredExpr, stmtCtx); 2071199e4974SJean Perier } 20727531c871SJean Perier 207367f9b5aeSValentin Clement (バレンタイン クレメン) fir::ExtendedValue Fortran::lower::convertDataRefToValue( 207467f9b5aeSValentin Clement (バレンタイン クレメン) mlir::Location loc, Fortran::lower::AbstractConverter &converter, 207567f9b5aeSValentin Clement (バレンタイン クレメン) const Fortran::evaluate::DataRef &dataRef, Fortran::lower::SymMap &symMap, 207667f9b5aeSValentin Clement (バレンタイン クレメン) Fortran::lower::StatementContext &stmtCtx) { 207767f9b5aeSValentin Clement (バレンタイン クレメン) fir::FortranVariableOpInterface loweredExpr = 207867f9b5aeSValentin Clement (バレンタイン クレメン) HlfirDesignatorBuilder(loc, converter, symMap, stmtCtx).gen(dataRef); 207967f9b5aeSValentin Clement (バレンタイン クレメン) return convertToValue(loc, converter, loweredExpr, stmtCtx); 208067f9b5aeSValentin Clement (バレンタイン クレメン) } 208167f9b5aeSValentin Clement (バレンタイン クレメン) 20827531c871SJean Perier fir::MutableBoxValue Fortran::lower::convertExprToMutableBox( 20837531c871SJean Perier mlir::Location loc, Fortran::lower::AbstractConverter &converter, 20847531c871SJean Perier const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) { 20857531c871SJean Perier // Pointers and Allocatable cannot be temporary expressions. Temporaries may 20867531c871SJean Perier // be created while lowering it (e.g. if any indices expression of a 20877531c871SJean Perier // designator create temporaries), but they can be destroyed before using the 20887531c871SJean Perier // lowered pointer or allocatable; 20897531c871SJean Perier Fortran::lower::StatementContext localStmtCtx; 20907531c871SJean Perier hlfir::EntityWithAttributes loweredExpr = 20917531c871SJean Perier HlfirBuilder(loc, converter, symMap, localStmtCtx).gen(expr); 20927531c871SJean Perier fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue( 20937531c871SJean Perier loc, converter.getFirOpBuilder(), loweredExpr, localStmtCtx); 20947531c871SJean Perier auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>(); 20957531c871SJean Perier assert(mutableBox && "expression could not be lowered to mutable box"); 20967531c871SJean Perier return *mutableBox; 20977531c871SJean Perier } 2098c7ff45a5SJean Perier 2099c7ff45a5SJean Perier hlfir::ElementalAddrOp 2100c7ff45a5SJean Perier Fortran::lower::convertVectorSubscriptedExprToElementalAddr( 2101c7ff45a5SJean Perier mlir::Location loc, Fortran::lower::AbstractConverter &converter, 2102c7ff45a5SJean Perier const Fortran::lower::SomeExpr &designatorExpr, 2103c7ff45a5SJean Perier Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { 2104c7ff45a5SJean Perier return HlfirDesignatorBuilder(loc, converter, symMap, stmtCtx) 2105c7ff45a5SJean Perier .convertVectorSubscriptedExprToElementalAddr(designatorExpr); 2106c7ff45a5SJean Perier } 2107