diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h index 5d64903eeb87b..0b1e36590f10b 100644 --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -27,6 +27,7 @@ namespace hlfir { class AssociateOp; class ElementalOp; +class ElementalAddrOp; class YieldElementOp; /// Is this an SSA value type for the value of a Fortran procedure @@ -390,6 +391,11 @@ std::pair> convertToBox(mlir::Location loc, fir::FirOpBuilder &builder, const hlfir::Entity &entity, mlir::Type targetType); +/// Clone an hlfir.elemental_addr into an hlfir.elemental value. +hlfir::ElementalOp cloneToElementalOp(mlir::Location loc, + fir::FirOpBuilder &builder, + hlfir::ElementalAddrOp elementalAddrOp); + } // namespace hlfir #endif // FORTRAN_OPTIMIZER_BUILDER_HLFIRTOOLS_H diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 15e0d0528e2c6..f5b581c881c14 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2994,6 +2994,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::common::visitors{ // [1] Plain old assignment. [&](const Fortran::evaluate::Assignment::Intrinsic &) { + if (Fortran::evaluate::HasVectorSubscript(assign.lhs)) + TODO(loc, "assignment to vector subscripted entity"); Fortran::lower::StatementContext stmtCtx; hlfir::Entity rhs = Fortran::lower::convertExprToHLFIR( loc, *this, assign.rhs, localSymbols, stmtCtx); diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp index 2dd61bb15833d..87c0099814fa8 100644 --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -35,6 +35,18 @@ namespace { /// Lower Designators to HLFIR. class HlfirDesignatorBuilder { +private: + /// Internal entry point on the rightest part of a evaluate::Designator. + template + hlfir::EntityWithAttributes + genLeafPartRef(const T &designatorNode, + bool vectorSubscriptDesignatorToValue) { + hlfir::EntityWithAttributes result = gen(designatorNode); + if (vectorSubscriptDesignatorToValue) + return turnVectorSubscriptedDesignatorIntoValue(result); + return result; + } + public: HlfirDesignatorBuilder(mlir::Location loc, Fortran::lower::AbstractConverter &converter, @@ -42,40 +54,62 @@ class HlfirDesignatorBuilder { Fortran::lower::StatementContext &stmtCtx) : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {} + /// Public entry points to lower a Designator (given its .u member, to + /// avoid the template arguments which does not matter here). + /// This lowers a designator to an hlfir variable SSA value (that can be + /// assigned to), except for vector subscripted designators that are + /// lowered by default to hlfir.expr value since they cannot be + /// represented as HLFIR variable SSA values. + // Character designators variant contains substrings using CharacterDesignators = decltype(Fortran::evaluate::Designator>::u); hlfir::EntityWithAttributes - gen(const CharacterDesignators &designatorVariant) { + gen(const CharacterDesignators &designatorVariant, + bool vectorSubscriptDesignatorToValue = true) { return std::visit( - [&](const auto &x) -> hlfir::EntityWithAttributes { return gen(x); }, + [&](const auto &x) -> hlfir::EntityWithAttributes { + return genLeafPartRef(x, vectorSubscriptDesignatorToValue); + }, designatorVariant); } // Character designators variant contains complex parts using RealDesignators = decltype(Fortran::evaluate::Designator>::u); - hlfir::EntityWithAttributes gen(const RealDesignators &designatorVariant) { + hlfir::EntityWithAttributes + gen(const RealDesignators &designatorVariant, + bool vectorSubscriptDesignatorToValue = true) { return std::visit( - [&](const auto &x) -> hlfir::EntityWithAttributes { return gen(x); }, + [&](const auto &x) -> hlfir::EntityWithAttributes { + return genLeafPartRef(x, vectorSubscriptDesignatorToValue); + }, designatorVariant); } // All other designators are similar using OtherDesignators = decltype(Fortran::evaluate::Designator>::u); - hlfir::EntityWithAttributes gen(const OtherDesignators &designatorVariant) { + hlfir::EntityWithAttributes + gen(const OtherDesignators &designatorVariant, + bool vectorSubscriptDesignatorToValue = true) { return std::visit( - [&](const auto &x) -> hlfir::EntityWithAttributes { return gen(x); }, + [&](const auto &x) -> hlfir::EntityWithAttributes { + return genLeafPartRef(x, vectorSubscriptDesignatorToValue); + }, designatorVariant); } hlfir::EntityWithAttributes - gen(const Fortran::evaluate::NamedEntity &namedEntity) { + genNamedEntity(const Fortran::evaluate::NamedEntity &namedEntity, + bool vectorSubscriptDesignatorToValue = true) { if (namedEntity.IsSymbol()) - return gen(Fortran::evaluate::SymbolRef{namedEntity.GetLastSymbol()}); - return gen(namedEntity.GetComponent()); + return genLeafPartRef( + Fortran::evaluate::SymbolRef{namedEntity.GetLastSymbol()}, + vectorSubscriptDesignatorToValue); + return genLeafPartRef(namedEntity.GetComponent(), + vectorSubscriptDesignatorToValue); } private: @@ -151,11 +185,29 @@ class HlfirDesignatorBuilder { fir::FortranVariableOpInterface genDesignate(mlir::Type designatorType, PartInfo &partInfo, fir::FortranVariableFlagsAttr attributes) { - auto designate = getBuilder().create( + fir::FirOpBuilder &builder = getBuilder(); + // Once a part with vector subscripts has been lowered, the following + // hlfir.designator (for the parts on the right of the designator) must + // be lowered inside the hlfir.elemental_addr because they depend on the + // hlfir.elemental_addr indices. + // All the subsequent Fortran indices however, should be lowered before + // the hlfir.elemental_addr because they should only be evaluated once, + // hence, the insertion point is restored outside of the + // hlfir.elemental_addr after generating the hlfir.designate. Example: in + // "X(VECTOR)%COMP(FOO(), BAR())", the calls to bar() and foo() must be + // generated outside of the hlfir.elemental, but the related hlfir.designate + // that depends on the scalar hlfir.designate of X(VECTOR) that was + // generated inside the hlfir.elemental_addr should be generated in the + // hlfir.elemental_addr. + if (auto elementalAddrOp = getVectorSubscriptElementAddrOp()) + builder.setInsertionPointToEnd(&elementalAddrOp->getBody().front()); + auto designate = builder.create( getLoc(), designatorType, partInfo.base.value().getBase(), partInfo.componentName, partInfo.componentShape, partInfo.subscripts, partInfo.substring, partInfo.complexPart, partInfo.resultShape, partInfo.typeParams, attributes); + if (auto elementalAddrOp = getVectorSubscriptElementAddrOp()) + builder.setInsertionPoint(*elementalAddrOp); return mlir::cast( designate.getOperation()); } @@ -414,8 +466,20 @@ class HlfirDesignatorBuilder { }; auto frontEndResultShape = Fortran::evaluate::GetShape(converter.getFoldingContext(), arrayRef); + auto tryGettingExtentFromFrontEnd = + [&](unsigned dim) -> std::pair { + // Use constant extent if possible. The main advantage to do this now + // is to get the best FIR array types as possible while lowering. + if (frontEndResultShape) + if (auto maybeI64 = + Fortran::evaluate::ToInt64(frontEndResultShape->at(dim))) + return {builder.createIntegerConstant(loc, idxTy, *maybeI64), + *maybeI64}; + return {mlir::Value{}, fir::SequenceType::getUnknownExtent()}; + }; llvm::SmallVector resultExtents; fir::SequenceType::Shape resultTypeShape; + bool sawVectorSubscripts = false; for (auto subscript : llvm::enumerate(arrayRef.subscript())) { if (const auto *triplet = std::get_if(&subscript.value().u)) { @@ -432,35 +496,43 @@ class HlfirDesignatorBuilder { ub = builder.createConvert(loc, idxTy, ub); mlir::Value stride = genSubscript(triplet->stride()); stride = builder.createConvert(loc, idxTy, stride); - mlir::Value extent; - // Use constant extent if possible. The main advantage to do this now - // is to get the best FIR array types as possible while lowering. - if (frontEndResultShape) - if (auto maybeI64 = Fortran::evaluate::ToInt64( - frontEndResultShape->at(resultExtents.size()))) { - resultTypeShape.push_back(*maybeI64); - extent = builder.createIntegerConstant(loc, idxTy, *maybeI64); - } - if (!extent) { - extent = builder.genExtentFromTriplet(loc, lb, ub, stride, idxTy); - resultTypeShape.push_back(fir::SequenceType::getUnknownExtent()); - } + auto [extentValue, shapeExtent] = + tryGettingExtentFromFrontEnd(resultExtents.size()); + resultTypeShape.push_back(shapeExtent); + if (!extentValue) + extentValue = + builder.genExtentFromTriplet(loc, lb, ub, stride, idxTy); + resultExtents.push_back(extentValue); partInfo.subscripts.emplace_back( hlfir::DesignateOp::Triplet{lb, ub, stride}); - resultExtents.push_back(extent); } else { const auto &expr = std::get( subscript.value().u) .value(); - if (expr.Rank() > 0) - TODO(getLoc(), "vector subscripts in HLFIR"); - partInfo.subscripts.push_back(genSubscript(expr)); + hlfir::Entity subscript = genSubscript(expr); + partInfo.subscripts.push_back(subscript); + if (expr.Rank() > 0) { + sawVectorSubscripts = true; + auto [extentValue, shapeExtent] = + tryGettingExtentFromFrontEnd(resultExtents.size()); + resultTypeShape.push_back(shapeExtent); + if (!extentValue) + extentValue = hlfir::genExtent(loc, builder, subscript, /*dim=*/0); + resultExtents.push_back(extentValue); + } } } - assert(resultExtents.size() == resultTypeShape.size() && "inconsistent hlfir.designate shape"); + + // For vector subscripts, create an hlfir.elemental_addr and continue + // lowering the designator inside it as if it was addressing an element of + // the vector subscripts. + if (sawVectorSubscripts) + return createVectorSubscriptElementAddrOp(partInfo, baseType, + resultExtents); + mlir::Type resultType = baseType.cast().getEleTy(); if (!resultTypeShape.empty()) { // Ranked array section. The result shape comes from the array section @@ -625,11 +697,132 @@ class HlfirDesignatorBuilder { return {baseType, fieldType}; } - /// Lower a subscript expression. If it is a scalar subscript that is - /// a variable, it is loaded into an integer value. + // Compute: "lb + (i-1)*step". + mlir::Value computeTripletPosition(mlir::Location loc, + fir::FirOpBuilder &builder, + hlfir::DesignateOp::Triplet &triplet, + mlir::Value oneBasedIndex) { + mlir::Type idxTy = builder.getIndexType(); + mlir::Value lb = builder.createConvert(loc, idxTy, std::get<0>(triplet)); + mlir::Value step = builder.createConvert(loc, idxTy, std::get<2>(triplet)); + mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); + oneBasedIndex = builder.createConvert(loc, idxTy, oneBasedIndex); + mlir::Value zeroBased = + builder.create(loc, oneBasedIndex, one); + mlir::Value offset = + builder.create(loc, zeroBased, step); + return builder.create(loc, lb, offset); + } + + /// Create an hlfir.element_addr operation to deal with vector subscripted + /// entities. This transforms the current vector subscripted array-ref into a + /// a scalar array-ref that is addressing the vector subscripted part given + /// the one based indices of the hlfir.element_addr. + /// The rest of the designator lowering will continue lowering any further + /// parts inside the hlfir.elemental as a scalar reference. + /// At the end of the designator lowering, the hlfir.elemental_addr will + /// be turned into an hlfir.elemental value, unless the caller of this + /// utility requested to get the hlfir.elemental_addr instead of lowering + /// the designator to an mlir::Value. + mlir::Type createVectorSubscriptElementAddrOp( + PartInfo &partInfo, mlir::Type baseType, + llvm::ArrayRef resultExtents) { + fir::FirOpBuilder &builder = getBuilder(); + mlir::Value shape = builder.genShape(loc, resultExtents); + // The type parameters to be added on the hlfir.elemental_addr are the ones + // of the whole designator (not the ones of the vector subscripted part). + // These are not yet known and will be added when finalizing the designator + // lowering. + auto elementalAddrOp = builder.create(loc, shape); + setVectorSubscriptElementAddrOp(elementalAddrOp); + builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front()); + mlir::Region::BlockArgListType indices = elementalAddrOp.getIndices(); + auto indicesIterator = indices.begin(); + auto getNextOneBasedIndex = [&]() -> mlir::Value { + assert(indicesIterator != indices.end() && "ill formed ElementalAddrOp"); + return *(indicesIterator++); + }; + // Transform the designator into a scalar designator computing the vector + // subscripted entity element address given one based indices (for the shape + // of the vector subscripted designator). + for (hlfir::DesignateOp::Subscript &subscript : partInfo.subscripts) { + if (auto *triplet = + std::get_if(&subscript)) { + // subscript = (lb + (i-1)*step) + mlir::Value scalarSubscript = computeTripletPosition( + loc, builder, *triplet, getNextOneBasedIndex()); + subscript = scalarSubscript; + } else { + hlfir::Entity valueSubscript{std::get(subscript)}; + if (valueSubscript.isScalar()) + continue; + // subscript = vector(i + (vector_lb-1)) + hlfir::Entity scalarSubscript = hlfir::getElementAt( + loc, builder, valueSubscript, {getNextOneBasedIndex()}); + scalarSubscript = + hlfir::loadTrivialScalar(loc, builder, scalarSubscript); + subscript = scalarSubscript; + } + } + builder.setInsertionPoint(elementalAddrOp); + return baseType.cast().getEleTy(); + } + + /// Yield the designator for the final part-ref inside the + /// hlfir.elemental_addr. + void finalizeElementAddrOp(hlfir::ElementalAddrOp elementalAddrOp, + hlfir::EntityWithAttributes elementAddr) { + fir::FirOpBuilder &builder = getBuilder(); + builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front()); + builder.create(loc, elementAddr); + builder.setInsertionPointAfter(elementalAddrOp); + } + + /// If the lowered designator has vector subscripts turn it into an + /// ElementalOp, otherwise, return the lowered designator. This should + /// only be called if the user did not request to get the + /// hlfir.elemental_addr. In Fortran, vector subscripted designators are only + /// writable on the left-hand side of an assignment and in input IO + /// statements. Otherwise, they are not variables (cannot be modified, their + /// value is taken at the place they appear). + hlfir::EntityWithAttributes turnVectorSubscriptedDesignatorIntoValue( + hlfir::EntityWithAttributes loweredDesignator) { + std::optional elementalAddrOp = + getVectorSubscriptElementAddrOp(); + if (!elementalAddrOp) + return loweredDesignator; + finalizeElementAddrOp(*elementalAddrOp, loweredDesignator); + // This vector subscript designator is only being read, transform the + // hlfir.elemental_addr into an hlfir.elemental. The content of the + // hlfir.elemental_addr is cloned, and the resulting address is loaded to + // get the new element value. + fir::FirOpBuilder &builder = getBuilder(); + mlir::Location loc = getLoc(); + mlir::Value elemental = + hlfir::cloneToElementalOp(loc, builder, *elementalAddrOp); + (*elementalAddrOp)->erase(); + setVectorSubscriptElementAddrOp(std::nullopt); + fir::FirOpBuilder *bldr = &builder; + getStmtCtx().attachCleanup( + [=]() { bldr->create(loc, elemental); }); + return hlfir::EntityWithAttributes{elemental}; + } + + /// Lower a subscript expression. If it is a scalar subscript that is a + /// variable, it is loaded into an integer value. If it is an array (for + /// vector subscripts) it is dereferenced if this is an allocatable or + /// pointer. template - hlfir::EntityWithAttributes - genSubscript(const Fortran::evaluate::Expr &expr); + hlfir::Entity genSubscript(const Fortran::evaluate::Expr &expr); + + const std::optional & + getVectorSubscriptElementAddrOp() const { + return vectorSubscriptElementAddrOp; + } + void setVectorSubscriptElementAddrOp( + std::optional elementalAddrOp) { + vectorSubscriptElementAddrOp = elementalAddrOp; + } mlir::Location getLoc() const { return loc; } Fortran::lower::AbstractConverter &getConverter() { return converter; } @@ -640,6 +833,9 @@ class HlfirDesignatorBuilder { Fortran::lower::AbstractConverter &converter; Fortran::lower::SymMap &symMap; Fortran::lower::StatementContext &stmtCtx; + // If there is a vector subscript, an elementalAddrOp is created + // to compute the address of the designator elements. + std::optional vectorSubscriptElementAddrOp{}; mlir::Location loc; }; @@ -1253,7 +1449,7 @@ class HlfirBuilder { hlfir::EntityWithAttributes entity = HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(), getStmtCtx()) - .gen(desc.base()); + .genNamedEntity(desc.base()); using ResTy = Fortran::evaluate::DescriptorInquiry::Result; mlir::Type resultType = getConverter().genType(ResTy::category, ResTy::kind); @@ -1304,25 +1500,20 @@ class HlfirBuilder { }; template -hlfir::EntityWithAttributes +hlfir::Entity HlfirDesignatorBuilder::genSubscript(const Fortran::evaluate::Expr &expr) { auto loweredExpr = HlfirBuilder(getLoc(), getConverter(), getSymMap(), getStmtCtx()) .gen(expr); - if (!loweredExpr.isArray()) { - fir::FirOpBuilder &builder = getBuilder(); - if (loweredExpr.isVariable()) + fir::FirOpBuilder &builder = getBuilder(); + // Skip constant conversions that litters designators and makes generated + // IR harder to read: directly use index constants for constant subscripts. + mlir::Type idxTy = builder.getIndexType(); + if (!loweredExpr.isArray() && loweredExpr.getType() != idxTy) + if (auto cstIndex = fir::getIntIfConstant(loweredExpr)) return hlfir::EntityWithAttributes{ - hlfir::loadTrivialScalar(loc, builder, loweredExpr).getBase()}; - // Skip constant conversions that litters designators and makes generated - // IR harder to read: directly use index constants for constant subscripts. - mlir::Type idxTy = builder.getIndexType(); - if (loweredExpr.getType() != idxTy) - if (auto cstIndex = fir::getIntIfConstant(loweredExpr)) - return hlfir::EntityWithAttributes{ - builder.createIntegerConstant(getLoc(), idxTy, *cstIndex)}; - } - return loweredExpr; + builder.createIntegerConstant(getLoc(), idxTy, *cstIndex)}; + return hlfir::loadTrivialScalar(loc, builder, loweredExpr); } } // namespace diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp index 21f08878fedc6..1c2e3cfffd111 100644 --- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp +++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp @@ -934,3 +934,52 @@ hlfir::convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder, exv = placeTrivialInMemory(loc, builder, base, targetType); return {exv, cleanup}; } + +/// Clone: +/// ``` +/// hlfir.elemental_addr %shape : !fir.shape<1> { +/// ^bb0(%i : index) +/// ..... +/// %hlfir.yield %scalarAddress : fir.ref +/// } +/// ``` +// +/// into +/// +/// ``` +/// %expr = hlfir.elemental %shape : (!fir.shape<1>) -> hlfir.expr { +/// ^bb0(%i : index) +/// ..... +/// %value = fir.load %scalarAddress : fir.ref +/// %hlfir.yield_element %value : T +/// } +/// ``` +hlfir::ElementalOp +hlfir::cloneToElementalOp(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::ElementalAddrOp elementalAddrOp) { + hlfir::Entity scalarAddress = + hlfir::Entity{mlir::cast( + elementalAddrOp.getBody().back().getTerminator()) + .getEntity()}; + llvm::SmallVector typeParams; + hlfir::genLengthParameters(loc, builder, scalarAddress, typeParams); + + builder.setInsertionPointAfter(elementalAddrOp); + auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b, + mlir::ValueRange oneBasedIndices) -> hlfir::Entity { + mlir::IRMapping mapper; + mapper.map(elementalAddrOp.getIndices(), oneBasedIndices); + mlir::Operation *newOp = nullptr; + for (auto &op : elementalAddrOp.getBody().back().getOperations()) + newOp = b.clone(op, mapper); + auto newYielOp = mlir::dyn_cast_or_null(newOp); + assert(newYielOp && "hlfir.elemental_addr is ill formed"); + hlfir::Entity newAddr{newYielOp.getEntity()}; + newYielOp->erase(); + return hlfir::loadTrivialScalar(l, b, newAddr); + }; + mlir::Type elementType = scalarAddress.getFortranElementType(); + return hlfir::genElementalOp(loc, builder, elementType, + elementalAddrOp.getShape(), typeParams, + genKernel); +} diff --git a/flang/test/Lower/HLFIR/vector-subscript-as-value.f90 b/flang/test/Lower/HLFIR/vector-subscript-as-value.f90 new file mode 100644 index 0000000000000..067bb65eeffe8 --- /dev/null +++ b/flang/test/Lower/HLFIR/vector-subscript-as-value.f90 @@ -0,0 +1,184 @@ +! Test lowering of vector subscript designators outside of the +! assignment left-and side and input IO context. +! RUN: bbc -emit-fir -hlfir -o - -I nw %s 2>&1 | FileCheck %s + +subroutine foo(x, y) + integer :: x(100) + integer(8) :: y(20) + call bar(x(y)) +end subroutine +! CHECK-LABEL: func.func @_QPfoo( +! CHECK: %[[VAL_2:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_3:[a-z0-9]*]]) {{.*}}Ex +! CHECK: %[[VAL_5:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) {{.*}}Ey +! CHECK: %[[VAL_8:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_10:.*]] = hlfir.elemental %[[VAL_9]] : (!fir.shape<1>) -> !hlfir.expr<20xi32> { +! CHECK: ^bb0(%[[VAL_11:.*]]: index): +! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_11]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref +! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_13]]) : (!fir.ref>, i64) -> !fir.ref +! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref +! CHECK: hlfir.yield_element %[[VAL_15]] : i32 +! CHECK: } +! CHECK: %[[VAL_16:.*]]:3 = hlfir.associate %[[VAL_17:.*]](%[[VAL_9]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<20xi32>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>, i1) +! CHECK: fir.call @_QPbar(%[[VAL_16]]#1) fastmath : (!fir.ref>) -> () +! CHECK: hlfir.end_associate %[[VAL_16]]#1, %[[VAL_16]]#2 : !fir.ref>, i1 +! CHECK: hlfir.destroy %[[VAL_17]] : !hlfir.expr<20xi32> + +subroutine foo2(x, y) + integer :: x(10, 30, 100) + integer(8) :: y(20) + call bar2(x(1:8:2, 5, y)) +end subroutine +! CHECK-LABEL: func.func @_QPfoo2( +! CHECK: %[[VAL_2:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_3:.*]] = arith.constant 30 : index +! CHECK: %[[VAL_4:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index) -> !fir.shape<3> +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_5:[a-z0-9]*]]) {{.*}}Ex +! CHECK: %[[VAL_7:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_7]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_8:[a-z0-9]*]]) {{.*}}Ey +! CHECK: %[[VAL_10:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_11:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_12:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_13:.*]] = arith.constant 5 : index +! CHECK: %[[VAL_14:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_15:.*]] = fir.shape %[[VAL_12]], %[[VAL_14]] : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_16:.*]] = hlfir.elemental %[[VAL_15]] : (!fir.shape<2>) -> !hlfir.expr<4x20xi32> { +! CHECK: ^bb0(%[[VAL_17:.*]]: index, %[[VAL_18:.*]]: index): +! CHECK: %[[VAL_19:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_20:.*]] = arith.subi %[[VAL_17]], %[[VAL_19]] : index +! CHECK: %[[VAL_21:.*]] = arith.muli %[[VAL_20]], %[[VAL_11]] : index +! CHECK: %[[VAL_22:.*]] = arith.addi %[[VAL_10]], %[[VAL_21]] : index +! CHECK: %[[VAL_23:.*]] = hlfir.designate %[[VAL_9]]#0 (%[[VAL_18]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_24:.*]] = fir.load %[[VAL_23]] : !fir.ref +! CHECK: %[[VAL_25:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_22]], %[[VAL_13]], %[[VAL_24]]) : (!fir.ref>, index, index, i64) -> !fir.ref +! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_25]] : !fir.ref +! CHECK: hlfir.yield_element %[[VAL_26]] : i32 +! CHECK: } + +subroutine foo3(x, y) + integer, pointer :: x(:, :, :) + integer(8) :: y(20) + call bar2(x(1:8:2, 5, y)) +end subroutine +! CHECK-LABEL: func.func @_QPfoo3( +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFfoo3Ex"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_3:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_4:[a-z0-9]*]]) {{.*}}Ey +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref>>> +! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_8:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_9:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_10:.*]] = arith.constant 5 : index +! CHECK: %[[VAL_11:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_9]], %[[VAL_11]] : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_13:.*]] = hlfir.elemental %[[VAL_12]] : (!fir.shape<2>) -> !hlfir.expr<4x20xi32> { +! CHECK: ^bb0(%[[VAL_14:.*]]: index, %[[VAL_15:.*]]: index): +! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_17:.*]] = arith.subi %[[VAL_14]], %[[VAL_16]] : index +! CHECK: %[[VAL_18:.*]] = arith.muli %[[VAL_17]], %[[VAL_8]] : index +! CHECK: %[[VAL_19:.*]] = arith.addi %[[VAL_7]], %[[VAL_18]] : index +! CHECK: %[[VAL_20:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_15]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_21:.*]] = fir.load %[[VAL_20]] : !fir.ref +! CHECK: %[[VAL_22:.*]] = hlfir.designate %[[VAL_6]] (%[[VAL_19]], %[[VAL_10]], %[[VAL_21]]) : (!fir.box>>, index, index, i64) -> !fir.ref +! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_22]] : !fir.ref +! CHECK: hlfir.yield_element %[[VAL_23]] : i32 +! CHECK: } + +subroutine foo4(at1, vector, i, j, k, l, step) + type t0 + complex :: x(10, 20) + end type + type t1 + type(t0) :: at0(30, 40, 50) + end type + type(t1) :: at1(:) + integer(8) :: vector(:), step, i, j, k, l + call bar3(at1(i)%at0(1:8:step, j, vector)%x(k, l)%im) +end subroutine +! CHECK-LABEL: func.func @_QPfoo4( +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Eat1 +! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_2:[a-z0-9]*]] {{.*}}Ei +! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_3:[a-z0-9]*]] {{.*}}Ej +! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_4:[a-z0-9]*]] {{.*}}Ek +! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_5:[a-z0-9]*]] {{.*}}El +! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_6:[a-z0-9]*]] {{.*}}Estep +! CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {{.*}}Evector +! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_8]]#0 : !fir.ref +! CHECK: %[[VAL_15:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_14]]) : (!fir.box>}>>}>>>, i64) -> !fir.ref>}>>}>> +! CHECK: %[[VAL_16:.*]] = arith.constant 30 : index +! CHECK: %[[VAL_17:.*]] = arith.constant 40 : index +! CHECK: %[[VAL_18:.*]] = arith.constant 50 : index +! CHECK: %[[VAL_19:.*]] = fir.shape %[[VAL_16]], %[[VAL_17]], %[[VAL_18]] : (index, index, index) -> !fir.shape<3> +! CHECK: %[[VAL_20:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_21:.*]] = arith.constant 8 : index +! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_12]]#0 : !fir.ref +! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i64) -> index +! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_21]], %[[VAL_20]] : index +! CHECK: %[[VAL_26:.*]] = arith.addi %[[VAL_25]], %[[VAL_23]] : index +! CHECK: %[[VAL_27:.*]] = arith.divsi %[[VAL_26]], %[[VAL_23]] : index +! CHECK: %[[VAL_28:.*]] = arith.cmpi sgt, %[[VAL_27]], %[[VAL_24]] : index +! CHECK: %[[VAL_29:.*]] = arith.select %[[VAL_28]], %[[VAL_27]], %[[VAL_24]] : index +! CHECK: %[[VAL_30:.*]] = fir.load %[[VAL_9]]#0 : !fir.ref +! CHECK: %[[VAL_31:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_32:.*]]:3 = fir.box_dims %[[VAL_13]]#0, %[[VAL_31]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_33:.*]] = fir.shape %[[VAL_29]], %[[VAL_32]]#1 : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_34:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_35:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_36:.*]] = fir.shape %[[VAL_34]], %[[VAL_35]] : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_37:.*]] = fir.load %[[VAL_10]]#0 : !fir.ref +! CHECK: %[[VAL_38:.*]] = fir.load %[[VAL_11]]#0 : !fir.ref +! CHECK: %[[VAL_39:.*]] = hlfir.elemental %[[VAL_33]] : (!fir.shape<2>) -> !hlfir.expr { +! CHECK: ^bb0(%[[VAL_40:.*]]: index, %[[VAL_41:.*]]: index): +! CHECK: %[[VAL_42:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_43:.*]] = arith.subi %[[VAL_40]], %[[VAL_42]] : index +! CHECK: %[[VAL_44:.*]] = arith.muli %[[VAL_43]], %[[VAL_23]] : index +! CHECK: %[[VAL_45:.*]] = arith.addi %[[VAL_20]], %[[VAL_44]] : index +! CHECK: %[[VAL_46:.*]] = hlfir.designate %[[VAL_13]]#0 (%[[VAL_41]]) : (!fir.box>, index) -> !fir.ref +! CHECK: %[[VAL_47:.*]] = fir.load %[[VAL_46]] : !fir.ref +! CHECK: %[[VAL_48:.*]] = hlfir.designate %[[VAL_15]]{"at0"} <%[[VAL_19]]> (%[[VAL_45]], %[[VAL_30]], %[[VAL_47]]) : (!fir.ref>}>>}>>, !fir.shape<3>, index, i64, i64) -> !fir.ref>}>> +! CHECK: %[[VAL_49:.*]] = hlfir.designate %[[VAL_48]]{"x"} <%[[VAL_36]]> (%[[VAL_37]], %[[VAL_38]]) imag : (!fir.ref>}>>, !fir.shape<2>, i64, i64) -> !fir.ref +! CHECK: %[[VAL_50:.*]] = fir.load %[[VAL_49]] : !fir.ref +! CHECK: hlfir.yield_element %[[VAL_50]] : f32 +! CHECK: } + +subroutine substring(c, vector, i, j) + character(*) :: c(:) + integer(8) :: vector(:), step, i, j + call bar4(c(vector)(i:j)) +end subroutine +! CHECK-LABEL: func.func @_QPsubstring( +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ec +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_2:[a-z0-9]*]] {{.*}}Ei +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_3:[a-z0-9]*]] {{.*}}Ej +! CHECK: %[[VAL_7:.*]] = fir.alloca i64 {bindc_name = "step", uniq_name = "_QFsubstringEstep"} +! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7:[a-z0-9]*]] {{.*}}Estep +! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {{.*}}Evector +! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_9]]#0, %[[VAL_10]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_11]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref +! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_6]]#0 : !fir.ref +! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_13]] : (i64) -> index +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_14]] : (i64) -> index +! CHECK: %[[VAL_17:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_16]], %[[VAL_15]] : index +! CHECK: %[[VAL_19:.*]] = arith.addi %[[VAL_18]], %[[VAL_17]] : index +! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_21:.*]] = arith.cmpi sgt, %[[VAL_19]], %[[VAL_20]] : index +! CHECK: %[[VAL_22:.*]] = arith.select %[[VAL_21]], %[[VAL_19]], %[[VAL_20]] : index +! CHECK: %[[VAL_23:.*]] = hlfir.elemental %[[VAL_12]] typeparams %[[VAL_22]] : (!fir.shape<1>, index) -> !hlfir.expr> { +! CHECK: ^bb0(%[[VAL_24:.*]]: index): +! CHECK: %[[VAL_25:.*]] = hlfir.designate %[[VAL_9]]#0 (%[[VAL_24]]) : (!fir.box>, index) -> !fir.ref +! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_25]] : !fir.ref +! CHECK: %[[VAL_27:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_26]]) substr %[[VAL_15]], %[[VAL_16]] typeparams %[[VAL_22]] : (!fir.box>>, i64, index, index, index) -> !fir.boxchar<1> +! CHECK: hlfir.yield_element %[[VAL_27]] : !fir.boxchar<1> +! CHECK: }