[flang][Lower] Implement lowering for new expression kind

flang/include/flang/Evaluate/expression.h

@@ -586,12 +586,15 @@ class Expr<Type<TypeCategory::Integer, KIND>>
   using DescriptorInquiries =
       std::conditional_t<KIND == DescriptorInquiry::Result::kind,
           std::tuple<DescriptorInquiry>, std::tuple<>>;
+  using RankOneBoundElements =
+      std::conditional_t<KIND == RankOneBoundElement::Result::kind,
+          std::tuple<RankOneBoundElement>, std::tuple<>>;
   using Others = std::tuple<Constant<Result>, ArrayConstructor<Result>,
       Designator<Result>, FunctionRef<Result>>;
 
 public:
   common::TupleToVariant<common::CombineTuples<Operations, Conversions, Indices,
-      TypeParamInquiries, DescriptorInquiries, Others>>
+      TypeParamInquiries, DescriptorInquiries, RankOneBoundElements, Others>>
       u;
 };
 

flang/include/flang/Evaluate/shape.h

@@ -165,6 +165,7 @@ class GetShapeHelper
 
   Result operator()(const ImpliedDoIndex &) const { return ScalarShape(); }
   Result operator()(const DescriptorInquiry &) const { return ScalarShape(); }
+  Result operator()(const RankOneBoundElement &) const { return ScalarShape(); }
   Result operator()(const TypeParamInquiry &) const { return ScalarShape(); }
   Result operator()(const BOZLiteralConstant &) const { return ScalarShape(); }
   Result operator()(const StaticDataObject::Pointer &) const {

flang/include/flang/Evaluate/traverse.h

@@ -161,6 +161,9 @@ class Traverse {
   Result operator()(const DescriptorInquiry &x) const {
     return visitor_(x.base());
   }
+  Result operator()(const RankOneBoundElement &x) const {
+    return visitor_(x.base());
+  }
 
   // Calls
   Result operator()(const SpecificIntrinsic &) const {

flang/include/flang/Evaluate/variable.h

@@ -435,6 +435,34 @@ class DescriptorInquiry {
   int dimension_{0}; // zero-based
 };
 
+// Represents the extraction of a single scalar element from a rank-1
+// integer array expression used as an explicit-shape array bound (F2023).
+// The inner expression is rank-1; this node is scalar (Rank() == 0).
+// dimension_ is zero-based.
+class RankOneBoundElement {
+public:
+  using Result = SubscriptInteger;
+  CLASS_BOILERPLATE(RankOneBoundElement)
+  RankOneBoundElement(common::CopyableIndirection<Expr<SubscriptInteger>> &&e,
+      int dim)
+      : base_{std::move(e)}, dimension_{dim} {}
+  RankOneBoundElement(Expr<SubscriptInteger> &&e, int dim)
+      : base_{std::move(e)}, dimension_{dim} {}
+
+  const Expr<SubscriptInteger> &base() const { return base_.value(); }
+  Expr<SubscriptInteger> &base() { return base_.value(); }
+  int dimension() const { return dimension_; }
+
+  static constexpr int Rank() { return 0; } // always scalar
+  static constexpr int Corank() { return 0; }
+  bool operator==(const RankOneBoundElement &) const;
+  llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
+
+private:
+  common::CopyableIndirection<Expr<SubscriptInteger>> base_;
+  int dimension_{0}; // zero-based
+};
+
 #define INSTANTIATE_VARIABLE_TEMPLATES \
   FOR_EACH_SPECIFIC_TYPE(template class Designator, )
 } // namespace Fortran::evaluate

flang/include/flang/Parser/dump-parse-tree.h

@@ -353,6 +353,7 @@ class ParseTreeDumper {
   NODE(parser, ExitStmt)
   NODE(parser, ExplicitCoshapeSpec)
   NODE(parser, ExplicitShapeSpec)
+  NODE(parser, ExplicitShapeBoundsSpec)
   NODE(parser, Expr)
   NODE(Expr, Parentheses)
   NODE(Expr, UnaryPlus)

flang/include/flang/Parser/parse-tree.h

@@ -1326,13 +1326,21 @@ WRAPPER_CLASS(ImpliedShapeSpec, std::list<AssumedImpliedSpec>);
 EMPTY_CLASS(AssumedRankSpec);
 
 // R815 array-spec ->
-//        explicit-shape-spec-list | assumed-shape-spec-list |
-//        deferred-shape-spec-list | assumed-size-spec | implied-shape-spec |
+//        explicit-shape-spec-list | explicit-shape-bounds-spec |
+//        assumed-shape-spec-list | deferred-shape-spec-list |
+//        assumed-size-spec | implied-shape-spec |
 //        implied-shape-or-assumed-size-spec | assumed-rank-spec
+
+struct ExplicitShapeBoundsSpec {
+  TUPLE_CLASS_BOILERPLATE(ExplicitShapeBoundsSpec);
+  std::tuple<std::optional<IntExpr>, IntExpr> t;
+};
+
 struct ArraySpec {
   UNION_CLASS_BOILERPLATE(ArraySpec);
-  std::variant<std::list<ExplicitShapeSpec>, std::list<AssumedShapeSpec>,
-      DeferredShapeSpecList, AssumedSizeSpec, ImpliedShapeSpec, AssumedRankSpec>
+  std::variant<std::list<ExplicitShapeSpec>, ExplicitShapeBoundsSpec,
+      std::list<AssumedShapeSpec>, DeferredShapeSpecList, AssumedSizeSpec,
+      ImpliedShapeSpec, AssumedRankSpec>
       u;
 };
 

flang/include/flang/Semantics/dump-expr.h

@@ -149,6 +149,7 @@ class DumpEvaluateExpr {
     Outdent();
   }
   void Show(const evaluate::DescriptorInquiry &x);
+  void Show(const evaluate::RankOneBoundElement &x);
   void Show(const evaluate::SpecificIntrinsic &);
   void Show(const evaluate::ProcedureDesignator &x);
   void Show(const evaluate::ActualArgument &x);

flang/lib/Evaluate/check-expression.cpp

@@ -91,6 +91,9 @@ class IsConstantExprHelper
             (IsIntentIn(sym) && !IsOptional(sym) &&
                 !sym.attrs().test(semantics::Attr::VALUE)));
   }
+  bool operator()(const RankOneBoundElement &x) const {
+    return (*this)(x.base());
+  }
 
   bool operator()(const ImpliedDoIndex &ido) const {
     return acImpliedDos_.find(ido.name) != acImpliedDos_.end() || !context_ ||
@@ -363,6 +366,7 @@ class IsInitialDataTargetHelper
         IsConstantExpr(x.upper(), context_) && (*this)(x.parent());
   }
   bool operator()(const DescriptorInquiry &) const { return false; }
+  bool operator()(const RankOneBoundElement &x) const { return false; } // unreachable
   template <typename T> bool operator()(const ArrayConstructor<T> &) const {
     return false;
   }
@@ -798,6 +802,10 @@ class CheckSpecificationExprHelper
     }
   }
 
