[flang-commits] [flang] 583d492 - [flang][hlfir] Lower vector subscripted RHS designators

Jean Perier via flang-commits flang-commits at lists.llvm.org
Wed May 3 00:24:59 PDT 2023


Author: Jean Perier
Date: 2023-05-03T09:22:25+02:00
New Revision: 583d492c630655dc0cd57ad167dec03e6c5d211c

URL: https://github.com/llvm/llvm-project/commit/583d492c630655dc0cd57ad167dec03e6c5d211c
DIFF: https://github.com/llvm/llvm-project/commit/583d492c630655dc0cd57ad167dec03e6c5d211c.diff

LOG: [flang][hlfir] Lower vector subscripted RHS designators

Lower vector subscripted designators as values when they appear outside
of the assignment left-hand side and input IO contexts.

This matches Fortran semantics where vector subscripted designators cannot
be written to outside of the two contexts mentioned above: they are
passed/taken by value where they appear.

This patch uses the added hlfir.element_addr to lower vector designators
in lowering. But when reaching the end of the designator lowering, the
hlfir.element_addr is turned into an hlfir.elemental when lowering is
not asking for the hlfir.elemental_addr.

This approach allows lowering vector subscripted in the same way in
while visiting the designator, and only adapt to the context at the
edge.

The part where lowering uses the hlfir.elemental_addr will be
done in further patch as it requires lowering assignments in the
new hlfir.region_assign op, and there is not codegen yet for these
new operations.

Differential Revision: https://reviews.llvm.org/D149480

Added: 
    flang/test/Lower/HLFIR/vector-subscript-as-value.f90

Modified: 
    flang/include/flang/Optimizer/Builder/HLFIRTools.h
    flang/lib/Lower/Bridge.cpp
    flang/lib/Lower/ConvertExprToHLFIR.cpp
    flang/lib/Optimizer/Builder/HLFIRTools.cpp

Removed: 
    


################################################################################
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<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
 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 <typename T>
+  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<T> (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<Fortran::evaluate::Type<
                    Fortran::evaluate::TypeCategory::Character, 1>>::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<Fortran::evaluate::Type<
                    Fortran::evaluate::TypeCategory::Real, 4>>::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<Fortran::evaluate::Type<
                    Fortran::evaluate::TypeCategory::Integer, 4>>::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<hlfir::DesignateOp>(
+    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<hlfir::DesignateOp>(
         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<fir::FortranVariableOpInterface>(
         designate.getOperation());
   }
@@ -414,8 +466,20 @@ class HlfirDesignatorBuilder {
     };
     auto frontEndResultShape =
         Fortran::evaluate::GetShape(converter.getFoldingContext(), arrayRef);
+    auto tryGettingExtentFromFrontEnd =
+        [&](unsigned dim) -> std::pair<mlir::Value, fir::SequenceType::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(dim)))
+          return {builder.createIntegerConstant(loc, idxTy, *maybeI64),
+                  *maybeI64};
+      return {mlir::Value{}, fir::SequenceType::getUnknownExtent()};
+    };
     llvm::SmallVector<mlir::Value> resultExtents;
     fir::SequenceType::Shape resultTypeShape;