+  Result operator()(const RankOneBoundElement &x) const {
+    return (*this)(x.base());
+  }
+
   Result operator()(const TypeParamInquiry &inq) const {
     if (scope_.IsDerivedType()) {
       if (!IsConstantExpr(inq, &context_) &&
@@ -1797,6 +1805,9 @@ class CollectUsedSymbolValuesHelper
   Result operator()(const DescriptorInquiry &) const {
     return {}; // doesn't count as a use
   }
+  Result operator()(const RankOneBoundElement &x) const {
+    return {}; // unreachable
+  }
 
   template <typename T> Result operator()(const ConditionalExpr<T> &condExpr) {
     auto restorer{common::ScopedSet(isDefinition_, false)};

flang/lib/Evaluate/fold-implementation.h

@@ -138,6 +138,8 @@ Expr<T> FoldOperation(FoldingContext &context, Designator<T> &&designator) {
 }
 Expr<TypeParamInquiry::Result> FoldOperation(
     FoldingContext &, TypeParamInquiry &&);
+Expr<RankOneBoundElement::Result> FoldOperation(
+    FoldingContext &, RankOneBoundElement &&);
 Expr<ImpliedDoIndex::Result> FoldOperation(
     FoldingContext &context, ImpliedDoIndex &&);
 template <typename T>

flang/lib/Evaluate/fold-integer.cpp

@@ -1554,6 +1554,20 @@ Expr<TypeParamInquiry::Result> FoldOperation(
   return AsExpr(std::move(inquiry));
 }
 
+Expr<RankOneBoundElement::Result> FoldOperation(
+    FoldingContext &context, RankOneBoundElement &&x) {
+  using ResultType = RankOneBoundElement::Result;
+  auto folded{Fold(context, Expr<ResultType>{x.base()})};
+  if (auto *c{UnwrapConstantValue<ResultType>(folded)}) {
+    // Base is a constant array; extract the element at dimension_ (0-based).
+    ConstantSubscripts at{c->lbounds()};
+    at[0] = c->lbounds()[0] + x.dimension();
+    return Expr<ResultType>{Constant<ResultType>{c->At(at)}};
+  }
+  return Expr<ResultType>{
+      RankOneBoundElement{std::move(folded), x.dimension()}};
+}
+
 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
   return common::visit(
       [](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);

flang/lib/Evaluate/formatting.cpp

@@ -847,6 +847,12 @@ llvm::raw_ostream &DescriptorInquiry::AsFortran(llvm::raw_ostream &o) const {
   return o << ",kind=" << DescriptorInquiry::Result::kind << ")";
 }
 
+llvm::raw_ostream &RankOneBoundElement::AsFortran(
+    llvm::raw_ostream &o) const {
+  llvm_unreachable("RankOneBoundElement has no Fortran representation");
+  return o;
+}
+
 llvm::raw_ostream &Assignment::AsFortran(llvm::raw_ostream &o) const {
   common::visit(
       common::visitors{

flang/lib/Evaluate/variable.cpp

@@ -764,6 +764,9 @@ bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const {
   return field_ == that.field_ && base_ == that.base_ &&
       dimension_ == that.dimension_;
 }
+bool RankOneBoundElement::operator==(const RankOneBoundElement &that) const {
+  return dimension_ == that.dimension_ && base_ == that.base_;
+}
 
 #ifdef _MSC_VER // disable bogus warning about missing definitions
 #pragma warning(disable : 4661)

flang/lib/Lower/ConvertExpr.cpp

@@ -1062,6 +1062,10 @@ class ScalarExprLowering {
     llvm_unreachable("unknown descriptor inquiry");
   }
 
+  ExtValue genval(const Fortran::evaluate::RankOneBoundElement &) {
+    llvm_unreachable("RankOneBoundElement in legacy lowering path");
+  }
+
   ExtValue genval(const Fortran::evaluate::TypeParamInquiry &) {
     TODO(getLoc(), "type parameter inquiry");
   }
@@ -6568,6 +6572,11 @@ class ArrayExprLowering {
     TODO(getLoc(), "array expr descriptor inquiry");
     return [](IterSpace iters) -> ExtValue { return mlir::Value{}; };
   }
+  CC genarr(const Fortran::evaluate::RankOneBoundElement &x) {
+    fir::emitFatalError(getLoc(),
+        "rank-1 bound element cannot appear in array context");
+    return [](IterSpace iters) -> ExtValue { return mlir::Value{}; };
+  }
   CC genarr(const Fortran::evaluate::StructureConstructor &x) {
     TODO(getLoc(), "structure constructor");
     return [](IterSpace iters) -> ExtValue { return mlir::Value{}; };

flang/lib/Lower/ConvertExprToHLFIR.cpp

@@ -1847,6 +1847,27 @@ class HlfirBuilder {
     llvm_unreachable("unknown descriptor inquiry");
   }
 
+  hlfir::EntityWithAttributes
+  gen(const Fortran::evaluate::RankOneBoundElement &x) {
+    mlir::Location loc = getLoc();
+    auto &builder = getBuilder();
+    using ResTy = Fortran::evaluate::RankOneBoundElement::Result;
+    mlir::Type resultType =
+        getConverter().genType(ResTy::category, ResTy::kind);
+    // Evaluate the rank-1 base expression.
+    Fortran::lower::SomeExpr someExpr{Fortran::evaluate::AsGenericExpr(
+        Fortran::evaluate::Expr<Fortran::evaluate::SomeInteger>{
+            Fortran::common::Clone(x.base())})};
+    hlfir::Entity baseArray{Fortran::lower::convertExprToHLFIR(
+        loc, getConverter(), someExpr, getSymMap(), getStmtCtx())};
+    // Extract element at dimension (1-based index).
+    mlir::Value idx = builder.createIntegerConstant(
+        loc, builder.getIndexType(), x.dimension() + 1);
+    mlir::Value elem = hlfir::loadElementAt(loc, builder, baseArray, {idx});
+    return hlfir::EntityWithAttributes{
+        builder.createConvert(loc, resultType, elem)};
+  }
+
   /// Build nested if-then-else chain by walking the right-skewed
   /// ConditionalExpr tree. The assignValue callback generates and assigns
   /// each value to avoid evaluating non-taken branches.

flang/lib/Lower/IterationSpace.cpp

@@ -166,6 +166,7 @@ class ArrayBaseFinder {
     return find(x.u);
   }
   RT find(const Fortran::evaluate::DescriptorInquiry &) { return {}; }
+  RT find(const Fortran::evaluate::RankOneBoundElement &) { return {}; }
   RT find(const Fortran::evaluate::SpecificIntrinsic &) { return {}; }
   RT find(const Fortran::evaluate::ProcedureDesignator &x) { return {}; }
   RT find(const Fortran::evaluate::ProcedureRef &x) {

flang/lib/Lower/Support/Utils.cpp

@@ -242,6 +242,11 @@ class HashEvaluateExpr {
            static_cast<unsigned>(x.dimension());
   }
   static unsigned
+  getHashValue(const Fortran::evaluate::RankOneBoundElement &x) {
+    return getHashValue(x.base()) * 141u +
+           static_cast<unsigned>(x.dimension()) * 17u;
+  }
+  static unsigned
   getHashValue(const Fortran::evaluate::StructureConstructor &x) {
     // FIXME: hash the contents.
     return 149u;
@@ -547,6 +552,10 @@ class IsEqualEvaluateExpr {
     return isEqual(x.base(), y.base()) && x.field() == y.field() &&
            x.dimension() == y.dimension();
   }
+  static bool isEqual(const Fortran::evaluate::RankOneBoundElement &x,
+                      const Fortran::evaluate::RankOneBoundElement &y) {
+    return x.dimension() == y.dimension() && isEqual(x.base(), y.base());
+  }
   static bool isEqual(const Fortran::evaluate::StructureConstructor &x,
                       const Fortran::evaluate::StructureConstructor &y) {
     const auto &xValues = x.values();

flang/lib/Parser/unparse.cpp

@@ -571,6 +571,10 @@ class UnparseVisitor {
     common::visit(
         common::visitors{
             [&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
+            [&](const ExplicitShapeBoundsSpec &y) {
+              Walk(std::get<std::optional<IntExpr>>(y.t), ":");
+              Walk(std::get<IntExpr>(y.t));
+            },
             [&](const std::list<AssumedShapeSpec> &y) { Walk(y, ","); },
             [&](const DeferredShapeSpecList &y) { Walk(y); },
             [&](const AssumedSizeSpec &y) { Walk(y); },

flang/lib/Semantics/dump-expr.cpp

@@ -195,6 +195,12 @@ void DumpEvaluateExpr::Show(const evaluate::DescriptorInquiry &x) {
   Outdent();
 }
 
+void DumpEvaluateExpr::Show(const evaluate::RankOneBoundElement &x) {
+  Indent(("rank-1 bound element [" + llvm::Twine(x.dimension()) + "]").str());
+  Show(x.base());
+  Outdent();
+}
+
 void DumpEvaluateExpr::Print(llvm::Twine twine) {
   outs_ << GetIndentString() << twine << '\n';
 }

flang/lib/Semantics/mod-file.cpp

@@ -59,6 +59,7 @@ static void PutBound(llvm::raw_ostream &, const Bound &);
 static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &);
 static void PutShape(
     llvm::raw_ostream &, const ArraySpec &, char open, char close);
+static bool HasRankOneBound(const ArraySpec &);
 static void PutMapper(llvm::raw_ostream &, const Symbol &, SemanticsContext &);
 
 static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);
@@ -974,18 +975,63 @@ void PutShapeSpec(llvm::raw_ostream &os, const ShapeSpec &x) {
     }
   }
 }
+
+// Check whether any bound in an ArraySpec holds a RankOneBoundElement,
+// indicating the shape came from a rank-1 integer array expression.
+bool HasRankOneBound(const ArraySpec &shape) {
+  const auto &first{shape.front()};
+  if (auto lb{first.lbound().GetExplicit()}) {
+    if (evaluate::UnwrapExpr<evaluate::RankOneBoundElement>(*lb)) {
+      return true;
+    }
+  }
+  if (auto ub{first.ubound().GetExplicit()}) {
+    if (evaluate::UnwrapExpr<evaluate::RankOneBoundElement>(*ub)) {
+      return true;
+    }
+  }
+  return false;
+}
+
 void PutShape(
     llvm::raw_ostream &os, const ArraySpec &shape, char open, char close) {
   if (!shape.empty()) {
     os << open;
-    bool first{true};
-    for (const auto &shapeSpec : shape) {
-      if (first) {
-        first = false;
-      } else {
-        os << ',';
+    if (HasRankOneBound(shape)) {
+      // Rank-1 bounds: all ShapeSpecs share the same rank-1 expression
+      // wrapped in RankOneBoundElement. Extract the base expression from the
+      // first element and emit it whole so the mod file round-trips through
+      // the parser as an ExplicitShapeBoundsSpec.
+      const auto &first{shape.front()};
+      if (!first.lbound().isColon()) {
+        auto lb{first.lbound().GetExplicit()};
+        if (auto *robe =
+                evaluate::UnwrapExpr<evaluate::RankOneBoundElement>(*lb)) {
+          robe->base().AsFortran(os);
+        } else {
+          PutBound(os, first.lbound());
+        }
+      }
+      os << ':';
+      if (!first.ubound().isColon()) {
+        auto ub{first.ubound().GetExplicit()};
+        if (auto *robe =
+                evaluate::UnwrapExpr<evaluate::RankOneBoundElement>(*ub)) {
+          robe->base().AsFortran(os);
+        } else {
+          PutBound(os, first.ubound());
+        }
+      }
+    } else {
+      bool first{true};
+      for (const auto &shapeSpec : shape) {
+        if (first) {
+          first = false;
+        } else {
+          os << ',';
+        }
+        PutShapeSpec(os, shapeSpec);
       }
-      PutShapeSpec(os, shapeSpec);
     }
     os << close;
   }