+    bool sawVectorSubscripts = false;
     for (auto subscript : llvm::enumerate(arrayRef.subscript())) {
       if (const auto *triplet =
               std::get_if<Fortran::evaluate::Triplet>(&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<Fortran::evaluate::IndirectSubscriptIntegerExpr>(
                 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<fir::SequenceType>().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<mlir::arith::SubIOp>(loc, oneBasedIndex, one);
+    mlir::Value offset =
+        builder.create<mlir::arith::MulIOp>(loc, zeroBased, step);
+    return builder.create<mlir::arith::AddIOp>(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<mlir::Value> 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<hlfir::ElementalAddrOp>(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<hlfir::DesignateOp::Triplet>(&subscript)) {
+        // subscript = (lb + (i-1)*step)
+        mlir::Value scalarSubscript = computeTripletPosition(
+            loc, builder, *triplet, getNextOneBasedIndex());
+        subscript = scalarSubscript;
+      } else {
+        hlfir::Entity valueSubscript{std::get<mlir::Value>(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<fir::SequenceType>().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<hlfir::YieldOp>(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<hlfir::ElementalAddrOp> 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<hlfir::DestroyOp>(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 <typename T>
-  hlfir::EntityWithAttributes
-  genSubscript(const Fortran::evaluate::Expr<T> &expr);
+  hlfir::Entity genSubscript(const Fortran::evaluate::Expr<T> &expr);
+
+  const std::optional<hlfir::ElementalAddrOp> &
+  getVectorSubscriptElementAddrOp() const {
+    return vectorSubscriptElementAddrOp;
+  }
+  void setVectorSubscriptElementAddrOp(
+      std::optional<hlfir::ElementalAddrOp> 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<hlfir::ElementalAddrOp> 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 <typename T>
-hlfir::EntityWithAttributes
+hlfir::Entity
 HlfirDesignatorBuilder::genSubscript(const Fortran::evaluate::Expr<T> &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<T>
+/// }
+/// ```
+//
+/// into
+///
+/// ```
+/// %expr = hlfir.elemental %shape : (!fir.shape<1>) -> hlfir.expr<?xT> {
+///   ^bb0(%i : index)
+///    .....
+///    %value = fir.load %scalarAddress : fir.ref<T>
+///    %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<hlfir::YieldOp>(
+                        elementalAddrOp.getBody().back().getTerminator())
+                        .getEntity()};
+  llvm::SmallVector<mlir::Value, 1> 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<hlfir::YieldOp>(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<!fir.array<20xi64>>, index) -> !fir.ref<i64>
+! CHECK:    %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref<i64>
+! CHECK:    %[[VAL_14:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_13]])  : (!fir.ref<!fir.array<100xi32>>, i64) -> !fir.ref<i32>
+! CHECK:    %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref<i32>
+! 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.array<20xi32>>, !fir.ref<!fir.array<20xi32>>, i1)
+! CHECK:  fir.call @_QPbar(%[[VAL_16]]#1) fastmath<contract> : (!fir.ref<!fir.array<20xi32>>) -> ()
+! CHECK:  hlfir.end_associate %[[VAL_16]]#1, %[[VAL_16]]#2 : !fir.ref<!fir.array<20xi32>>, 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<!fir.array<20xi64>>, index) -> !fir.ref<i64>
+! CHECK:    %[[VAL_24:.*]] = fir.load %[[VAL_23]] : !fir.ref<i64>
+! CHECK:    %[[VAL_25:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_22]], %[[VAL_13]], %[[VAL_24]])  : (!fir.ref<!fir.array<10x30x100xi32>>, index, index, i64) -> !fir.ref<i32>
+! CHECK:    %[[VAL_26:.*]] = fir.load %[[VAL_25]] : !fir.ref<i32>
+! 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<pointer>, uniq_name = "_QFfoo3Ex"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x?xi32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x?xi32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x?xi32>>>>)
+! 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<!fir.box<!fir.ptr<!fir.array<?x?x?xi32>>>>
+! 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<!fir.array<20xi64>>, index) -> !fir.ref<i64>
+! CHECK:    %[[VAL_21:.*]] = fir.load %[[VAL_20]] : !fir.ref<i64>
+! CHECK:    %[[VAL_22:.*]] = hlfir.designate %[[VAL_6]] (%[[VAL_19]], %[[VAL_10]], %[[VAL_21]])  : (!fir.box<!fir.ptr<!fir.array<?x?x?xi32>>>, index, index, i64) -> !fir.ref<i32>
+! CHECK:    %[[VAL_23:.*]] = fir.load %[[VAL_22]] : !fir.ref<i32>
+! 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<i64>
+! CHECK:  %[[VAL_15:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_14]])  : (!fir.box<!fir.array<?x!fir.type<_QFfoo4Tt1{at0:!fir.array<30x40x50x!fir.type<_QFfoo4Tt0{x:!fir.array<10x20x!fir.complex<4>>}>>}>>>, i64) -> !fir.ref<!fir.type<_QFfoo4Tt1{at0:!fir.array<30x40x50x!fir.type<_QFfoo4Tt0{x:!fir.array<10x20x!fir.complex<4>>}>>}>>
+! 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<i64>
+! 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<i64>
+! CHECK:  %[[VAL_31:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_32:.*]]:3 = fir.box_dims %[[VAL_13]]#0, %[[VAL_31]] : (!fir.box<!fir.array<?xi64>>, 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<i64>
+! CHECK:  %[[VAL_38:.*]] = fir.load %[[VAL_11]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_39:.*]] = hlfir.elemental %[[VAL_33]] : (!fir.shape<2>) -> !hlfir.expr<?x?xf32> {
+! 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<!fir.array<?xi64>>, index) -> !fir.ref<i64>
+! CHECK:    %[[VAL_47:.*]] = fir.load %[[VAL_46]] : !fir.ref<i64>
+! CHECK:    %[[VAL_48:.*]] = hlfir.designate %[[VAL_15]]{"at0"} <%[[VAL_19]]> (%[[VAL_45]], %[[VAL_30]], %[[VAL_47]])  : (!fir.ref<!fir.type<_QFfoo4Tt1{at0:!fir.array<30x40x50x!fir.type<_QFfoo4Tt0{x:!fir.array<10x20x!fir.complex<4>>}>>}>>, !fir.shape<3>, index, i64, i64) -> !fir.ref<!fir.type<_QFfoo4Tt0{x:!fir.array<10x20x!fir.complex<4>>}>>
+! CHECK:    %[[VAL_49:.*]] = hlfir.designate %[[VAL_48]]{"x"} <%[[VAL_36]]> (%[[VAL_37]], %[[VAL_38]]) imag : (!fir.ref<!fir.type<_QFfoo4Tt0{x:!fir.array<10x20x!fir.complex<4>>}>>, !fir.shape<2>, i64, i64) -> !fir.ref<f32>
+! CHECK:    %[[VAL_50:.*]] = fir.load %[[VAL_49]] : !fir.ref<f32>
+! 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<!fir.array<?xi64>>, 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<i64>
+! CHECK:  %[[VAL_14:.*]] = fir.load %[[VAL_6]]#0 : !fir.ref<i64>
+! 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<?x!fir.char<1,?>> {
+! CHECK:  ^bb0(%[[VAL_24:.*]]: index):
+! CHECK:    %[[VAL_25:.*]] = hlfir.designate %[[VAL_9]]#0 (%[[VAL_24]])  : (!fir.box<!fir.array<?xi64>>, index) -> !fir.ref<i64>
+! CHECK:    %[[VAL_26:.*]] = fir.load %[[VAL_25]] : !fir.ref<i64>
+! CHECK:    %[[VAL_27:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_26]]) substr %[[VAL_15]], %[[VAL_16]]  typeparams %[[VAL_22]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, i64, index, index, index) -> !fir.boxchar<1>
+! CHECK:    hlfir.yield_element %[[VAL_27]] : !fir.boxchar<1>
+! CHECK:  }


        


More information about the flang-commits mailing list