[flang] Simple array assignment lowering

[clementval]

Summary

This patch handles lowering of simple array assignment.

a(:) = 10

or

a(1) = 1

This patch is part of the upstreaming effort from fir-dev branch.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Evaluate/variable.h

 public:
   Triplet();
   DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(Triplet)
   Triplet(std::optional<Expr<SubscriptInteger>> &&,
       std::optional<Expr<SubscriptInteger>> &&,
       std::optional<Expr<SubscriptInteger>> &&);
 
   std::optional<Expr<SubscriptInteger>> lower() const;
+  const Expr<SubscriptInteger> *GetLower() const {
+    return lower_.has_value() ? &lower_->value() : nullptr;
+  }
   Triplet &set_lower(Expr<SubscriptInteger> &&);
   std::optional<Expr<SubscriptInteger>> upper() const;
+  const Expr<SubscriptInteger> *GetUpper() const {
+    return upper_.has_value() ? &upper_->value() : nullptr;
+  }
   Triplet &set_upper(Expr<SubscriptInteger> &&);
   Expr<SubscriptInteger> stride() const; // N.B. result is not optional<>
+  const Expr<SubscriptInteger> &GetStride() const { return stride_.value(); }
   Triplet &set_stride(Expr<SubscriptInteger> &&);
 
   bool operator==(const Triplet &) const;
   bool IsStrideOne() const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
 private:
   std::optional<IndirectSubscriptIntegerExpr> lower_, upper_;

flang/include/flang/Lower/ComponentPath.h

+//===-- ComponentPath.h -----------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_COMPONENTPATH_H
+#define FORTRAN_LOWER_COMPONENTPATH_H
+
+#include "flang/Lower/IterationSpace.h"
+#include "llvm/ADT/SmallVector.h"
+
+namespace fir {
+class ArrayLoadOp;
+}
+namespace Fortran::evaluate {
+class ArrayRef;
+}
+
+namespace Fortran::lower {
+
+namespace details {
+class ImplicitSubscripts {};
+} // namespace details
+
+using PathComponent =
+    std::variant<const evaluate::ArrayRef *, const evaluate::Component *,
+                 const Fortran::evaluate::ComplexPart *,
+                 details::ImplicitSubscripts>;
+
+/// Collection of components.
+///
+/// This class is used both to collect front-end post-order functional Expr
+/// trees and their translations to Values to be used in a pre-order list of
+/// arguments.
+class ComponentPath {
+public:
+  ComponentPath(bool isImplicit) { setPC(isImplicit); }
+  ComponentPath(bool isImplicit, const evaluate::Substring *ss)
+      : substring(ss) {
+    setPC(isImplicit);
+  }
+  ComponentPath() = delete;
+
+  bool isSlice() { return !trips.empty() || hasComponents(); }
+  bool hasComponents() { return !suffixComponents.empty(); }
+  void clear();
+
+  llvm::SmallVector<PathComponent> reversePath;
+  const evaluate::Substring *substring = nullptr;
+  bool applied = false;
+
+  llvm::SmallVector<mlir::Value> prefixComponents;
+  llvm::SmallVector<mlir::Value> trips;
+  llvm::SmallVector<mlir::Value> suffixComponents;
+  std::function<IterationSpace(const IterationSpace &)> pc;
+
+private:
+  void setPC(bool isImplicit);
+};
+
+/// Examine each subscript expression of \p x and return true if and only if any
+/// of the subscripts is a vector or has a rank greater than 0.
+bool isRankedArrayAccess(const Fortran::evaluate::ArrayRef &x);
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_COMPONENTPATH_H

flang/include/flang/Lower/ConvertExpr.h

 struct SomeType;
 } // namespace Fortran::evaluate
 
 namespace Fortran::lower {
 
 class AbstractConverter;
 class StatementContext;
 class SymMap;
+class ExplicitIterSpace;
+class ImplicitIterSpace;
+class StatementContext;
+
 using SomeExpr = Fortran::evaluate::Expr<Fortran::evaluate::SomeType>;
 
 /// Create an extended expression value.
 fir::ExtendedValue createSomeExtendedExpression(mlir::Location loc,
                                                 AbstractConverter &converter,
                                                 const SomeExpr &expr,
                                                 SymMap &symMap,
                                                 StatementContext &stmtCtx);

 /// subroutines. \p isUserDefAssignment must be set if this is called in the
 /// context of a user defined assignment. For subroutines with alternate
 /// returns, the returned value indicates which label the code should jump to.
 /// The returned value is null otherwise.
 mlir::Value createSubroutineCall(AbstractConverter &converter,
                                  const evaluate::ProcedureRef &call,
                                  SymMap &symMap, StatementContext &stmtCtx);
 
+/// Create the address of the box.
+/// \p expr must be the designator of an allocatable/pointer entity.
+fir::MutableBoxValue createMutableBox(mlir::Location loc,
+                                      AbstractConverter &converter,
+                                      const SomeExpr &expr, SymMap &symMap);
+
+/// Lower an array assignment expression.
+///
+/// 1. Evaluate the lhs to determine the rank and how to form the ArrayLoad
+/// (e.g., if there is a slicing op).
+/// 2. Scan the rhs, creating the ArrayLoads and evaluate the scalar subparts to
+/// be added to the map.
+/// 3. Create the loop nest and evaluate the elemental expression, threading the
+/// results.
+/// 4. Copy the resulting array back with ArrayMergeStore to the lhs as
+/// determined per step 1.
+void createSomeArrayAssignment(AbstractConverter &converter,
+                               const SomeExpr &lhs, const SomeExpr &rhs,
+                               SymMap &symMap, StatementContext &stmtCtx);
+
+/// Lower an array assignment expression with pre-evaluated left and right
+/// hand sides. This implements an array copy taking into account
+/// non-contiguity and potential overlaps.
+void createSomeArrayAssignment(AbstractConverter &converter,
+                               const fir::ExtendedValue &lhs,
+                               const fir::ExtendedValue &rhs, SymMap &symMap,
+                               StatementContext &stmtCtx);
+
+/// Lower an assignment to an allocatable array, allocating the array if
+/// it is not allocated yet or reallocation it if it does not conform
+/// with the right hand side.
+void createAllocatableArrayAssignment(AbstractConverter &converter,
+                                      const SomeExpr &lhs, const SomeExpr &rhs,
+                                      ExplicitIterSpace &explicitIterSpace,
+                                      ImplicitIterSpace &implicitIterSpace,
+                                      SymMap &symMap,
+                                      StatementContext &stmtCtx);
+
 // Attribute for an alloca that is a trivial adaptor for converting a value to
 // pass-by-ref semantics for a VALUE parameter. The optimizer may be able to
 // eliminate these.
 inline mlir::NamedAttribute getAdaptToByRefAttr(fir::FirOpBuilder &builder) {
   return {mlir::StringAttr::get(builder.getContext(),
                                 fir::getAdaptToByRefAttrName()),
           builder.getUnitAttr()};
 }
 
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_CONVERTEXPR_H

flang/include/flang/Lower/DumpEvaluateExpr.h

+//===-- Lower/DumpEvaluateExpr.h --------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_DUMPEVALUATEEXPR_H
+#define FORTRAN_LOWER_DUMPEVALUATEEXPR_H
+
+#include "flang/Evaluate/tools.h"
+#include "flang/Lower/Support/Utils.h"
+#include "llvm/ADT/StringRef.h"
+#include "llvm/ADT/Twine.h"
+
+namespace Fortran::lower {
+
+/// Class to dump Fortran::evaluate::Expr trees out in a user readable way.
+///
+/// FIXME: This can be improved to dump more information in some cases.
+class DumpEvaluateExpr {
+public:
+  DumpEvaluateExpr() : outs(llvm::errs()) {}
+  DumpEvaluateExpr(llvm::raw_ostream &str) : outs(str) {}
+
+  template <typename A>
+  static void dump(const A &x) {
+    DumpEvaluateExpr{}.show(x);
+  }
+  template <typename A>
+  static void dump(llvm::raw_ostream &stream, const A &x) {
+    DumpEvaluateExpr{stream}.show(x);
+  }
+
+private:
+  template <typename A, bool C>
+  void show(const Fortran::common::Indirection<A, C> &x) {
+    show(x.value());
+  }
+  template <typename A>
+  void show(const Fortran::semantics::SymbolRef x) {
+    show(*x);
+  }
+  template <typename A>
+  void show(const std::unique_ptr<A> &x) {
+    show(x.get());
+  }
+  template <typename A>
+  void show(const std::shared_ptr<A> &x) {
+    show(x.get());
+  }
+  template <typename A>
+  void show(const A *x) {
+    if (x) {
+      show(*x);
+      return;
+    }
+    print("nullptr");
+  }
+  template <typename A>
+  void show(const std::optional<A> &x) {
+    if (x) {
+      show(*x);
+      return;
+    }
+    print("None");
+  }
+  template <typename... A>
+  void show(const std::variant<A...> &u) {
+    std::visit([&](const auto &v) { show(v); }, u);
+  }
+  template <typename A>
+  void show(const std::vector<A> &x) {
+    indent("vector");
+    for (const auto &v : x)
+      show(v);
+    outdent();
+  }
+  void show(const Fortran::evaluate::BOZLiteralConstant &);
+  void show(const Fortran::evaluate::NullPointer &);
+  template <typename T>
+  void show(const Fortran::evaluate::Constant<T> &x) {
+    if constexpr (T::category == Fortran::common::TypeCategory::Derived) {
+      indent("derived constant");
+      for (const auto &map : x.values())
+        for (const auto &pair : map)
+          show(pair.second.value());
+      outdent();
+    } else {
+      print("constant");
+    }
+  }
+  void show(const Fortran::semantics::Symbol &symbol);
+  void show(const Fortran::evaluate::StaticDataObject &);
+  void show(const Fortran::evaluate::ImpliedDoIndex &);
+  void show(const Fortran::evaluate::BaseObject &x);
+  void show(const Fortran::evaluate::Component &x);
+  void show(const Fortran::evaluate::NamedEntity &x);
+  void show(const Fortran::evaluate::TypeParamInquiry &x);
+  void show(const Fortran::evaluate::Triplet &x);
+  void show(const Fortran::evaluate::Subscript &x);
+  void show(const Fortran::evaluate::ArrayRef &x);
+  void show(const Fortran::evaluate::CoarrayRef &x);
+  void show(const Fortran::evaluate::DataRef &x);
+  void show(const Fortran::evaluate::Substring &x);
+  void show(const Fortran::evaluate::ComplexPart &x);
+  template <typename T>
+  void show(const Fortran::evaluate::Designator<T> &x) {
+    indent("designator");
+    show(x.u);
+    outdent();
+  }
+  template <typename T>
+  void show(const Fortran::evaluate::Variable<T> &x) {
+    indent("variable");
+    show(x.u);
+    outdent();
+  }
+  void show(const Fortran::evaluate::DescriptorInquiry &x);
+  void show(const Fortran::evaluate::SpecificIntrinsic &);
+  void show(const Fortran::evaluate::ProcedureDesignator &x);
+  void show(const Fortran::evaluate::ActualArgument &x);
+  void show(const Fortran::evaluate::ProcedureRef &x) {
+    indent("procedure ref");
+    show(x.proc());
+    show(x.arguments());
+    outdent();
+  }
+  template <typename T>
+  void show(const Fortran::evaluate::FunctionRef<T> &x) {
+    indent("function ref");
+    show(x.proc());
+    show(x.arguments());
+    outdent();
+  }
+  template <typename T>
+  void show(const Fortran::evaluate::ArrayConstructorValue<T> &x) {
+    show(x.u);
+  }
+  template <typename T>
+  void show(const Fortran::evaluate::ArrayConstructorValues<T> &x) {
+    indent("array constructor value");
+    for (auto &v : x)
+      show(v);
+    outdent();
+  }
+  template <typename T>
+  void show(const Fortran::evaluate::ImpliedDo<T> &x) {
+    indent("implied do");
+    show(x.lower());
+    show(x.upper());
+    show(x.stride());
+    show(x.values());
+    outdent();
+  }
+  void show(const Fortran::semantics::ParamValue &x);
+  void
+  show(const Fortran::semantics::DerivedTypeSpec::ParameterMapType::value_type
+           &x);
+  void show(const Fortran::semantics::DerivedTypeSpec &x);
+  void show(const Fortran::evaluate::StructureConstructorValues::value_type &x);
+  void show(const Fortran::evaluate::StructureConstructor &x);
+  template <typename D, typename R, typename O>
+  void show(const Fortran::evaluate::Operation<D, R, O> &op) {
+    indent("unary op");
+    show(op.left());
+    outdent();
+  }
+  template <typename D, typename R, typename LO, typename RO>
+  void show(const Fortran::evaluate::Operation<D, R, LO, RO> &op) {
+    indent("binary op");
+    show(op.left());
+    show(op.right());
+    outdent();
+  }
+  void
+  show(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &x);
+  template <typename T>
+  void show(const Fortran::evaluate::Expr<T> &x) {
+    indent("expr T");
+    show(x.u);
+    outdent();
+  }
+
+  const char *getIndentString() const;
+  void print(llvm::Twine s);
+  void indent(llvm::StringRef s);
+  void outdent();
+
+  llvm::raw_ostream &outs;
+  unsigned level = 0;
+};
+
+LLVM_DUMP_METHOD void
+dumpEvExpr(const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &x);
+LLVM_DUMP_METHOD void dumpEvExpr(
+    const Fortran::evaluate::Expr<
+        Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 4>> &x);
+LLVM_DUMP_METHOD void dumpEvExpr(
+    const Fortran::evaluate::Expr<
+        Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 8>> &x);
+LLVM_DUMP_METHOD void dumpEvExpr(const Fortran::evaluate::ArrayRef &x);
+LLVM_DUMP_METHOD void dumpEvExpr(const Fortran::evaluate::DataRef &x);
+LLVM_DUMP_METHOD void dumpEvExpr(const Fortran::evaluate::Substring &x);
+LLVM_DUMP_METHOD void dumpEvExpr(
+    const Fortran::evaluate::Designator<
+        Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 4>> &x);
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_DUMPEVALUATEEXPR_H

flang/include/flang/Lower/IterationSpace.h

+//===-- IterationSpace.h ----------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_ITERATIONSPACE_H
+#define FORTRAN_LOWER_ITERATIONSPACE_H
+
+#include "flang/Evaluate/tools.h"
+#include "flang/Lower/StatementContext.h"
+#include "flang/Lower/SymbolMap.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+
+namespace llvm {
+class raw_ostream;
+}
+
+namespace Fortran {
+namespace evaluate {
+struct SomeType;
+template <typename>
+class Expr;
+} // namespace evaluate
+
+namespace lower {
+
+using FrontEndExpr = const evaluate::Expr<evaluate::SomeType> *;
+using FrontEndSymbol = const semantics::Symbol *;
+
+class AbstractConverter;
+
+unsigned getHashValue(FrontEndExpr x);
+bool isEqual(FrontEndExpr x, FrontEndExpr y);
+} // namespace lower
+} // namespace Fortran
+
+namespace llvm {
+template <>
+struct DenseMapInfo<Fortran::lower::FrontEndExpr> {
+  static inline Fortran::lower::FrontEndExpr getEmptyKey() {
+    return reinterpret_cast<Fortran::lower::FrontEndExpr>(~0);
+  }
+  static inline Fortran::lower::FrontEndExpr getTombstoneKey() {
+    return reinterpret_cast<Fortran::lower::FrontEndExpr>(~0 - 1);
+  }
+  static unsigned getHashValue(Fortran::lower::FrontEndExpr v) {
+    return Fortran::lower::getHashValue(v);
+  }
+  static bool isEqual(Fortran::lower::FrontEndExpr lhs,
+                      Fortran::lower::FrontEndExpr rhs) {
+    return Fortran::lower::isEqual(lhs, rhs);
+  }
+};
+} // namespace llvm
+
+namespace Fortran::lower {
+
+/// Abstraction of the iteration space for building the elemental compute loop
+/// of an array(-like) statement.
+class IterationSpace {
+public:
+  IterationSpace() = default;
+
+  template <typename A>
+  explicit IterationSpace(mlir::Value inArg, mlir::Value outRes,
+                          llvm::iterator_range<A> range)
+      : inArg{inArg}, outRes{outRes}, indices{range.begin(), range.end()} {}
+
+  explicit IterationSpace(const IterationSpace &from,
+                          llvm::ArrayRef<mlir::Value> idxs)
+      : inArg(from.inArg), outRes(from.outRes), element(from.element),
+        indices(idxs.begin(), idxs.end()) {}
+
+  /// Create a copy of the \p from IterationSpace and prepend the \p prefix
+  /// values and append the \p suffix values, respectively.
+  explicit IterationSpace(const IterationSpace &from,
+                          llvm::ArrayRef<mlir::Value> prefix,
+                          llvm::ArrayRef<mlir::Value> suffix)
+      : inArg(from.inArg), outRes(from.outRes), element(from.element) {
+    indices.assign(prefix.begin(), prefix.end());
+    indices.append(from.indices.begin(), from.indices.end());
+    indices.append(suffix.begin(), suffix.end());
+  }
+
+  bool empty() const { return indices.empty(); }
+
+  /// This is the output value as it appears as an argument in the innermost
+  /// loop in the nest. The output value is threaded through the loop (and
+  /// conditionals) to maintain proper SSA form.
+  mlir::Value innerArgument() const { return inArg; }
+
+  /// This is the output value as it appears as an output value from the
+  /// outermost loop in the loop nest. The output value is threaded through the
+  /// loop (and conditionals) to maintain proper SSA form.
+  mlir::Value outerResult() const { return outRes; }
+
+  /// Returns a vector for the iteration space. This vector is used to access
+  /// elements of arrays in the compute loop.
+  llvm::SmallVector<mlir::Value> iterVec() const { return indices; }
+
+  mlir::Value iterValue(std::size_t i) const {
+    assert(i < indices.size());
+    return indices[i];
+  }
+
+  /// Set (rewrite) the Value at a given index.
+  void setIndexValue(std::size_t i, mlir::Value v) {
+    assert(i < indices.size());
+    indices[i] = v;
+  }
+
+  void setIndexValues(llvm::ArrayRef<mlir::Value> vals) {
+    indices.assign(vals.begin(), vals.end());
+  }
+
+  void insertIndexValue(std::size_t i, mlir::Value av) {
+    assert(i <= indices.size());
+    indices.insert(indices.begin() + i, av);
+  }
+
+  /// Set the `element` value. This is the SSA value that corresponds to an
+  /// element of the resultant array value.
+  void setElement(fir::ExtendedValue &&ele) {
+    assert(!fir::getBase(element) && "result element already set");
+    element = ele;
+  }
+
+  /// Get the value that will be merged into the resultant array. This is the
+  /// computed value that will be stored to the lhs of the assignment.
+  mlir::Value getElement() const {
+    assert(fir::getBase(element) && "element must be set");
+    return fir::getBase(element);
+  }
+
+  /// Get the element as an extended value.
+  fir::ExtendedValue elementExv() const { return element; }
+
+  void clearIndices() { indices.clear(); }
+
+private:
+  mlir::Value inArg;
+  mlir::Value outRes;
+  fir::ExtendedValue element;
+  llvm::SmallVector<mlir::Value> indices;
+};
+
+using GenerateElementalArrayFunc =
+    std::function<fir::ExtendedValue(const IterationSpace &)>;
+
+template <typename A>
+class StackableConstructExpr {
+public:
+  bool empty() const { return stack.empty(); }
+
+  void growStack() { stack.push_back(A{}); }
+
+  /// Bind a front-end expression to a closure.
+  void bind(FrontEndExpr e, GenerateElementalArrayFunc &&fun) {
+    vmap.insert({e, std::move(fun)});
+  }
+
+  /// Replace the binding of front-end expression `e` with a new closure.
+  void rebind(FrontEndExpr e, GenerateElementalArrayFunc &&fun) {
+    vmap.erase(e);
+    bind(e, std::move(fun));
+  }
+
+  /// Get the closure bound to the front-end expression, `e`.
+  GenerateElementalArrayFunc getBoundClosure(FrontEndExpr e) const {
+    if (!vmap.count(e))
+      llvm::report_fatal_error(
+          "evaluate::Expr is not in the map of lowered mask expressions");
+    return vmap.lookup(e);
+  }
+
+  /// Has the front-end expression, `e`, been lowered and bound?
+  bool isLowered(FrontEndExpr e) const { return vmap.count(e); }
+
+  StatementContext &stmtContext() { return stmtCtx; }
+
+protected:
+  void shrinkStack() {
+    assert(!empty());
+    stack.pop_back();
+    if (empty()) {
+      stmtCtx.finalize();
+      vmap.clear();
+    }
+  }
+
+  // The stack for the construct information.
+  llvm::SmallVector<A> stack;
+
+  // Map each mask expression back to the temporary holding the initial
+  // evaluation results.
+  llvm::DenseMap<FrontEndExpr, GenerateElementalArrayFunc> vmap;
+
+  // Inflate the statement context for the entire construct. We have to cache
+  // the mask expression results, which are always evaluated first, across the
+  // entire construct.
+  StatementContext stmtCtx;
+};
+
+class ImplicitIterSpace;
+llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ImplicitIterSpace &);
+
+/// All array expressions have an implicit iteration space, which is isomorphic
+/// to the shape of the base array that facilitates the expression having a
+/// non-zero rank. This implied iteration space may be conditionalized
+/// (disjunctively) with an if-elseif-else like structure, specifically
+/// Fortran's WHERE construct.
+///
+/// This class is used in the bridge to collect the expressions from the
+/// front end (the WHERE construct mask expressions), forward them for lowering
+/// as array expressions in an "evaluate once" (copy-in, copy-out) semantics.
+/// See 10.2.3.2p3, 10.2.3.2p13, etc.
+class ImplicitIterSpace
+    : public StackableConstructExpr<llvm::SmallVector<FrontEndExpr>> {
+public:
+  using Base = StackableConstructExpr<llvm::SmallVector<FrontEndExpr>>;
+  using FrontEndMaskExpr = FrontEndExpr;
+
+  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
+                                       const ImplicitIterSpace &);
+
+  LLVM_DUMP_METHOD void dump() const;
+
+  void append(FrontEndMaskExpr e) {
+    assert(!empty());
+    getMasks().back().push_back(e);
+  }
+
+  llvm::SmallVector<FrontEndMaskExpr> getExprs() const {
+    llvm::SmallVector<FrontEndMaskExpr> maskList = getMasks()[0];
+    for (size_t i = 1, d = getMasks().size(); i < d; ++i)
+      maskList.append(getMasks()[i].begin(), getMasks()[i].end());
+    return maskList;
+  }
+
+  /// Add a variable binding, `var`, along with its shape for the mask
+  /// expression `exp`.
+  void addMaskVariable(FrontEndExpr exp, mlir::Value var, mlir::Value shape,
+                       mlir::Value header) {
+    maskVarMap.try_emplace(exp, std::make_tuple(var, shape, header));
+  }
+
+  /// Lookup the variable corresponding to the temporary buffer that contains
+  /// the mask array expression results.
+  mlir::Value lookupMaskVariable(FrontEndExpr exp) {
+    return std::get<0>(maskVarMap.lookup(exp));
+  }
+
+  /// Lookup the variable containing the shape vector for the mask array
+  /// expression results.
+  mlir::Value lookupMaskShapeBuffer(FrontEndExpr exp) {
+    return std::get<1>(maskVarMap.lookup(exp));
+  }
+
+  mlir::Value lookupMaskHeader(FrontEndExpr exp) {
+    return std::get<2>(maskVarMap.lookup(exp));
+  }
+
+  // Stack of WHERE constructs, each building a list of mask expressions.
+  llvm::SmallVector<llvm::SmallVector<FrontEndMaskExpr>> &getMasks() {
+    return stack;
+  }
+  const llvm::SmallVector<llvm::SmallVector<FrontEndMaskExpr>> &
+  getMasks() const {
+    return stack;
+  }
+
+  // Cleanup at the end of a WHERE statement or construct.
+  void shrinkStack() {
+    Base::shrinkStack();
+    if (stack.empty())
+      maskVarMap.clear();
+  }
+
+private:
+  llvm::DenseMap<FrontEndExpr,
+                 std::tuple<mlir::Value, mlir::Value, mlir::Value>>
+      maskVarMap;
+};
+
+class ExplicitIterSpace;
+llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ExplicitIterSpace &);
+
+/// Create all the array_load ops for the explicit iteration space context. The
+/// nest of FORALLs must have been analyzed a priori.
+void createArrayLoads(AbstractConverter &converter, ExplicitIterSpace &esp,
+                      SymMap &symMap);
+
+/// Create the array_merge_store ops after the explicit iteration space context
+/// is conmpleted.
+void createArrayMergeStores(AbstractConverter &converter,
+                            ExplicitIterSpace &esp);
+using ExplicitSpaceArrayBases =
+    std::variant<FrontEndSymbol, const evaluate::Component *,
+                 const evaluate::ArrayRef *>;
+
+unsigned getHashValue(const ExplicitSpaceArrayBases &x);
+bool isEqual(const ExplicitSpaceArrayBases &x,
+             const ExplicitSpaceArrayBases &y);
+
+} // namespace Fortran::lower
+
+namespace llvm {
+template <>
+struct DenseMapInfo<Fortran::lower::ExplicitSpaceArrayBases> {
+  static inline Fortran::lower::ExplicitSpaceArrayBases getEmptyKey() {
+    return reinterpret_cast<Fortran::lower::FrontEndSymbol>(~0);
+  }
+  static inline Fortran::lower::ExplicitSpaceArrayBases getTombstoneKey() {
+    return reinterpret_cast<Fortran::lower::FrontEndSymbol>(~0 - 1);
+  }
+  static unsigned
+  getHashValue(const Fortran::lower::ExplicitSpaceArrayBases &v) {
+    return Fortran::lower::getHashValue(v);
+  }
+  static bool isEqual(const Fortran::lower::ExplicitSpaceArrayBases &lhs,
+                      const Fortran::lower::ExplicitSpaceArrayBases &rhs) {
+    return Fortran::lower::isEqual(lhs, rhs);
+  }
+};
+} // namespace llvm
+
+namespace Fortran::lower {
+/// Fortran also allows arrays to be evaluated under constructs which allow the
+/// user to explicitly specify the iteration space using concurrent-control
+/// expressions. These constructs allow the user to define both an iteration
+/// space and explicit access vectors on arrays. These need not be isomorphic.
+/// The explicit iteration spaces may be conditionalized (conjunctively) with an
+/// "and" structure and may be found in FORALL (and DO CONCURRENT) constructs.
+///
+/// This class is used in the bridge to collect a stack of lists of
+/// concurrent-control expressions to be used to generate the iteration space
+/// and associated masks (if any) for a set of nested FORALL constructs around
+/// assignment and WHERE constructs.
+class ExplicitIterSpace {
+public:
+  using IterSpaceDim =
+      std::tuple<FrontEndSymbol, FrontEndExpr, FrontEndExpr, FrontEndExpr>;
+  using ConcurrentSpec =
+      std::pair<llvm::SmallVector<IterSpaceDim>, FrontEndExpr>;
+  using ArrayBases = ExplicitSpaceArrayBases;
+
+  friend void createArrayLoads(AbstractConverter &converter,
+                               ExplicitIterSpace &esp, SymMap &symMap);
+  friend void createArrayMergeStores(AbstractConverter &converter,
+                                     ExplicitIterSpace &esp);
+
+  /// Is a FORALL context presently active?
+  /// If we are lowering constructs/statements nested within a FORALL, then a
+  /// FORALL context is active.
+  bool isActive() const { return forallContextOpen != 0; }
+
+  /// Get the statement context.
+  StatementContext &stmtContext() { return stmtCtx; }
+
+  //===--------------------------------------------------------------------===//
+  // Analysis support
+  //===--------------------------------------------------------------------===//
+
+  /// Open a new construct. The analysis phase starts here.
+  void pushLevel();
+
+  /// Close the construct.
+  void popLevel();
+
+  /// Add new concurrent header control variable symbol.
+  void addSymbol(FrontEndSymbol sym);
+
+  /// Collect array bases from the expression, `x`.
+  void exprBase(FrontEndExpr x, bool lhs);
+
+  /// Called at the end of a assignment statement.
+  void endAssign();
+
+  /// Return all the active control variables on the stack.
+  llvm::SmallVector<FrontEndSymbol> collectAllSymbols();
+
+  //===--------------------------------------------------------------------===//
+  // Code gen support
+  //===--------------------------------------------------------------------===//
+
+  /// Enter a FORALL context.
+  void enter() { forallContextOpen++; }
+
+  /// Leave a FORALL context.
+  void leave();
+
+  void pushLoopNest(std::function<void()> lambda) {
+    ccLoopNest.push_back(lambda);
+  }
+
+  /// Get the inner arguments that correspond to the output arrays.
+  mlir::ValueRange getInnerArgs() const { return innerArgs; }
+
+  /// Set the inner arguments for the next loop level.
+  void setInnerArgs(llvm::ArrayRef<mlir::BlockArgument> args) {
+    innerArgs.clear();
+    for (auto &arg : args)
+      innerArgs.push_back(arg);
+  }
+
+  /// Reset the outermost `array_load` arguments to the loop nest.
+  void resetInnerArgs() { innerArgs = initialArgs; }
+
+  /// Capture the current outermost loop.
+  void setOuterLoop(fir::DoLoopOp loop) {
+    clearLoops();
+    outerLoop = loop;
+  }
+
+  /// Sets the inner loop argument at position \p offset to \p val.
+  void setInnerArg(size_t offset, mlir::Value val) {
+    assert(offset < innerArgs.size());
+    innerArgs[offset] = val;
+  }
+
+  /// Get the types of the output arrays.
+  llvm::SmallVector<mlir::Type> innerArgTypes() const {
+    llvm::SmallVector<mlir::Type> result;
+    for (auto &arg : innerArgs)
+      result.push_back(arg.getType());
+    return result;
+  }
+
+  /// Create a binding between an Ev::Expr node pointer and a fir::array_load
+  /// op. This bindings will be used when generating the IR.
+  void bindLoad(ArrayBases base, fir::ArrayLoadOp load) {
+    loadBindings.try_emplace(std::move(base), load);
+  }
+
+  fir::ArrayLoadOp findBinding(const ArrayBases &base) {
+    return loadBindings.lookup(base);
+  }
+
+  /// `load` must be a LHS array_load. Returns `llvm::None` on error.
+  llvm::Optional<size_t> findArgPosition(fir::ArrayLoadOp load);
+
+  bool isLHS(fir::ArrayLoadOp load) { return findArgPosition(load).hasValue(); }
+
+  /// `load` must be a LHS array_load. Determine the threaded inner argument
+  /// corresponding to this load.
+  mlir::Value findArgumentOfLoad(fir::ArrayLoadOp load) {
+    if (auto opt = findArgPosition(load))
+      return innerArgs[*opt];
+    llvm_unreachable("array load argument not found");
+  }
+
+  size_t argPosition(mlir::Value arg) {
+    for (auto i : llvm::enumerate(innerArgs))
+      if (arg == i.value())
+        return i.index();
+    llvm_unreachable("inner argument value was not found");
+  }
+
+  llvm::Optional<fir::ArrayLoadOp> getLhsLoad(size_t i) {
+    assert(i < lhsBases.size());
+    if (lhsBases[counter].hasValue())
+      return findBinding(lhsBases[counter].getValue());
+    return llvm::None;
+  }
+
+  /// Return the outermost loop in this FORALL nest.
+  fir::DoLoopOp getOuterLoop() {
+    assert(outerLoop.hasValue());
+    return outerLoop.getValue();
+  }
+
+  /// Return the statement context for the entire, outermost FORALL construct.
+  StatementContext &outermostContext() { return outerContext; }
+
+  /// Generate the explicit loop nest.
+  void genLoopNest() {
+    for (auto &lambda : ccLoopNest)
+      lambda();
+  }
+
+  /// Clear the array_load bindings.
+  void resetBindings() { loadBindings.clear(); }
+
+  /// Get the current counter value.
+  std::size_t getCounter() const { return counter; }
+
+  /// Increment the counter value to the next assignment statement.
+  void incrementCounter() { counter++; }
+
+  bool isOutermostForall() const {
+    assert(forallContextOpen);
+    return forallContextOpen == 1;
+  }
+
+  void attachLoopCleanup(std::function<void(fir::FirOpBuilder &builder)> fn) {
+    if (!loopCleanup.hasValue()) {
+      loopCleanup = fn;
+      return;
+    }
+    std::function<void(fir::FirOpBuilder &)> oldFn = loopCleanup.getValue();
+    loopCleanup = [=](fir::FirOpBuilder &builder) {
+      oldFn(builder);
+      fn(builder);
+    };
+  }
+
+  // LLVM standard dump method.
+  LLVM_DUMP_METHOD void dump() const;
+
+  // Pretty-print.
+  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
+                                       const ExplicitIterSpace &);
+
+  /// Finalize the current body statement context.
+  void finalizeContext() { stmtCtx.finalize(); }
+
+  void appendLoops(const llvm::SmallVector<fir::DoLoopOp> &loops) {
+    loopStack.push_back(loops);
+  }
+
+  void clearLoops() { loopStack.clear(); }
+
+  llvm::SmallVector<llvm::SmallVector<fir::DoLoopOp>> getLoopStack() const {
+    return loopStack;
+  }
+
+private:
+  /// Cleanup the analysis results.
+  void conditionalCleanup();
+
+  StatementContext outerContext;
+
+  // A stack of lists of front-end symbols.
+  llvm::SmallVector<llvm::SmallVector<FrontEndSymbol>> symbolStack;
+  llvm::SmallVector<llvm::Optional<ArrayBases>> lhsBases;
+  llvm::SmallVector<llvm::SmallVector<ArrayBases>> rhsBases;
+  llvm::DenseMap<ArrayBases, fir::ArrayLoadOp> loadBindings;
+
+  // Stack of lambdas to create the loop nest.
+  llvm::SmallVector<std::function<void()>> ccLoopNest;
+
+  // Assignment statement context (inside the loop nest).
+  StatementContext stmtCtx;
+  llvm::SmallVector<mlir::Value> innerArgs;
+  llvm::SmallVector<mlir::Value> initialArgs;
+  llvm::Optional<fir::DoLoopOp> outerLoop;
+  llvm::SmallVector<llvm::SmallVector<fir::DoLoopOp>> loopStack;
+  llvm::Optional<std::function<void(fir::FirOpBuilder &)>> loopCleanup;
+  std::size_t forallContextOpen = 0;
+  std::size_t counter = 0;
+};
+
+/// Is there a Symbol in common between the concurrent header set and the set
+/// of symbols in the expression?
+template <typename A>
+bool symbolSetsIntersect(llvm::ArrayRef<FrontEndSymbol> ctrlSet,
+                         const A &exprSyms) {
+  for (const auto &sym : exprSyms)
+    if (std::find(ctrlSet.begin(), ctrlSet.end(), &sym.get()) != ctrlSet.end())
+      return true;
+  return false;
+}
+
+/// Determine if the subscript expression symbols from an Ev::ArrayRef
+/// intersects with the set of concurrent control symbols, `ctrlSet`.
+template <typename A>
+bool symbolsIntersectSubscripts(llvm::ArrayRef<FrontEndSymbol> ctrlSet,
+                                const A &subscripts) {
+  for (auto &sub : subscripts) {
+    if (const auto *expr =
+            std::get_if<evaluate::IndirectSubscriptIntegerExpr>(&sub.u))
+      if (symbolSetsIntersect(ctrlSet, evaluate::CollectSymbols(expr->value())))
+        return true;
+  }
+  return false;
+}
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_ITERATIONSPACE_H

flang/include/flang/Optimizer/Builder/FIRBuilder.h

public:
   mlir::Value genShape(mlir::Location loc, llvm::ArrayRef<mlir::Value> shift,
                        llvm::ArrayRef<mlir::Value> exts);
   mlir::Value genShape(mlir::Location loc, llvm::ArrayRef<mlir::Value> exts);
 
   /// Create one of the shape ops given an extended value. For a boxed value,
   /// this may create a `fir.shift` op.
   mlir::Value createShape(mlir::Location loc, const fir::ExtendedValue &exv);
 
+  /// Create a slice op extended value. The value to be sliced, `exv`, must be
+  /// an array.
+  mlir::Value createSlice(mlir::Location loc, const fir::ExtendedValue &exv,
+                          mlir::ValueRange triples, mlir::ValueRange path);
+
   /// Create a boxed value (Fortran descriptor) to be passed to the runtime.
   /// \p exv is an extended value holding a memory reference to the object that
   /// must be boxed. This function will crash if provided something that is not
   /// a memory reference type.
   /// Array entities are boxed with a shape and character with their length.
   mlir::Value createBox(mlir::Location loc, const fir::ExtendedValue &exv);
 
   /// Create constant i1 with value 1. if \p b is true or 0. otherwise

 /// describing the entity.
 mlir::Value readCharLen(fir::FirOpBuilder &builder, mlir::Location loc,
                         const fir::ExtendedValue &box);
 
 /// Read or get the extent in dimension \p dim of the array described by \p box.
 mlir::Value readExtent(fir::FirOpBuilder &builder, mlir::Location loc,
                        const fir::ExtendedValue &box, unsigned dim);
 
+/// Read or get the lower bound in dimension \p dim of the array described by
+/// \p box. If the lower bound is left default in the ExtendedValue,
+/// \p defaultValue will be returned.
+mlir::Value readLowerBound(fir::FirOpBuilder &builder, mlir::Location loc,
+                           const fir::ExtendedValue &box, unsigned dim,
+                           mlir::Value defaultValue);
+
 /// Read extents from \p box.
 llvm::SmallVector<mlir::Value> readExtents(fir::FirOpBuilder &builder,
                                            mlir::Location loc,
                                            const fir::BoxValue &box);
 
 /// Get extents from \p box. For fir::BoxValue and
 /// fir::MutableBoxValue, this will generate code to read the extents.
 llvm::SmallVector<mlir::Value> getExtents(fir::FirOpBuilder &builder,

 /// flang/include/flang/Runtime/ragged.h.
 mlir::TupleType getRaggedArrayHeaderType(fir::FirOpBuilder &builder);
 
 /// Create the zero value of a given the numerical or logical \p type (`false`
 /// for logical types).
 mlir::Value createZeroValue(fir::FirOpBuilder &builder, mlir::Location loc,
                             mlir::Type type);
 
+//===--------------------------------------------------------------------===//
+// ExtendedValue helpers
+//===--------------------------------------------------------------------===//
+
+/// Return the extended value for a component of a derived type instance given
+/// the address of the component.
+fir::ExtendedValue componentToExtendedValue(fir::FirOpBuilder &builder,
+                                            mlir::Location loc,
+                                            mlir::Value component);
+
+/// Given the address of an array element and the ExtendedValue describing the
+/// array, returns the ExtendedValue describing the array element. The purpose
+/// is to propagate the length parameters of the array to the element.
+/// This can be used for elements of `array` or `array(i:j:k)`. If \p element
+/// belongs to an array section `array%x` whose base is \p array,
+/// arraySectionElementToExtendedValue must be used instead.
+fir::ExtendedValue arrayElementToExtendedValue(fir::FirOpBuilder &builder,
+                                               mlir::Location loc,
+                                               const fir::ExtendedValue &array,
+                                               mlir::Value element);
+
+/// Build the ExtendedValue for \p element that is an element of an array or
+/// array section with \p array base (`array` or `array(i:j:k)%x%y`).
+/// If it is an array section, \p slice must be provided and be a fir::SliceOp
+/// that describes the section.
+fir::ExtendedValue arraySectionElementToExtendedValue(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice);
+
 } // namespace fir::factory
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H

flang/include/flang/Optimizer/Builder/Factory.h

 } // namespace mlir
 
 namespace fir::factory {
 
 constexpr llvm::StringRef attrFortranArrayOffsets() {
   return "Fortran.offsets";
 }
 
+/// Get extents from fir.shape/fir.shape_shift op. Empty result if
+/// \p shapeVal is empty or is a fir.shift.
+inline std::vector<mlir::Value> getExtents(mlir::Value shapeVal) {
+  if (shapeVal)
+    if (auto *shapeOp = shapeVal.getDefiningOp()) {
+      if (auto shOp = mlir::dyn_cast<fir::ShapeOp>(shapeOp)) {
+        auto operands = shOp.getExtents();
+        return {operands.begin(), operands.end()};
+      }
+      if (auto shOp = mlir::dyn_cast<fir::ShapeShiftOp>(shapeOp))
+        return shOp.getExtents();
+    }
+  return {};
+}
+
 /// Get origins from fir.shape_shift/fir.shift op. Empty result if
 /// \p shapeVal is empty or is a fir.shape.
 inline std::vector<mlir::Value> getOrigins(mlir::Value shapeVal) {
   if (shapeVal)
     if (auto *shapeOp = shapeVal.getDefiningOp()) {
       if (auto shOp = mlir::dyn_cast<fir::ShapeShiftOp>(shapeOp))
         return shOp.getOrigins();
       if (auto shOp = mlir::dyn_cast<fir::ShiftOp>(shapeOp)) {

flang/lib/Lower/Bridge.cpp

 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Bridge.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Lower/CallInterface.h"
 #include "flang/Lower/ConvertExpr.h"
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/ConvertVariable.h"
+#include "flang/Lower/IterationSpace.h"
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
std::visit(
               // Note: No ad-hoc handling for pointers is required here. The
               // target will be assigned as per 2018 10.2.1.3 p2. genExprAddr
               // on a pointer returns the target address and not the address of
               // the pointer variable.
 
               if (assign.lhs.Rank() > 0) {
                 // Array assignment
                 // See Fortran 2018 10.2.1.3 p5, p6, and p7
-                TODO(toLocation(), "Array assignment");
+                genArrayAssignment(assign, stmtCtx);
                 return;
               }
 
               // Scalar assignment
               const bool isNumericScalar =
                   isNumericScalarCategory(lhsType->category());
               fir::ExtendedValue rhs = isNumericScalar
                                            ? genExprValue(assign.rhs, stmtCtx)
private:
   void genFIR(const Fortran::parser::FormTeamStmt &stmt) {
     TODO(toLocation(), "FormTeamStmt lowering");
   }
 
   void genFIR(const Fortran::parser::LockStmt &stmt) {
     TODO(toLocation(), "LockStmt lowering");
   }
 
+  /// Generate an array assignment.
+  /// This is an assignment expression with rank > 0. The assignment may or may
+  /// not be in a WHERE and/or FORALL context.
+  void genArrayAssignment(const Fortran::evaluate::Assignment &assign,
+                          Fortran::lower::StatementContext &stmtCtx) {
+    if (isWholeAllocatable(assign.lhs)) {
+      // Assignment to allocatables may require the lhs to be
+      // deallocated/reallocated. See Fortran 2018 10.2.1.3 p3
+      Fortran::lower::createAllocatableArrayAssignment(
+          *this, assign.lhs, assign.rhs, explicitIterSpace, implicitIterSpace,
+          localSymbols, stmtCtx);
+      return;
+    }
+
+    // No masks and the iteration space is implied by the array, so create a
+    // simple array assignment.
+    Fortran::lower::createSomeArrayAssignment(*this, assign.lhs, assign.rhs,
+                                              localSymbols, stmtCtx);
+  }
+
   void genFIR(const Fortran::parser::WhereConstruct &c) {
     TODO(toLocation(), "WhereConstruct lowering");
   }
 
   void genFIR(const Fortran::parser::WhereBodyConstruct &body) {
     TODO(toLocation(), "WhereBodyConstruct lowering");
   }
 
private:
   Fortran::evaluate::FoldingContext foldingContext;
   fir::FirOpBuilder *builder = nullptr;
   Fortran::lower::pft::Evaluation *evalPtr = nullptr;
   Fortran::lower::SymMap localSymbols;
   Fortran::parser::CharBlock currentPosition;
 
   /// Tuple of host assoicated variables.
   mlir::Value hostAssocTuple;
+  Fortran::lower::ImplicitIterSpace implicitIterSpace;
+  Fortran::lower::ExplicitIterSpace explicitIterSpace;
 };
 
 } // namespace
 
 Fortran::evaluate::FoldingContext
 Fortran::lower::LoweringBridge::createFoldingContext() const {
   return {getDefaultKinds(), getIntrinsicTable()};
 }

flang/lib/Lower/CMakeLists.txt

 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(FortranLower
   Allocatable.cpp
   Bridge.cpp
   CallInterface.cpp
   Coarray.cpp
   ConvertExpr.cpp
   ConvertType.cpp
   ConvertVariable.cpp
   IntrinsicCall.cpp
+  ComponentPath.cpp
+  DumpEvaluateExpr.cpp
+  IterationSpace.cpp
   Mangler.cpp
   OpenACC.cpp
   OpenMP.cpp
   PFTBuilder.cpp
   Runtime.cpp
   SymbolMap.cpp
 
   DEPENDS

flang/lib/Lower/CallInterface.cpp

if (result.attrs.test(Attr::Pointer))
       mlirType = fir::BoxType::get(fir::PointerType::get(mlirType));
 
     addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
                  Property::Value);
   }
 
   fir::SequenceType::Shape getBounds(const Fortran::evaluate::Shape &shape) {
     fir::SequenceType::Shape bounds;
-    for (Fortran::evaluate::MaybeExtentExpr extentExpr : shape) {
-      fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent();
-      if (std::optional<std::int64_t> constantExtent =
-              toInt64(std::move(extentExpr)))
-        extent = *constantExtent;
-      bounds.push_back(extent);
+    for (const std::optional<Fortran::evaluate::ExtentExpr> &extent : shape) {
+      fir::SequenceType::Extent bound = fir::SequenceType::getUnknownExtent();
+      if (std::optional<std::int64_t> i = toInt64(extent))
+        bound = *i;
+      bounds.emplace_back(bound);
     }
     return bounds;
   }
-
-  template <typename A>
-  std::optional<std::int64_t> toInt64(A &&expr) {
+  std::optional<std::int64_t>
+  toInt64(std::optional<
+          Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger>>
+              expr) {
+    if (expr)
       return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
-        getConverter().getFoldingContext(), std::move(expr)));
+          getConverter().getFoldingContext(), toEvExpr(*expr)));
+    return std::nullopt;
   }
 
   /// Return a vector with an attribute with the name of the argument if this
   /// is a callee interface and the name is available. Otherwise, just return
   /// an empty vector.
   llvm::SmallVector<mlir::NamedAttribute>
   dummyNameAttr(const FortranEntity &entity) {
     if constexpr (std::is_same_v<FortranEntity,

flang/lib/Lower/ComponentPath.cpp

+//===-- ComponentPath.cpp -------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/ComponentPath.h"
+
+static std::function<
+    Fortran::lower::IterationSpace(const Fortran::lower::IterationSpace &)>
+getIdentityFunc() {
+  return [](const Fortran::lower::IterationSpace &s) { return s; };
+}
+
+static std::function<
+    Fortran::lower::IterationSpace(const Fortran::lower::IterationSpace &)>
+getNullaryFunc() {
+  return [](const Fortran::lower::IterationSpace &s) {
+    Fortran::lower::IterationSpace newIters(s);
+    newIters.clearIndices();
+    return newIters;
+  };
+}
+
+void Fortran::lower::ComponentPath::clear() {
+  reversePath.clear();
+  substring = nullptr;
+  applied = false;
+  prefixComponents.clear();
+  trips.clear();
+  suffixComponents.clear();
+  pc = getIdentityFunc();
+}
+
+bool Fortran::lower::isRankedArrayAccess(const Fortran::evaluate::ArrayRef &x) {
+  for (const Fortran::evaluate::Subscript &sub : x.subscript()) {
+    if (std::visit(
+            Fortran::common::visitors{
+                [&](const Fortran::evaluate::Triplet &) { return true; },
+                [&](const Fortran::evaluate::IndirectSubscriptIntegerExpr &e) {
+                  return e.value().Rank() > 0;
+                }},
+            sub.u))
+      return true;
+  }
+  return false;
+}
+
+void Fortran::lower::ComponentPath::setPC(bool isImplicit) {
+  pc = isImplicit ? getIdentityFunc() : getNullaryFunc();
+}

flang/lib/Lower/ConvertExpr.cpp

 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/ConvertExpr.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/traverse.h"
 #include "flang/Lower/AbstractConverter.h"
 #include "flang/Lower/CallInterface.h"
+#include "flang/Lower/ComponentPath.h"
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/ConvertVariable.h"
+#include "flang/Lower/DumpEvaluateExpr.h"
 #include "flang/Lower/IntrinsicCall.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/Complex.h"
+#include "flang/Optimizer/Builder/Factory.h"
+#include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include "mlir/Dialect/StandardOps/IR/Ops.h"
 #include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-expr"
 
 //===----------------------------------------------------------------------===//
 // The composition and structure of Fortran::evaluate::Expr is defined in
 // the various header files in include/flang/Evaluate. You are referred
 // there for more information on these data structures. Generally speaking,
 // these data structures are a strongly typed family of abstract data types
 // that, composed as trees, describe the syntax of Fortran expressions.
 //
 // This part of the bridge can traverse these tree structures and lower them
 // to the correct FIR representation in SSA form.
 //===----------------------------------------------------------------------===//
 
+/// The various semantics of a program constituent (or a part thereof) as it may
+/// appear in an expression.
+///
+/// Given the following Fortran declarations.
+/// ```fortran
+///   REAL :: v1, v2, v3
+///   REAL, POINTER :: vp1
+///   REAL :: a1(c), a2(c)
+///   REAL ELEMENTAL FUNCTION f1(arg) ! array -> array
+///   FUNCTION f2(arg)                ! array -> array
+///   vp1 => v3       ! 1
+///   v1 = v2 * vp1   ! 2
+///   a1 = a1 + a2    ! 3
+///   a1 = f1(a2)     ! 4
+///   a1 = f2(a2)     ! 5
+/// ```
+///
+/// In line 1, `vp1` is a BoxAddr to copy a box value into. The box value is
+/// constructed from the DataAddr of `v3`.
+/// In line 2, `v1` is a DataAddr to copy a value into. The value is constructed
+/// from the DataValue of `v2` and `vp1`. DataValue is implicitly a double
+/// dereference in the `vp1` case.
+/// In line 3, `a1` and `a2` on the rhs are RefTransparent. The `a1` on the lhs
+/// is CopyInCopyOut as `a1` is replaced elementally by the additions.
+/// In line 4, `a2` can be RefTransparent, ByValueArg, RefOpaque, or BoxAddr if
+/// `arg` is declared as C-like pass-by-value, VALUE, INTENT(?), or ALLOCATABLE/
+/// POINTER, respectively. `a1` on the lhs is CopyInCopyOut.
+///  In line 5, `a2` may be DataAddr or BoxAddr assuming f2 is transformational.
+///  `a1` on the lhs is again CopyInCopyOut.
+enum class ConstituentSemantics {
+  // Scalar data reference semantics.
+  //
+  // For these let `v` be the location in memory of a variable with value `x`
+  DataValue, // refers to the value `x`
+  DataAddr,  // refers to the address `v`
+  BoxValue,  // refers to a box value containing `v`
+  BoxAddr,   // refers to the address of a box value containing `v`
+
+  // Array data reference semantics.
+  //
+  // For these let `a` be the location in memory of a sequence of value `[xs]`.
+  // Let `x_i` be the `i`-th value in the sequence `[xs]`.
+
+  // Referentially transparent. Refers to the array's value, `[xs]`.
+  RefTransparent,
+  // Refers to an ephemeral address `tmp` containing value `x_i` (15.5.2.3.p7
+  // note 2). (Passing a copy by reference to simulate pass-by-value.)
+  ByValueArg,
+  // Refers to the merge of array value `[xs]` with another array value `[ys]`.
+  // This merged array value will be written into memory location `a`.
+  CopyInCopyOut,
+  // Similar to CopyInCopyOut but `a` may be a transient projection (rather than
+  // a whole array).
+  ProjectedCopyInCopyOut,
+  // Similar to ProjectedCopyInCopyOut, except the merge value is not assigned
+  // automatically by the framework. Instead, and address for `[xs]` is made
+  // accessible so that custom assignments to `[xs]` can be implemented.
+  CustomCopyInCopyOut,
+  // Referentially opaque. Refers to the address of `x_i`.
+  RefOpaque
+};
+
 /// Place \p exv in memory if it is not already a memory reference. If
 /// \p forceValueType is provided, the value is first casted to the provided
 /// type before being stored (this is mainly intended for logicals whose value
 /// may be `i1` but needed to be stored as Fortran logicals).
 static fir::ExtendedValue
 placeScalarValueInMemory(fir::FirOpBuilder &builder, mlir::Location loc,
                          const fir::ExtendedValue &exv,
                          mlir::Type storageType) {

 isElementalProcWithArrayArgs(const Fortran::evaluate::ProcedureRef &procRef) {
   if (procRef.IsElemental())
     for (const std::optional<Fortran::evaluate::ActualArgument> &arg :
          procRef.arguments())
       if (arg && arg->Rank() != 0)
         return true;
   return false;
 }
+template <typename T>
+static bool isElementalProcWithArrayArgs(const Fortran::evaluate::Expr<T> &) {
+  return false;
+}
+template <>
+bool isElementalProcWithArrayArgs(const Fortran::lower::SomeExpr &x) {
+  if (const auto *procRef = std::get_if<Fortran::evaluate::ProcedureRef>(&x.u))
+    return isElementalProcWithArrayArgs(*procRef);
+  return false;
+}
 
 /// If \p arg is the address of a function with a denoted host-association tuple
 /// argument, then return the host-associations tuple value of the current
 /// procedure. Otherwise, return nullptr.
 static mlir::Value
 argumentHostAssocs(Fortran::lower::AbstractConverter &converter,
                    mlir::Value arg) {
   if (auto addr = mlir::dyn_cast_or_null<fir::AddrOfOp>(arg.getDefiningOp())) {
public:
   ExtValue
   genMutableBoxValueImpl(const Fortran::evaluate::Designator<T> &designator) {
     return std::visit(
         Fortran::common::visitors{
             [&](const Fortran::evaluate::SymbolRef &sym) -> ExtValue {
               return symMap.lookupSymbol(*sym).toExtendedValue();
             },
             [&](const Fortran::evaluate::Component &comp) -> ExtValue {
-              TODO(getLoc(), "genMutableBoxValueImpl Component");
+              return genComponent(comp);
             },
             [&](const auto &) -> ExtValue {
               fir::emitFatalError(getLoc(),
                                   "not an allocatable or pointer designator");
             }},
         designator.u);
   }
 
#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
   ExtValue gen(const Fortran::evaluate::Substring &s) {
     TODO(getLoc(), "gen Substring");
   }
   ExtValue genval(const Fortran::evaluate::Substring &ss) {
     TODO(getLoc(), "genval Substring");
   }
 
   ExtValue genval(const Fortran::evaluate::Subscript &subs) {
-    TODO(getLoc(), "genval Subscript");
+    if (auto *s = std::get_if<Fortran::evaluate::IndirectSubscriptIntegerExpr>(
+            &subs.u)) {
+      if (s->value().Rank() > 0)
+        fir::emitFatalError(getLoc(), "vector subscript is not scalar");
+      return {genval(s->value())};
+    }
+    fir::emitFatalError(getLoc(), "subscript triple notation is not scalar");
+  }
+
+  ExtValue genSubscript(const Fortran::evaluate::Subscript &subs) {
+    return genval(subs);
   }
 
   ExtValue gen(const Fortran::evaluate::DataRef &dref) {
     TODO(getLoc(), "gen DataRef");
   }
   ExtValue genval(const Fortran::evaluate::DataRef &dref) {
     TODO(getLoc(), "genval DataRef");
   }
 
+  // Helper function to turn the Component structure into a list of nested
+  // components, ordered from largest/leftmost to smallest/rightmost:
+  //  - where only the smallest/rightmost item may be allocatable or a pointer
+  //    (nested allocatable/pointer components require nested coordinate_of ops)
+  //  - that does not contain any parent components
+  //    (the front end places parent components directly in the object)
+  // Return the object used as the base coordinate for the component chain.
+  static Fortran::evaluate::DataRef const *
+  reverseComponents(const Fortran::evaluate::Component &cmpt,
+                    std::list<const Fortran::evaluate::Component *> &list) {
+    if (!cmpt.GetLastSymbol().test(
+            Fortran::semantics::Symbol::Flag::ParentComp))
+      list.push_front(&cmpt);
+    return std::visit(
+        Fortran::common::visitors{
+            [&](const Fortran::evaluate::Component &x) {
+              if (Fortran::semantics::IsAllocatableOrPointer(x.GetLastSymbol()))
+                return &cmpt.base();
+              return reverseComponents(x, list);
+            },
+            [&](auto &) { return &cmpt.base(); },
+        },
+        cmpt.base().u);
+  }
+
+  // Return the coordinate of the component reference
+  ExtValue genComponent(const Fortran::evaluate::Component &cmpt) {
+    std::list<const Fortran::evaluate::Component *> list;
+    const Fortran::evaluate::DataRef *base = reverseComponents(cmpt, list);
+    llvm::SmallVector<mlir::Value> coorArgs;
+    ExtValue obj = gen(*base);
+    mlir::Type ty = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(obj).getType());
+    mlir::Location loc = getLoc();
+    auto fldTy = fir::FieldType::get(&converter.getMLIRContext());
+    // FIXME: need to thread the LEN type parameters here.
+    for (const Fortran::evaluate::Component *field : list) {
+      auto recTy = ty.cast<fir::RecordType>();
+      const Fortran::semantics::Symbol &sym = field->GetLastSymbol();
+      llvm::StringRef name = toStringRef(sym.name());
+      coorArgs.push_back(builder.create<fir::FieldIndexOp>(
+          loc, fldTy, name, recTy, fir::getTypeParams(obj)));
+      ty = recTy.getType(name);
+    }
+    ty = builder.getRefType(ty);
+    return fir::factory::componentToExtendedValue(
+        builder, loc,
+        builder.create<fir::CoordinateOp>(loc, ty, fir::getBase(obj),
+                                          coorArgs));
+  }
+
   ExtValue gen(const Fortran::evaluate::Component &cmpt) {
     TODO(getLoc(), "gen Component");
   }
   ExtValue genval(const Fortran::evaluate::Component &cmpt) {
     TODO(getLoc(), "genval Component");
   }
 
   ExtValue genval(const Fortran::semantics::Bound &bound) {
     TODO(getLoc(), "genval Bound");
   }
 
+  /// Return lower bounds of \p box in dimension \p dim. The returned value
+  /// has type \ty.
+  mlir::Value getLBound(const ExtValue &box, unsigned dim, mlir::Type ty) {
+    assert(box.rank() > 0 && "must be an array");
+    mlir::Location loc = getLoc();
+    mlir::Value one = builder.createIntegerConstant(loc, ty, 1);
+    mlir::Value lb = fir::factory::readLowerBound(builder, loc, box, dim, one);
+    return builder.createConvert(loc, ty, lb);
+  }
+
+  /// Lower an ArrayRef to a fir.coordinate_of given its lowered base.
+  ExtValue genCoordinateOp(const ExtValue &array,
+                           const Fortran::evaluate::ArrayRef &aref) {
+    mlir::Location loc = getLoc();
+    // References to array of rank > 1 with non constant shape that are not
+    // fir.box must be collapsed into an offset computation in lowering already.
+    // The same is needed with dynamic length character arrays of all ranks.
+    mlir::Type baseType =
+        fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(array).getType());
+    if ((array.rank() > 1 && fir::hasDynamicSize(baseType)) ||
+        fir::characterWithDynamicLen(fir::unwrapSequenceType(baseType)))
+      if (!array.getBoxOf<fir::BoxValue>())
+        TODO(getLoc(), "genOffsetAndCoordinateOp");
+    // Generate a fir.coordinate_of with zero based array indexes.
+    llvm::SmallVector<mlir::Value> args;
+    for (const auto &subsc : llvm::enumerate(aref.subscript())) {
+      ExtValue subVal = genSubscript(subsc.value());
+      assert(fir::isUnboxedValue(subVal) && "subscript must be simple scalar");
+      mlir::Value val = fir::getBase(subVal);
+      mlir::Type ty = val.getType();
+      mlir::Value lb = getLBound(array, subsc.index(), ty);
+      args.push_back(builder.create<mlir::arith::SubIOp>(loc, ty, val, lb));
+    }
+
+    mlir::Value base = fir::getBase(array);
+    auto seqTy =
+        fir::dyn_cast_ptrOrBoxEleTy(base.getType()).cast<fir::SequenceType>();
+    assert(args.size() == seqTy.getDimension());
+    mlir::Type ty = builder.getRefType(seqTy.getEleTy());
+    auto addr = builder.create<fir::CoordinateOp>(loc, ty, base, args);
+    return fir::factory::arrayElementToExtendedValue(builder, loc, array, addr);
+  }
+
   ExtValue gen(const Fortran::evaluate::ArrayRef &aref) {
-    TODO(getLoc(), "gen ArrayRef");
+    ExtValue base = aref.base().IsSymbol() ? gen(aref.base().GetFirstSymbol())
+                                           : gen(aref.base().GetComponent());
+    return genCoordinateOp(base, aref);
   }
   ExtValue genval(const Fortran::evaluate::ArrayRef &aref) {
     TODO(getLoc(), "genval ArrayRef");
   }
 
   ExtValue gen(const Fortran::evaluate::CoarrayRef &coref) {
     TODO(getLoc(), "gen CoarrayRef");
   }
private:
   Fortran::lower::AbstractConverter &converter;
   fir::FirOpBuilder &builder;
   Fortran::lower::StatementContext &stmtCtx;
   Fortran::lower::SymMap &symMap;
   bool useBoxArg = false; // expression lowered as argument
 };
 } // namespace
 
+// Helper for changing the semantics in a given context. Preserves the current
+// semantics which is resumed when the "push" goes out of scope.
+#define PushSemantics(PushVal)                                                 \
+  [[maybe_unused]] auto pushSemanticsLocalVariable##__LINE__ =                 \
+      Fortran::common::ScopedSet(semant, PushVal);
+
+static bool isAdjustedArrayElementType(mlir::Type t) {
+  return fir::isa_char(t) || fir::isa_derived(t) || t.isa<fir::SequenceType>();
+}
+
+/// Build an ExtendedValue from a fir.array<?x...?xT> without actually setting
+/// the actual extents and lengths. This is only to allow their propagation as
+/// ExtendedValue without triggering verifier failures when propagating
+/// character/arrays as unboxed values. Only the base of the resulting
+/// ExtendedValue should be used, it is undefined to use the length or extents
+/// of the extended value returned,
+inline static fir::ExtendedValue
+convertToArrayBoxValue(mlir::Location loc, fir::FirOpBuilder &builder,
+                       mlir::Value val, mlir::Value len) {
+  mlir::Type ty = fir::unwrapRefType(val.getType());
+  mlir::IndexType idxTy = builder.getIndexType();
+  auto seqTy = ty.cast<fir::SequenceType>();
+  auto undef = builder.create<fir::UndefOp>(loc, idxTy);
+  llvm::SmallVector<mlir::Value> extents(seqTy.getDimension(), undef);
+  if (fir::isa_char(seqTy.getEleTy()))
+    return fir::CharArrayBoxValue(val, len ? len : undef, extents);
+  return fir::ArrayBoxValue(val, extents);
+}
+
+//===----------------------------------------------------------------------===//
+//
+// Lowering of array expressions.
+//
+//===----------------------------------------------------------------------===//
+
+namespace {
+class ArrayExprLowering {
+  using ExtValue = fir::ExtendedValue;
+
+  /// Structure to keep track of lowered array operands in the
+  /// array expression. Useful to later deduce the shape of the
+  /// array expression.
+  struct ArrayOperand {
+    /// Array base (can be a fir.box).
+    mlir::Value memref;
+    /// ShapeOp, ShapeShiftOp or ShiftOp
+    mlir::Value shape;
+    /// SliceOp
+    mlir::Value slice;
+    /// Can this operand be absent ?
+    bool mayBeAbsent = false;
+  };
+
+  using ImplicitSubscripts = Fortran::lower::details::ImplicitSubscripts;
+  using PathComponent = Fortran::lower::PathComponent;
+
+  /// Active iteration space.
+  using IterationSpace = Fortran::lower::IterationSpace;
+  using IterSpace = const Fortran::lower::IterationSpace &;
+
+  /// Current continuation. Function that will generate IR for a single
+  /// iteration of the pending iterative loop structure.
+  using CC = Fortran::lower::GenerateElementalArrayFunc;
+
+  /// Projection continuation. Function that will project one iteration space
+  /// into another.
+  using PC = std::function<IterationSpace(IterSpace)>;
+  using ArrayBaseTy =
+      std::variant<std::monostate, const Fortran::evaluate::ArrayRef *,
+                   const Fortran::evaluate::DataRef *>;
+  using ComponentPath = Fortran::lower::ComponentPath;
+
+public:
+  //===--------------------------------------------------------------------===//
+  // Regular array assignment
+  //===--------------------------------------------------------------------===//
+
+  /// Entry point for array assignments. Both the left-hand and right-hand sides
+  /// can either be ExtendedValue or evaluate::Expr.
+  template <typename TL, typename TR>
+  static void lowerArrayAssignment(Fortran::lower::AbstractConverter &converter,
+                                   Fortran::lower::SymMap &symMap,
+                                   Fortran::lower::StatementContext &stmtCtx,
+                                   const TL &lhs, const TR &rhs) {
+    ArrayExprLowering ael{converter, stmtCtx, symMap,
+                          ConstituentSemantics::CopyInCopyOut};
+    ael.lowerArrayAssignment(lhs, rhs);
+  }
+
+  template <typename TL, typename TR>
+  void lowerArrayAssignment(const TL &lhs, const TR &rhs) {
+    mlir::Location loc = getLoc();
+    /// Here the target subspace is not necessarily contiguous. The ArrayUpdate
+    /// continuation is implicitly returned in `ccStoreToDest` and the ArrayLoad
+    /// in `destination`.
+    PushSemantics(ConstituentSemantics::ProjectedCopyInCopyOut);
+    ccStoreToDest = genarr(lhs);
+    determineShapeOfDest(lhs);
+    semant = ConstituentSemantics::RefTransparent;
+    ExtValue exv = lowerArrayExpression(rhs);
+    if (explicitSpaceIsActive()) {
+      explicitSpace->finalizeContext();
+      builder.create<fir::ResultOp>(loc, fir::getBase(exv));
+    } else {
+      builder.create<fir::ArrayMergeStoreOp>(
+          loc, destination, fir::getBase(exv), destination.getMemref(),
+          destination.getSlice(), destination.getTypeparams());
+    }
+  }
+
+  //===--------------------------------------------------------------------===//
+  // Array assignment to allocatable array
+  //===--------------------------------------------------------------------===//
+
+  /// Entry point for assignment to allocatable array.
+  static void lowerAllocatableArrayAssignment(
+      Fortran::lower::AbstractConverter &converter,
+      Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
+      const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs,
+      Fortran::lower::ExplicitIterSpace &explicitSpace,
+      Fortran::lower::ImplicitIterSpace &implicitSpace) {
+    ArrayExprLowering ael(converter, stmtCtx, symMap,
+                          ConstituentSemantics::CopyInCopyOut, &explicitSpace,
+                          &implicitSpace);
+    ael.lowerAllocatableArrayAssignment(lhs, rhs);
+  }
+
+  /// Assignment to allocatable array.
+  ///
+  /// The semantics are reverse that of a "regular" array assignment. The rhs
+  /// defines the iteration space of the computation and the lhs is
+  /// resized/reallocated to fit if necessary.
+  void lowerAllocatableArrayAssignment(const Fortran::lower::SomeExpr &lhs,
+                                       const Fortran::lower::SomeExpr &rhs) {
+    // With assignment to allocatable, we want to lower the rhs first and use
+    // its shape to determine if we need to reallocate, etc.
+    mlir::Location loc = getLoc();
+    // FIXME: If the lhs is in an explicit iteration space, the assignment may
+    // be to an array of allocatable arrays rather than a single allocatable
+    // array.
+    fir::MutableBoxValue mutableBox =
+        createMutableBox(loc, converter, lhs, symMap);
+    mlir::Type resultTy = converter.genType(rhs);
+    if (rhs.Rank() > 0)
+      determineShapeOfDest(rhs);
+    auto rhsCC = [&]() {
+      PushSemantics(ConstituentSemantics::RefTransparent);
+      return genarr(rhs);
+    }();
+
+    llvm::SmallVector<mlir::Value> lengthParams;
+    // Currently no safe way to gather length from rhs (at least for
+    // character, it cannot be taken from array_loads since it may be
+    // changed by concatenations).
+    if ((mutableBox.isCharacter() && !mutableBox.hasNonDeferredLenParams()) ||
+        mutableBox.isDerivedWithLengthParameters())
+      TODO(loc, "gather rhs length parameters in assignment to allocatable");
+
+    // The allocatable must take lower bounds from the expr if it is
+    // reallocated and the right hand side is not a scalar.
+    const bool takeLboundsIfRealloc = rhs.Rank() > 0;
+    llvm::SmallVector<mlir::Value> lbounds;
+    // When the reallocated LHS takes its lower bounds from the RHS,
+    // they will be non default only if the RHS is a whole array
+    // variable. Otherwise, lbounds is left empty and default lower bounds
+    // will be used.
+    if (takeLboundsIfRealloc &&
+        Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(rhs)) {
+      assert(arrayOperands.size() == 1 &&
+             "lbounds can only come from one array");
+      std::vector<mlir::Value> lbs =
+          fir::factory::getOrigins(arrayOperands[0].shape);
+      lbounds.append(lbs.begin(), lbs.end());
+    }
+    fir::factory::MutableBoxReallocation realloc =
+        fir::factory::genReallocIfNeeded(builder, loc, mutableBox, destShape,
+                                         lengthParams);
+    // Create ArrayLoad for the mutable box and save it into `destination`.
+    PushSemantics(ConstituentSemantics::ProjectedCopyInCopyOut);
+    ccStoreToDest = genarr(realloc.newValue);
+    // If the rhs is scalar, get shape from the allocatable ArrayLoad.
+    if (destShape.empty())
+      destShape = getShape(destination);
+    // Finish lowering the loop nest.
+    assert(destination && "destination must have been set");
+    ExtValue exv = lowerArrayExpression(rhsCC, resultTy);
+    if (explicitSpaceIsActive()) {
+      explicitSpace->finalizeContext();
+      builder.create<fir::ResultOp>(loc, fir::getBase(exv));
+    } else {
+      builder.create<fir::ArrayMergeStoreOp>(
+          loc, destination, fir::getBase(exv), destination.getMemref(),
+          destination.getSlice(), destination.getTypeparams());
+    }
+    fir::factory::finalizeRealloc(builder, loc, mutableBox, lbounds,
+                                  takeLboundsIfRealloc, realloc);
+  }
+
+  /// Entry point into lowering an expression with rank. This entry point is for
+  /// lowering a rhs expression, for example. (RefTransparent semantics.)
+  static ExtValue
+  lowerNewArrayExpression(Fortran::lower::AbstractConverter &converter,
+                          Fortran::lower::SymMap &symMap,
+                          Fortran::lower::StatementContext &stmtCtx,
+                          const Fortran::lower::SomeExpr &expr) {
+    ArrayExprLowering ael{converter, stmtCtx, symMap};
+    ael.determineShapeOfDest(expr);
+    ExtValue loopRes = ael.lowerArrayExpression(expr);
+    fir::ArrayLoadOp dest = ael.destination;
+    mlir::Value tempRes = dest.getMemref();
+    fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+    mlir::Location loc = converter.getCurrentLocation();
+    builder.create<fir::ArrayMergeStoreOp>(loc, dest, fir::getBase(loopRes),
+                                           tempRes, dest.getSlice(),
+                                           dest.getTypeparams());
+
+    auto arrTy =
+        fir::dyn_cast_ptrEleTy(tempRes.getType()).cast<fir::SequenceType>();
+    if (auto charTy =
+            arrTy.getEleTy().template dyn_cast<fir::CharacterType>()) {
+      if (fir::characterWithDynamicLen(charTy))
+        TODO(loc, "CHARACTER does not have constant LEN");
+      mlir::Value len = builder.createIntegerConstant(
+          loc, builder.getCharacterLengthType(), charTy.getLen());
+      return fir::CharArrayBoxValue(tempRes, len, dest.getExtents());
+    }
+    return fir::ArrayBoxValue(tempRes, dest.getExtents());
+  }
+
+  // FIXME: should take multiple inner arguments.
+  std::pair<IterationSpace, mlir::OpBuilder::InsertPoint>
+  genImplicitLoops(mlir::ValueRange shape, mlir::Value innerArg) {
+    mlir::Location loc = getLoc();
+    mlir::IndexType idxTy = builder.getIndexType();
+    mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+    mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
+    llvm::SmallVector<mlir::Value> loopUppers;
+
+    // Convert any implied shape to closed interval form. The fir.do_loop will
+    // run from 0 to `extent - 1` inclusive.
+    for (auto extent : shape)
+      loopUppers.push_back(
+          builder.create<mlir::arith::SubIOp>(loc, extent, one));
+
+    // Iteration space is created with outermost columns, innermost rows
+    llvm::SmallVector<fir::DoLoopOp> loops;
+
+    const std::size_t loopDepth = loopUppers.size();
+    llvm::SmallVector<mlir::Value> ivars;
+
+    for (auto i : llvm::enumerate(llvm::reverse(loopUppers))) {
+      if (i.index() > 0) {
+        assert(!loops.empty());
+        builder.setInsertionPointToStart(loops.back().getBody());
+      }
+      fir::DoLoopOp loop;
+      if (innerArg) {
+        loop = builder.create<fir::DoLoopOp>(
+            loc, zero, i.value(), one, isUnordered(),
+            /*finalCount=*/false, mlir::ValueRange{innerArg});
+        innerArg = loop.getRegionIterArgs().front();
+        if (explicitSpaceIsActive())
+          explicitSpace->setInnerArg(0, innerArg);
+      } else {
+        loop = builder.create<fir::DoLoopOp>(loc, zero, i.value(), one,
+                                             isUnordered(),
+                                             /*finalCount=*/false);
+      }
+      ivars.push_back(loop.getInductionVar());
+      loops.push_back(loop);
+    }
+
+    if (innerArg)
+      for (std::remove_const_t<decltype(loopDepth)> i = 0; i + 1 < loopDepth;
+           ++i) {
+        builder.setInsertionPointToEnd(loops[i].getBody());
+        builder.create<fir::ResultOp>(loc, loops[i + 1].getResult(0));
+      }
+
+    // Move insertion point to the start of the innermost loop in the nest.
+    builder.setInsertionPointToStart(loops.back().getBody());
+    // Set `afterLoopNest` to just after the entire loop nest.
+    auto currPt = builder.saveInsertionPoint();
+    builder.setInsertionPointAfter(loops[0]);
+    auto afterLoopNest = builder.saveInsertionPoint();
+    builder.restoreInsertionPoint(currPt);
+
+    // Put the implicit loop variables in row to column order to match FIR's
+    // Ops. (The loops were constructed from outermost column to innermost
+    // row.)
+    mlir::Value outerRes = loops[0].getResult(0);
+    return {IterationSpace(innerArg, outerRes, llvm::reverse(ivars)),
+            afterLoopNest};
+  }
+
+  /// Build the iteration space into which the array expression will be
+  /// lowered. The resultType is used to create a temporary, if needed.
+  std::pair<IterationSpace, mlir::OpBuilder::InsertPoint>
+  genIterSpace(mlir::Type resultType) {
+    mlir::Location loc = getLoc();
+    llvm::SmallVector<mlir::Value> shape = genIterationShape();
+    if (!destination) {
+      // Allocate storage for the result if it is not already provided.
+      destination = createAndLoadSomeArrayTemp(resultType, shape);
+    }
+
+    // Generate the lazy mask allocation, if one was given.
+    if (ccPrelude.hasValue())
+      ccPrelude.getValue()(shape);
+
+    // Now handle the implicit loops.
+    mlir::Value inner = explicitSpaceIsActive()
+                            ? explicitSpace->getInnerArgs().front()
+                            : destination.getResult();
+    auto [iters, afterLoopNest] = genImplicitLoops(shape, inner);
+    mlir::Value innerArg = iters.innerArgument();
+
+    // Generate the mask conditional structure, if there are masks. Unlike the
+    // explicit masks, which are interleaved, these mask expression appear in
+    // the innermost loop.
+    if (implicitSpaceHasMasks()) {
+      // Recover the cached condition from the mask buffer.
+      auto genCond = [&](Fortran::lower::FrontEndExpr e, IterSpace iters) {
+        return implicitSpace->getBoundClosure(e)(iters);
+      };
+
+      // Handle the negated conditions in topological order of the WHERE
+      // clauses. See 10.2.3.2p4 as to why this control structure is produced.
+      for (llvm::SmallVector<Fortran::lower::FrontEndExpr> maskExprs :
+           implicitSpace->getMasks()) {
+        const std::size_t size = maskExprs.size() - 1;
+        auto genFalseBlock = [&](const auto *e, auto &&cond) {
+          auto ifOp = builder.create<fir::IfOp>(
+              loc, mlir::TypeRange{innerArg.getType()}, fir::getBase(cond),
+              /*withElseRegion=*/true);
+          builder.create<fir::ResultOp>(loc, ifOp.getResult(0));
+          builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+          builder.create<fir::ResultOp>(loc, innerArg);
+          builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
+        };
+        auto genTrueBlock = [&](const auto *e, auto &&cond) {
+          auto ifOp = builder.create<fir::IfOp>(
+              loc, mlir::TypeRange{innerArg.getType()}, fir::getBase(cond),
+              /*withElseRegion=*/true);
+          builder.create<fir::ResultOp>(loc, ifOp.getResult(0));
+          builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
+          builder.create<fir::ResultOp>(loc, innerArg);
+          builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+        };
+        for (std::remove_const_t<decltype(size)> i = 0; i < size; ++i)
+          if (const auto *e = maskExprs[i])
+            genFalseBlock(e, genCond(e, iters));
+
+        // The last condition is either non-negated or unconditionally negated.
+        if (const auto *e = maskExprs[size])
+          genTrueBlock(e, genCond(e, iters));
+      }
+    }
+
+    // We're ready to lower the body (an assignment statement) for this context
+    // of loop nests at this point.
+    return {iters, afterLoopNest};
+  }
+
+  fir::ArrayLoadOp
+  createAndLoadSomeArrayTemp(mlir::Type type,
+                             llvm::ArrayRef<mlir::Value> shape) {
+    if (ccLoadDest.hasValue())
+      return ccLoadDest.getValue()(shape);
+    auto seqTy = type.dyn_cast<fir::SequenceType>();
+    assert(seqTy && "must be an array");
+    mlir::Location loc = getLoc();
+    // TODO: Need to thread the length parameters here. For character, they may
+    // differ from the operands length (e.g concatenation). So the array loads
+    // type parameters are not enough.
+    if (auto charTy = seqTy.getEleTy().dyn_cast<fir::CharacterType>())
+      if (charTy.hasDynamicLen())
+        TODO(loc, "character array expression temp with dynamic length");
+    if (auto recTy = seqTy.getEleTy().dyn_cast<fir::RecordType>())
+      if (recTy.getNumLenParams() > 0)
+        TODO(loc, "derived type array expression temp with length parameters");
+    mlir::Value temp = seqTy.hasConstantShape()
+                           ? builder.create<fir::AllocMemOp>(loc, type)
+                           : builder.create<fir::AllocMemOp>(
+                                 loc, type, ".array.expr", llvm::None, shape);
+    fir::FirOpBuilder *bldr = &converter.getFirOpBuilder();
+    stmtCtx.attachCleanup(
+        [bldr, loc, temp]() { bldr->create<fir::FreeMemOp>(loc, temp); });
+    mlir::Value shapeOp = genShapeOp(shape);
+    return builder.create<fir::ArrayLoadOp>(loc, seqTy, temp, shapeOp,
+                                            /*slice=*/mlir::Value{},
+                                            llvm::None);
+  }
+
+  static fir::ShapeOp genShapeOp(mlir::Location loc, fir::FirOpBuilder &builder,
+                                 llvm::ArrayRef<mlir::Value> shape) {
+    mlir::IndexType idxTy = builder.getIndexType();
+    llvm::SmallVector<mlir::Value> idxShape;
+    for (auto s : shape)
+      idxShape.push_back(builder.createConvert(loc, idxTy, s));
+    auto shapeTy = fir::ShapeType::get(builder.getContext(), idxShape.size());
+    return builder.create<fir::ShapeOp>(loc, shapeTy, idxShape);
+  }
+
+  fir::ShapeOp genShapeOp(llvm::ArrayRef<mlir::Value> shape) {
+    return genShapeOp(getLoc(), builder, shape);
+  }
+
+  //===--------------------------------------------------------------------===//
+  // Expression traversal and lowering.
+  //===--------------------------------------------------------------------===//
+
+  /// Lower the expression, \p x, in a scalar context.
+  template <typename A>
+  ExtValue asScalar(const A &x) {
+    return ScalarExprLowering{getLoc(), converter, symMap, stmtCtx}.genval(x);
+  }
+
+  /// Lower the expression in a scalar context to a memory reference.
+  template <typename A>
+  ExtValue asScalarRef(const A &x) {
+    return ScalarExprLowering{getLoc(), converter, symMap, stmtCtx}.gen(x);
+  }
+
+  // An expression with non-zero rank is an array expression.
+  template <typename A>
+  bool isArray(const A &x) const {
+    return x.Rank() != 0;
+  }
+
+  /// If there were temporaries created for this element evaluation, finalize
+  /// and deallocate the resources now. This should be done just prior the the
+  /// fir::ResultOp at the end of the innermost loop.
+  void finalizeElementCtx() {
+    if (elementCtx) {
+      stmtCtx.finalize(/*popScope=*/true);
+      elementCtx = false;
+    }
+  }
+
+  template <typename A>
+  CC genScalarAndForwardValue(const A &x) {
+    ExtValue result = asScalar(x);
+    return [=](IterSpace) { return result; };
+  }
+
+  template <typename A, typename = std::enable_if_t<Fortran::common::HasMember<
+                            A, Fortran::evaluate::TypelessExpression>>>
+  CC genarr(const A &x) {
+    return genScalarAndForwardValue(x);
+  }
+
+  template <typename A>
+  CC genarr(const Fortran::evaluate::Expr<A> &x) {
+    LLVM_DEBUG(Fortran::lower::DumpEvaluateExpr::dump(llvm::dbgs(), x));
+    if (isArray(x) || explicitSpaceIsActive() ||
+        isElementalProcWithArrayArgs(x))
+      return std::visit([&](const auto &e) { return genarr(e); }, x.u);
+    return genScalarAndForwardValue(x);
+  }
+
+  template <Fortran::common::TypeCategory TC1, int KIND,
+            Fortran::common::TypeCategory TC2>
+  CC genarr(const Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>,
+                                             TC2> &x) {
+    TODO(getLoc(), "");
+  }
+
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::ComplexComponent<KIND> &x) {
+    TODO(getLoc(), "");
+  }
+
+  template <typename T>
+  CC genarr(const Fortran::evaluate::Parentheses<T> &x) {
+    TODO(getLoc(), "");
+  }
+
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
+                Fortran::common::TypeCategory::Integer, KIND>> &x) {
+    TODO(getLoc(), "");
+  }
+
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
+                Fortran::common::TypeCategory::Real, KIND>> &x) {
+    TODO(getLoc(), "");
+  }
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
+                Fortran::common::TypeCategory::Complex, KIND>> &x) {
+    TODO(getLoc(), "");
+  }
+
+#undef GENBIN
+#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
+  template <int KIND>                                                          \
+  CC genarr(const Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type<       \
+                Fortran::common::TypeCategory::GenBinTyCat, KIND>> &x) {       \
+    TODO(getLoc(), "genarr Binary");                                           \
+  }
+
+  GENBIN(Add, Integer, mlir::arith::AddIOp)
+  GENBIN(Add, Real, mlir::arith::AddFOp)
+  GENBIN(Add, Complex, fir::AddcOp)
+  GENBIN(Subtract, Integer, mlir::arith::SubIOp)
+  GENBIN(Subtract, Real, mlir::arith::SubFOp)
+  GENBIN(Subtract, Complex, fir::SubcOp)
+  GENBIN(Multiply, Integer, mlir::arith::MulIOp)
+  GENBIN(Multiply, Real, mlir::arith::MulFOp)
+  GENBIN(Multiply, Complex, fir::MulcOp)
+  GENBIN(Divide, Integer, mlir::arith::DivSIOp)
+  GENBIN(Divide, Real, mlir::arith::DivFOp)
+  GENBIN(Divide, Complex, fir::DivcOp)
+
+  template <Fortran::common::TypeCategory TC, int KIND>
+  CC genarr(
+      const Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>> &x) {
+    TODO(getLoc(), "genarr ");
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  CC genarr(
+      const Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>> &x) {
+    TODO(getLoc(), "genarr ");
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  CC genarr(
+      const Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>
+          &x) {
+    TODO(getLoc(), "genarr ");
+  }
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::ComplexConstructor<KIND> &x) {
+    TODO(getLoc(), "genarr ");
+  }
+
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::Concat<KIND> &x) {
+    TODO(getLoc(), "genarr ");
+  }
+
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::SetLength<KIND> &x) {
+    TODO(getLoc(), "genarr ");
+  }
+
+  template <typename A>
+  CC genarr(const Fortran::evaluate::Constant<A> &x) {
+    TODO(getLoc(), "genarr ");
+  }
+
+  CC genarr(const Fortran::semantics::SymbolRef &sym,
+            ComponentPath &components) {
+    return genarr(sym.get(), components);
+  }
+
+  ExtValue abstractArrayExtValue(mlir::Value val, mlir::Value len = {}) {
+    return convertToArrayBoxValue(getLoc(), builder, val, len);
+  }
+
+  CC genarr(const ExtValue &extMemref) {
+    ComponentPath dummy(/*isImplicit=*/true);
+    return genarr(extMemref, dummy);
+  }
+
+  template <typename A>
+  CC genarr(const Fortran::evaluate::ArrayConstructor<A> &x) {
+    TODO(getLoc(), "genarr ArrayConstructor<A>");
+  }
+
+  CC genarr(const Fortran::evaluate::ImpliedDoIndex &) {
+    TODO(getLoc(), "genarr ImpliedDoIndex");
+  }
+
+  CC genarr(const Fortran::evaluate::TypeParamInquiry &x) {
+    TODO(getLoc(), "genarr TypeParamInquiry");
+  }
+
+  CC genarr(const Fortran::evaluate::DescriptorInquiry &x) {
+    TODO(getLoc(), "genarr DescriptorInquiry");
+  }
+
+  CC genarr(const Fortran::evaluate::StructureConstructor &x) {
+    TODO(getLoc(), "genarr StructureConstructor");
+  }
+
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::Not<KIND> &x) {
+    TODO(getLoc(), "genarr Not");
+  }
+
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::LogicalOperation<KIND> &x) {
+    TODO(getLoc(), "genarr LogicalOperation");
+  }
+
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
+                Fortran::common::TypeCategory::Integer, KIND>> &x) {
+    TODO(getLoc(), "genarr Relational Integer");
+  }
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
+                Fortran::common::TypeCategory::Character, KIND>> &x) {
+    TODO(getLoc(), "genarr Relational Character");
+  }
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
+                Fortran::common::TypeCategory::Real, KIND>> &x) {
+    TODO(getLoc(), "genarr Relational Real");
+  }
+  template <int KIND>
+  CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
+                Fortran::common::TypeCategory::Complex, KIND>> &x) {
+    TODO(getLoc(), "genarr Relational Complex");
+  }
+  CC genarr(
+      const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &r) {
+    TODO(getLoc(), "genarr Relational SomeType");
+  }
+
+  template <typename A>
+  CC genarr(const Fortran::evaluate::Designator<A> &des) {
+    ComponentPath components(des.Rank() > 0);
+    return std::visit([&](const auto &x) { return genarr(x, components); },
+                      des.u);
+  }
+
+  template <typename T>
+  CC genarr(const Fortran::evaluate::FunctionRef<T> &funRef) {
+    TODO(getLoc(), "genarr FunctionRef");
+  }
+
+  template <typename A>
+  CC genImplicitArrayAccess(const A &x, ComponentPath &components) {
+    components.reversePath.push_back(ImplicitSubscripts{});
+    ExtValue exv = asScalarRef(x);
+    // lowerPath(exv, components);
+    auto lambda = genarr(exv, components);
+    return [=](IterSpace iters) { return lambda(components.pc(iters)); };
+  }
+  CC genImplicitArrayAccess(const Fortran::evaluate::NamedEntity &x,
+                            ComponentPath &components) {
+    if (x.IsSymbol())
+      return genImplicitArrayAccess(x.GetFirstSymbol(), components);
+    return genImplicitArrayAccess(x.GetComponent(), components);
+  }
+
+  template <typename A>
+  CC genAsScalar(const A &x) {
+    mlir::Location loc = getLoc();
+    if (isProjectedCopyInCopyOut()) {
+      return [=, &x, builder = &converter.getFirOpBuilder()](
+                 IterSpace iters) -> ExtValue {
+        ExtValue exv = asScalarRef(x);
+        mlir::Value val = fir::getBase(exv);
+        mlir::Type eleTy = fir::unwrapRefType(val.getType());
+        if (isAdjustedArrayElementType(eleTy)) {
+          if (fir::isa_char(eleTy)) {
+            TODO(getLoc(), "assignment of character type");
+          } else if (fir::isa_derived(eleTy)) {
+            TODO(loc, "assignment of derived type");
+          } else {
+            fir::emitFatalError(loc, "array type not expected in scalar");
+          }
+        } else {
+          builder->create<fir::StoreOp>(loc, iters.getElement(), val);
+        }
+        return exv;
+      };
+    }
+    return [=, &x](IterSpace) { return asScalar(x); };
+  }
+
+  CC genarr(const Fortran::semantics::Symbol &x, ComponentPath &components) {
+    if (explicitSpaceIsActive()) {
+      TODO(getLoc(), "genarr Symbol explicitSpace");
+    } else {
+      return genImplicitArrayAccess(x, components);
+    }
+  }
+
+  CC genarr(const Fortran::evaluate::Component &x, ComponentPath &components) {
+    TODO(getLoc(), "genarr Component");
+  }
+
+  CC genarr(const Fortran::evaluate::ArrayRef &x, ComponentPath &components) {
+    TODO(getLoc(), "genar  ArrayRef");
+  }
+
+  CC genarr(const Fortran::evaluate::CoarrayRef &x, ComponentPath &components) {
+    TODO(getLoc(), "coarray reference");
+  }
+
+  CC genarr(const Fortran::evaluate::NamedEntity &x,
+            ComponentPath &components) {
+    return x.IsSymbol() ? genarr(x.GetFirstSymbol(), components)
+                        : genarr(x.GetComponent(), components);
+  }
+
+  CC genarr(const Fortran::evaluate::DataRef &x, ComponentPath &components) {
+    return std::visit([&](const auto &v) { return genarr(v, components); },
+                      x.u);
+  }
+
+  CC genarr(const Fortran::evaluate::ComplexPart &x,
+            ComponentPath &components) {
+    TODO(getLoc(), "genarr ComplexPart");
+  }
+
+  CC genarr(const Fortran::evaluate::StaticDataObject::Pointer &,
+            ComponentPath &components) {
+    TODO(getLoc(), "genarr StaticDataObject::Pointer");
+  }
+
+  /// Substrings (see 9.4.1)
+  CC genarr(const Fortran::evaluate::Substring &x, ComponentPath &components) {
+    TODO(getLoc(), "genarr Substring");
+  }
+
+  /// Base case of generating an array reference,
+  CC genarr(const ExtValue &extMemref, ComponentPath &components) {
+    mlir::Location loc = getLoc();
+    mlir::Value memref = fir::getBase(extMemref);
+    mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(memref.getType());
+    assert(arrTy.isa<fir::SequenceType>() && "memory ref must be an array");
+    mlir::Value shape = builder.createShape(loc, extMemref);
+    mlir::Value slice;
+    if (components.isSlice()) {
+      TODO(loc, "genarr with Slices");
+    }
+    arrayOperands.push_back(ArrayOperand{memref, shape, slice});
+    if (destShape.empty())
+      destShape = getShape(arrayOperands.back());
+    if (isBoxValue()) {
+      TODO(loc, "genarr BoxValue");
+    }
+    if (isReferentiallyOpaque()) {
+      TODO(loc, "genarr isReferentiallyOpaque");
+    }
+    auto arrLoad = builder.create<fir::ArrayLoadOp>(
+        loc, arrTy, memref, shape, slice, fir::getTypeParams(extMemref));
+    mlir::Value arrLd = arrLoad.getResult();
+    if (isProjectedCopyInCopyOut()) {
+      // Semantics are projected copy-in copy-out.
+      // The backing store of the destination of an array expression may be
+      // partially modified. These updates are recorded in FIR by forwarding a
+      // continuation that generates an `array_update` Op. The destination is
+      // always loaded at the beginning of the statement and merged at the
+      // end.
+      destination = arrLoad;
+      auto lambda = ccStoreToDest.hasValue()
+                        ? ccStoreToDest.getValue()
+                        : defaultStoreToDestination(components.substring);
+      return [=](IterSpace iters) -> ExtValue { return lambda(iters); };
+    }
+    if (isCustomCopyInCopyOut()) {
+      TODO(loc, "isCustomCopyInCopyOut");
+    }
+    if (isCopyInCopyOut()) {
+      // Semantics are copy-in copy-out.
+      // The continuation simply forwards the result of the `array_load` Op,
+      // which is the value of the array as it was when loaded. All data
+      // references with rank > 0 in an array expression typically have
+      // copy-in copy-out semantics.
+      return [=](IterSpace) -> ExtValue { return arrLd; };
+    }
+    mlir::Operation::operand_range arrLdTypeParams = arrLoad.getTypeparams();
+    if (isValueAttribute()) {
+      // Semantics are value attribute.
+      // Here the continuation will `array_fetch` a value from an array and
+      // then store that value in a temporary. One can thus imitate pass by
+      // value even when the call is pass by reference.
+      return [=](IterSpace iters) -> ExtValue {
+        mlir::Value base;
+        mlir::Type eleTy = fir::applyPathToType(arrTy, iters.iterVec());
+        if (isAdjustedArrayElementType(eleTy)) {
+          mlir::Type eleRefTy = builder.getRefType(eleTy);
+          base = builder.create<fir::ArrayAccessOp>(
+              loc, eleRefTy, arrLd, iters.iterVec(), arrLdTypeParams);
+        } else {
+          base = builder.create<fir::ArrayFetchOp>(
+              loc, eleTy, arrLd, iters.iterVec(), arrLdTypeParams);
+        }
+        mlir::Value temp = builder.createTemporary(
+            loc, base.getType(),
+            llvm::ArrayRef<mlir::NamedAttribute>{
+                Fortran::lower::getAdaptToByRefAttr(builder)});
+        builder.create<fir::StoreOp>(loc, base, temp);
+        return fir::factory::arraySectionElementToExtendedValue(
+            builder, loc, extMemref, temp, slice);
+      };
+    }
+    // In the default case, the array reference forwards an `array_fetch` or
+    // `array_access` Op in the continuation.
+    return [=](IterSpace iters) -> ExtValue {
+      mlir::Type eleTy = fir::applyPathToType(arrTy, iters.iterVec());
+      if (isAdjustedArrayElementType(eleTy)) {
+        mlir::Type eleRefTy = builder.getRefType(eleTy);
+        mlir::Value arrayOp = builder.create<fir::ArrayAccessOp>(
+            loc, eleRefTy, arrLd, iters.iterVec(), arrLdTypeParams);
+        if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
+          llvm::SmallVector<mlir::Value> substringBounds;
+          populateBounds(substringBounds, components.substring);
+          if (!substringBounds.empty()) {
+            // mlir::Value dstLen = fir::factory::genLenOfCharacter(
+            //     builder, loc, arrLoad, iters.iterVec(), substringBounds);
+            // fir::CharBoxValue dstChar(arrayOp, dstLen);
+            // return fir::factory::CharacterExprHelper{builder, loc}
+            //     .createSubstring(dstChar, substringBounds);
+          }
+        }
+        return fir::factory::arraySectionElementToExtendedValue(
+            builder, loc, extMemref, arrayOp, slice);
+      }
+      auto arrFetch = builder.create<fir::ArrayFetchOp>(
+          loc, eleTy, arrLd, iters.iterVec(), arrLdTypeParams);
+      return fir::factory::arraySectionElementToExtendedValue(
+          builder, loc, extMemref, arrFetch, slice);
+    };
+  }
+
+  /// Reduce the rank of a array to be boxed based on the slice's operands.
+  static mlir::Type reduceRank(mlir::Type arrTy, mlir::Value slice) {
+    if (slice) {
+      auto slOp = mlir::dyn_cast<fir::SliceOp>(slice.getDefiningOp());
+      assert(slOp && "expected slice op");
+      auto seqTy = arrTy.dyn_cast<fir::SequenceType>();
+      assert(seqTy && "expected array type");
+      mlir::Operation::operand_range triples = slOp.getTriples();
+      fir::SequenceType::Shape shape;
+      // reduce the rank for each invariant dimension
+      for (unsigned i = 1, end = triples.size(); i < end; i += 3)
+        if (!mlir::isa_and_nonnull<fir::UndefOp>(triples[i].getDefiningOp()))
+          shape.push_back(fir::SequenceType::getUnknownExtent());
+      return fir::SequenceType::get(shape, seqTy.getEleTy());
+    }
+    // not sliced, so no change in rank
+    return arrTy;
+  }
+
+private:
+  void determineShapeOfDest(const fir::ExtendedValue &lhs) {
+    destShape = fir::factory::getExtents(builder, getLoc(), lhs);
+  }
+
+  void determineShapeOfDest(const Fortran::lower::SomeExpr &lhs) {
+    if (!destShape.empty())
+      return;
+    // if (explicitSpaceIsActive() && determineShapeWithSlice(lhs))
+    //   return;
+    mlir::Type idxTy = builder.getIndexType();
+    mlir::Location loc = getLoc();
+    if (std::optional<Fortran::evaluate::ConstantSubscripts> constantShape =
+            Fortran::evaluate::GetConstantExtents(converter.getFoldingContext(),
+                                                  lhs))
+      for (Fortran::common::ConstantSubscript extent : *constantShape)
+        destShape.push_back(builder.createIntegerConstant(loc, idxTy, extent));
+  }
+
+  ExtValue lowerArrayExpression(const Fortran::lower::SomeExpr &exp) {
+    mlir::Type resTy = converter.genType(exp);
+    return std::visit(
+        [&](const auto &e) { return lowerArrayExpression(genarr(e), resTy); },
+        exp.u);
+  }
+  ExtValue lowerArrayExpression(const ExtValue &exv) {
+    assert(!explicitSpace);
+    mlir::Type resTy = fir::unwrapPassByRefType(fir::getBase(exv).getType());
+    return lowerArrayExpression(genarr(exv), resTy);
+  }
+
+  void populateBounds(llvm::SmallVectorImpl<mlir::Value> &bounds,
+                      const Fortran::evaluate::Substring *substring) {
+    if (!substring)
+      return;
+    bounds.push_back(fir::getBase(asScalar(substring->lower())));
+    if (auto upper = substring->upper())
+      bounds.push_back(fir::getBase(asScalar(*upper)));
+  }
+
+  /// Default store to destination implementation.
+  /// This implements the default case, which is to assign the value in
+  /// `iters.element` into the destination array, `iters.innerArgument`. Handles
+  /// by value and by reference assignment.
+  CC defaultStoreToDestination(const Fortran::evaluate::Substring *substring) {
+    return [=](IterSpace iterSpace) -> ExtValue {
+      mlir::Location loc = getLoc();
+      mlir::Value innerArg = iterSpace.innerArgument();
+      fir::ExtendedValue exv = iterSpace.elementExv();
+      mlir::Type arrTy = innerArg.getType();
+      mlir::Type eleTy = fir::applyPathToType(arrTy, iterSpace.iterVec());
+      if (isAdjustedArrayElementType(eleTy)) {
+        TODO(loc, "isAdjustedArrayElementType");
+      }
+      // By value semantics. The element is being assigned by value.
+      mlir::Value ele = builder.createConvert(loc, eleTy, fir::getBase(exv));
+      auto update = builder.create<fir::ArrayUpdateOp>(
+          loc, arrTy, innerArg, ele, iterSpace.iterVec(),
+          destination.getTypeparams());
+      return abstractArrayExtValue(update);
+    };
+  }
+
+  /// For an elemental array expression.
+  ///   1. Lower the scalars and array loads.
+  ///   2. Create the iteration space.
+  ///   3. Create the element-by-element computation in the loop.
+  ///   4. Return the resulting array value.
+  /// If no destination was set in the array context, a temporary of
+  /// \p resultTy will be created to hold the evaluated expression.
+  /// Otherwise, \p resultTy is ignored and the expression is evaluated
+  /// in the destination. \p f is a continuation built from an
+  /// evaluate::Expr or an ExtendedValue.
+  ExtValue lowerArrayExpression(CC f, mlir::Type resultTy) {
+    mlir::Location loc = getLoc();
+    auto [iterSpace, insPt] = genIterSpace(resultTy);
+    auto exv = f(iterSpace);
+    iterSpace.setElement(std::move(exv));
+    auto lambda = ccStoreToDest.hasValue()
+                      ? ccStoreToDest.getValue()
+                      : defaultStoreToDestination(/*substring=*/nullptr);
+    mlir::Value updVal = fir::getBase(lambda(iterSpace));
+    finalizeElementCtx();
+    builder.create<fir::ResultOp>(loc, updVal);
+    builder.restoreInsertionPoint(insPt);
+    return abstractArrayExtValue(iterSpace.outerResult());
+  }
+
+  /// Get the shape from an ArrayOperand. The shape of the array is adjusted if
+  /// the array was sliced.
+  llvm::SmallVector<mlir::Value> getShape(ArrayOperand array) {
+    // if (array.slice)
+    //   return computeSliceShape(array.slice);
+    if (array.memref.getType().isa<fir::BoxType>())
+      return fir::factory::readExtents(builder, getLoc(),
+                                       fir::BoxValue{array.memref});
+    std::vector<mlir::Value, std::allocator<mlir::Value>> extents =
+        fir::factory::getExtents(array.shape);
+    return {extents.begin(), extents.end()};
+  }
+
+  /// Get the shape from an ArrayLoad.
+  llvm::SmallVector<mlir::Value> getShape(fir::ArrayLoadOp arrayLoad) {
+    return getShape(ArrayOperand{arrayLoad.getMemref(), arrayLoad.getShape(),
+                                 arrayLoad.getSlice()});
+  }
+
+  /// Returns the first array operand that may not be absent. If all
+  /// array operands may be absent, return the first one.
+  const ArrayOperand &getInducingShapeArrayOperand() const {
+    assert(!arrayOperands.empty());
+    for (const ArrayOperand &op : arrayOperands)
+      if (!op.mayBeAbsent)
+        return op;
+    // If all arrays operand appears in optional position, then none of them
+    // is allowed to be absent as per 15.5.2.12 point 3. (6). Just pick the
+    // first operands.
+    // TODO: There is an opportunity to add a runtime check here that
+    // this array is present as required.
+    return arrayOperands[0];
+  }
+
+  /// Generate the shape of the iteration space over the array expression. The
+  /// iteration space may be implicit, explicit, or both. If it is implied it is
+  /// based on the destination and operand array loads, or an optional
+  /// Fortran::evaluate::Shape from the front end. If the shape is explicit,
+  /// this returns any implicit shape component, if it exists.
+  llvm::SmallVector<mlir::Value> genIterationShape() {
+    // Use the precomputed destination shape.
+    if (!destShape.empty())
+      return destShape;
+    // Otherwise, use the destination's shape.
+    if (destination)
+      return getShape(destination);
+    // Otherwise, use the first ArrayLoad operand shape.
+    if (!arrayOperands.empty())
+      return getShape(getInducingShapeArrayOperand());
+    fir::emitFatalError(getLoc(),
+                        "failed to compute the array expression shape");
+  }
+
+  bool explicitSpaceIsActive() const {
+    return explicitSpace && explicitSpace->isActive();
+  }
+
+  bool implicitSpaceHasMasks() const {
+    return implicitSpace && !implicitSpace->empty();
+  }
+
+  explicit ArrayExprLowering(Fortran::lower::AbstractConverter &converter,
+                             Fortran::lower::StatementContext &stmtCtx,
+                             Fortran::lower::SymMap &symMap)
+      : converter{converter}, builder{converter.getFirOpBuilder()},
+        stmtCtx{stmtCtx}, symMap{symMap} {}
+
+  explicit ArrayExprLowering(Fortran::lower::AbstractConverter &converter,
+                             Fortran::lower::StatementContext &stmtCtx,
+                             Fortran::lower::SymMap &symMap,
+                             ConstituentSemantics sem)
+      : converter{converter}, builder{converter.getFirOpBuilder()},
+        stmtCtx{stmtCtx}, symMap{symMap}, semant{sem} {}
+
+  explicit ArrayExprLowering(Fortran::lower::AbstractConverter &converter,
+                             Fortran::lower::StatementContext &stmtCtx,
+                             Fortran::lower::SymMap &symMap,
+                             ConstituentSemantics sem,
+                             Fortran::lower::ExplicitIterSpace *expSpace,
+                             Fortran::lower::ImplicitIterSpace *impSpace)
+      : converter{converter}, builder{converter.getFirOpBuilder()},
+        stmtCtx{stmtCtx}, symMap{symMap},
+        explicitSpace(expSpace->isActive() ? expSpace : nullptr),
+        implicitSpace(impSpace->empty() ? nullptr : impSpace), semant{sem} {
+    // Generate any mask expressions, as necessary. This is the compute step
+    // that creates the effective masks. See 10.2.3.2 in particular.
+    // genMasks();
+  }
+
+  mlir::Location getLoc() { return converter.getCurrentLocation(); }
+
+  /// Array appears in a lhs context such that it is assigned after the rhs is
+  /// fully evaluated.
+  inline bool isCopyInCopyOut() {
+    return semant == ConstituentSemantics::CopyInCopyOut;
+  }
+
+  /// Array appears in a lhs (or temp) context such that a projected,
+  /// discontiguous subspace of the array is assigned after the rhs is fully
+  /// evaluated. That is, the rhs array value is merged into a section of the
+  /// lhs array.
+  inline bool isProjectedCopyInCopyOut() {
+    return semant == ConstituentSemantics::ProjectedCopyInCopyOut;
+  }
+
+  inline bool isCustomCopyInCopyOut() {
+    return semant == ConstituentSemantics::CustomCopyInCopyOut;
+  }
+
+  /// Array appears in a context where it must be boxed.
+  inline bool isBoxValue() { return semant == ConstituentSemantics::BoxValue; }
+
+  /// Array appears in a context where differences in the memory reference can
+  /// be observable in the computational results. For example, an array
+  /// element is passed to an impure procedure.
+  inline bool isReferentiallyOpaque() {
+    return semant == ConstituentSemantics::RefOpaque;
+  }
+
+  /// Array appears in a context where it is passed as a VALUE argument.
+  inline bool isValueAttribute() {
+    return semant == ConstituentSemantics::ByValueArg;
+  }
+
+  /// Can the loops over the expression be unordered?
+  inline bool isUnordered() const { return unordered; }
+
+  void setUnordered(bool b) { unordered = b; }
+
+  Fortran::lower::AbstractConverter &converter;
+  fir::FirOpBuilder &builder;
+  Fortran::lower::StatementContext &stmtCtx;
+  bool elementCtx = false;
+  Fortran::lower::SymMap &symMap;
+  /// The continuation to generate code to update the destination.
+  llvm::Optional<CC> ccStoreToDest;
+  llvm::Optional<std::function<void(llvm::ArrayRef<mlir::Value>)>> ccPrelude;
+  llvm::Optional<std::function<fir::ArrayLoadOp(llvm::ArrayRef<mlir::Value>)>>
+      ccLoadDest;
+  /// The destination is the loaded array into which the results will be
+  /// merged.
+  fir::ArrayLoadOp destination;
+  /// The shape of the destination.
+  llvm::SmallVector<mlir::Value> destShape;
+  /// List of arrays in the expression that have been loaded.
+  llvm::SmallVector<ArrayOperand> arrayOperands;
+  /// If there is a user-defined iteration space, explicitShape will hold the
+  /// information from the front end.
+  Fortran::lower::ExplicitIterSpace *explicitSpace = nullptr;
+  Fortran::lower::ImplicitIterSpace *implicitSpace = nullptr;
+  ConstituentSemantics semant = ConstituentSemantics::RefTransparent;
+  // Can the array expression be evaluated in any order?
+  // Will be set to false if any of the expression parts prevent this.
+  bool unordered = true;
+};
+} // namespace
+
 fir::ExtendedValue Fortran::lower::createSomeExtendedExpression(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
     Fortran::lower::StatementContext &stmtCtx) {
   LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "expr: ") << '\n');
   return ScalarExprLowering{loc, converter, symMap, stmtCtx}.genval(expr);
 }
 
mlir::Value Fortran::lower::createSubroutineCall(
     SymMap &symMap, StatementContext &stmtCtx) {
   mlir::Location loc = converter.getCurrentLocation();
 
   // Simple subroutine call, with potential alternate return.
   auto res = Fortran::lower::createSomeExtendedExpression(
       loc, converter, toEvExpr(call), symMap, stmtCtx);
   return fir::getBase(res);
 }
+
+void Fortran::lower::createSomeArrayAssignment(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs,
+    Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+  LLVM_DEBUG(lhs.AsFortran(llvm::dbgs() << "onto array: ") << '\n';
+             rhs.AsFortran(llvm::dbgs() << "assign expression: ") << '\n';);
+  ArrayExprLowering::lowerArrayAssignment(converter, symMap, stmtCtx, lhs, rhs);
+}
+
+void Fortran::lower::createSomeArrayAssignment(
+    Fortran::lower::AbstractConverter &converter, const fir::ExtendedValue &lhs,
+    const fir::ExtendedValue &rhs, Fortran::lower::SymMap &symMap,
+    Fortran::lower::StatementContext &stmtCtx) {
+  LLVM_DEBUG(llvm::dbgs() << "onto array: " << lhs << '\n';
+             llvm::dbgs() << "assign expression: " << rhs << '\n';);
+  ArrayExprLowering::lowerArrayAssignment(converter, symMap, stmtCtx, lhs, rhs);
+}
+
+void Fortran::lower::createAllocatableArrayAssignment(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs,
+    Fortran::lower::ExplicitIterSpace &explicitSpace,
+    Fortran::lower::ImplicitIterSpace &implicitSpace,
+    Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+  LLVM_DEBUG(lhs.AsFortran(llvm::dbgs() << "defining array: ") << '\n';
+             rhs.AsFortran(llvm::dbgs() << "assign expression: ")
+             << " given the explicit iteration space:\n"
+             << explicitSpace << "\n and implied mask conditions:\n"
+             << implicitSpace << '\n';);
+  ArrayExprLowering::lowerAllocatableArrayAssignment(
+      converter, symMap, stmtCtx, lhs, rhs, explicitSpace, implicitSpace);
+}

flang/lib/Lower/ConvertVariable.cpp

ba.match(
       // need to be cast to a multi-dimensional array with constant bounds
       // (possibly with a missing column), bounds computed in the callee
       // (here), or with bounds from the caller (boxed somewhere else). Locals
       // have the same properties except they are never boxed arguments from
       // the caller and never having a missing column size.
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::ScalarStaticChar &x) {
-        TODO(loc, "mapSymbolAttributes ScalarStaticChar");
+        TODO(loc, "ScalarStaticChar variable lowering");
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::ScalarDynamicChar &x) {
-        TODO(loc, "mapSymbolAttributes ScalarDynamicChar");
+        TODO(loc, "ScalarDynamicChar variable lowering");
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::StaticArray &x) {
         // object shape is constant, not a character
         mlir::Type castTy = builder.getRefType(converter.genType(var));
         mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
ba.match(
                     : createNewLocal(converter, loc, var, preAlloc, extents);
         assert(isDummy || Fortran::lower::isExplicitShape(sym));
         symMap.addSymbolWithBounds(sym, local, extents, lbounds, isDummy);
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::DynamicArray &x) {
-        TODO(loc, "mapSymbolAttributes DynamicArray");
+        TODO(loc, "DynamicArray variable lowering");
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::StaticArrayStaticChar &x) {
-        TODO(loc, "mapSymbolAttributes StaticArrayStaticChar");
+        TODO(loc, "StaticArrayStaticChar variable lowering");
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::StaticArrayDynamicChar &x) {
-        TODO(loc, "mapSymbolAttributes StaticArrayDynamicChar");
+        TODO(loc, "StaticArrayDynamicChar variable lowering");
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::DynamicArrayStaticChar &x) {
-        TODO(loc, "mapSymbolAttributes DynamicArrayStaticChar");
+        TODO(loc, "DynamicArrayStaticChar variable lowering");
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) {
-        TODO(loc, "mapSymbolAttributes DynamicArrayDynamicChar");
+        TODO(loc, "DynamicArrayDynamicChar variable lowering");
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::BoxAnalyzer::None &) {
         mlir::emitError(loc, "symbol analysis failed on ")
             << toStringRef(sym.name());
       });

flang/lib/Lower/DumpEvaluateExpr.cpp

+//===-- Lower/DumpEvaluateExpr.cpp ----------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/DumpEvaluateExpr.h"
+#include <iostream>
+
+static constexpr char whiteSpacePadding[] =
+    ">>                                               ";
+static constexpr auto whiteSize = sizeof(whiteSpacePadding) - 1;
+
+inline const char *Fortran::lower::DumpEvaluateExpr::getIndentString() const {
+  auto count = (level * 2 >= whiteSize) ? whiteSize : level * 2;
+  return whiteSpacePadding + whiteSize - count;
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::CoarrayRef &x) {
+  indent("coarray ref");
+  show(x.base());
+  show(x.subscript());
+  show(x.cosubscript());
+  show(x.stat());
+  show(x.team());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::BOZLiteralConstant &) {
+  print("BOZ literal constant");
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::NullPointer &) {
+  print("null pointer");
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::semantics::Symbol &symbol) {
+  const auto &ultimate{symbol.GetUltimate()};
+  print("symbol: "s + std::string(toStringRef(symbol.name())));
+  if (const auto *assoc =
+          ultimate.detailsIf<Fortran::semantics::AssocEntityDetails>()) {
+    indent("assoc details");
+    show(assoc->expr());
+    outdent();
+  }
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::StaticDataObject &) {
+  print("static data object");
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::ImpliedDoIndex &) {
+  print("implied do index");
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::BaseObject &x) {
+  indent("base object");
+  show(x.u);
+  outdent();
+}
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::Component &x) {
+  indent("component");
+  show(x.base());
+  show(x.GetLastSymbol());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::NamedEntity &x) {
+  indent("named entity");
+  if (const auto *component = x.UnwrapComponent())
+    show(*component);
+  else
+    show(x.GetFirstSymbol());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::TypeParamInquiry &x) {
+  indent("type inquiry");
+  show(x.base());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::Triplet &x) {
+  indent("triplet");
+  show(x.lower());
+  show(x.upper());
+  show(x.stride());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::Subscript &x) {
+  indent("subscript");
+  show(x.u);
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::ArrayRef &x) {
+  indent("array ref");
+  show(x.base());
+  show(x.subscript());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::DataRef &x) {
+  indent("data ref");
+  show(x.u);
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::Substring &x) {
+  indent("substring");
+  show(x.parent());
+  show(x.lower());
+  show(x.upper());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::semantics::ParamValue &x) {
+  indent("param value");
+  show(x.GetExplicit());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::semantics::DerivedTypeSpec::ParameterMapType::value_type
+        &x) {
+  show(x.second);
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::semantics::DerivedTypeSpec &x) {
+  indent("derived type spec");
+  for (auto &v : x.parameters())
+    show(v);
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::StructureConstructorValues::value_type &x) {
+  show(x.second);
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::StructureConstructor &x) {
+  indent("structure constructor");
+  show(x.derivedTypeSpec());
+  for (auto &v : x)
+    show(v);
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &x) {
+  indent("expr some type");
+  show(x.u);
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::ComplexPart &x) {
+  indent("complex part");
+  show(x.complex());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::ActualArgument &x) {
+  indent("actual argument");
+  if (const auto *symbol = x.GetAssumedTypeDummy())
+    show(*symbol);
+  else
+    show(x.UnwrapExpr());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::ProcedureDesignator &x) {
+  indent("procedure designator");
+  if (const auto *component = x.GetComponent())
+    show(*component);
+  else if (const auto *symbol = x.GetSymbol())
+    show(*symbol);
+  else
+    show(DEREF(x.GetSpecificIntrinsic()));
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::SpecificIntrinsic &) {
+  print("specific intrinsic");
+}
+
+void Fortran::lower::DumpEvaluateExpr::show(
+    const Fortran::evaluate::DescriptorInquiry &x) {
+  indent("descriptor inquiry");
+  show(x.base());
+  outdent();
+}
+
+void Fortran::lower::DumpEvaluateExpr::print(llvm::Twine twine) {
+  outs << getIndentString() << twine << '\n';
+}
+
+void Fortran::lower::DumpEvaluateExpr::indent(llvm::StringRef s) {
+  print(s + " {");
+  level++;
+}
+
+void Fortran::lower::DumpEvaluateExpr::outdent() {
+  if (level)
+    level--;
+  print("}");
+}
+
+//===----------------------------------------------------------------------===//
+// Boilerplate entry points that the debugger can find.
+//===----------------------------------------------------------------------===//
+
+void Fortran::lower::dumpEvExpr(const Fortran::semantics::SomeExpr &x) {
+  DumpEvaluateExpr::dump(x);
+}
+
+void Fortran::lower::dumpEvExpr(
+    const Fortran::evaluate::Expr<
+        Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 4>>
+        &x) {
+  DumpEvaluateExpr::dump(x);
+}
+
+void Fortran::lower::dumpEvExpr(
+    const Fortran::evaluate::Expr<
+        Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 8>>
+        &x) {
+  DumpEvaluateExpr::dump(x);
+}
+
+void Fortran::lower::dumpEvExpr(const Fortran::evaluate::ArrayRef &x) {
+  DumpEvaluateExpr::dump(x);
+}
+
+void Fortran::lower::dumpEvExpr(const Fortran::evaluate::DataRef &x) {
+  DumpEvaluateExpr::dump(x);
+}
+
+void Fortran::lower::dumpEvExpr(const Fortran::evaluate::Substring &x) {
+  DumpEvaluateExpr::dump(x);
+}
+
+void Fortran::lower::dumpEvExpr(
+    const Fortran::evaluate::Designator<
+        Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 4>>
+        &x) {
+  DumpEvaluateExpr::dump(x);
+}

flang/lib/Lower/IterationSpace.cpp

+//===-- IterationSpace.cpp ------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/IterationSpace.h"
+#include "flang/Evaluate/expression.h"
+#include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/Support/Utils.h"
+#include "llvm/Support/Debug.h"
+
+#define DEBUG_TYPE "flang-lower-iteration-space"
+
+namespace {
+// Fortran::evaluate::Expr are functional values organized like an AST. A
+// Fortran::evaluate::Expr is meant to be moved and cloned. Using the front end
+// tools can often cause copies and extra wrapper classes to be added to any
+// Fortran::evalute::Expr. These values should not be assumed or relied upon to
+// have an *object* identity. They are deeply recursive, irregular structures
+// built from a large number of classes which do not use inheritance and
+// necessitate a large volume of boilerplate code as a result.
+//
+// Contrastingly, LLVM data structures make ubiquitous assumptions about an
+// object's identity via pointers to the object. An object's location in memory
+// is thus very often an identifying relation.
+
+// This class defines a hash computation of a Fortran::evaluate::Expr tree value
+// so it can be used with llvm::DenseMap. The Fortran::evaluate::Expr need not
+// have the same address.
+class HashEvaluateExpr {
+public:
+  // A Se::Symbol is the only part of an Fortran::evaluate::Expr with an
+  // identity property.
+  static unsigned getHashValue(const Fortran::semantics::Symbol &x) {
+    return static_cast<unsigned>(reinterpret_cast<std::intptr_t>(&x));
+  }
+  template <typename A, bool COPY>
+  static unsigned getHashValue(const Fortran::common::Indirection<A, COPY> &x) {
+    return getHashValue(x.value());
+  }
+  template <typename A>
+  static unsigned getHashValue(const std::optional<A> &x) {
+    if (x.has_value())
+      return getHashValue(x.value());
+    return 0u;
+  }
+  static unsigned getHashValue(const Fortran::evaluate::Subscript &x) {
+    return std::visit([&](const auto &v) { return getHashValue(v); }, x.u);
+  }
+  static unsigned getHashValue(const Fortran::evaluate::Triplet &x) {
+    return getHashValue(x.lower()) - getHashValue(x.upper()) * 5u -
+           getHashValue(x.stride()) * 11u;
+  }
+  static unsigned getHashValue(const Fortran::evaluate::Component &x) {
+    return getHashValue(x.base()) * 83u - getHashValue(x.GetLastSymbol());
+  }
+  static unsigned getHashValue(const Fortran::evaluate::ArrayRef &x) {
+    unsigned subs = 1u;
+    for (const Fortran::evaluate::Subscript &v : x.subscript())
+      subs -= getHashValue(v);
+    return getHashValue(x.base()) * 89u - subs;
+  }
+  static unsigned getHashValue(const Fortran::evaluate::CoarrayRef &x) {
+    unsigned subs = 1u;
+    for (const Fortran::evaluate::Subscript &v : x.subscript())
+      subs -= getHashValue(v);
+    unsigned cosubs = 3u;
+    for (const Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger> &v :
+         x.cosubscript())
+      cosubs -= getHashValue(v);
+    unsigned syms = 7u;
+    for (const Fortran::evaluate::SymbolRef &v : x.base())
+      syms += getHashValue(v);
+    return syms * 97u - subs - cosubs + getHashValue(x.stat()) + 257u +
+           getHashValue(x.team());
+  }
+  static unsigned getHashValue(const Fortran::evaluate::NamedEntity &x) {
+    if (x.IsSymbol())
+      return getHashValue(x.GetFirstSymbol()) * 11u;
+    return getHashValue(x.GetComponent()) * 13u;
+  }
+  static unsigned getHashValue(const Fortran::evaluate::DataRef &x) {
+    return std::visit([&](const auto &v) { return getHashValue(v); }, x.u);
+  }
+  static unsigned getHashValue(const Fortran::evaluate::ComplexPart &x) {
+    return getHashValue(x.complex()) - static_cast<unsigned>(x.part());
+  }
+  template <Fortran::common::TypeCategory TC1, int KIND,
+            Fortran::common::TypeCategory TC2>
+  static unsigned getHashValue(
+      const Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>
+          &x) {
+    return getHashValue(x.left()) - (static_cast<unsigned>(TC1) + 2u) -
+           (static_cast<unsigned>(KIND) + 5u);
+  }
+  template <int KIND>
+  static unsigned
+  getHashValue(const Fortran::evaluate::ComplexComponent<KIND> &x) {
+    return getHashValue(x.left()) -
+           (static_cast<unsigned>(x.isImaginaryPart) + 1u) * 3u;
+  }
+  template <typename T>
+  static unsigned getHashValue(const Fortran::evaluate::Parentheses<T> &x) {
+    return getHashValue(x.left()) * 17u;
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  static unsigned getHashValue(
+      const Fortran::evaluate::Negate<Fortran::evaluate::Type<TC, KIND>> &x) {
+    return getHashValue(x.left()) - (static_cast<unsigned>(TC) + 5u) -
+           (static_cast<unsigned>(KIND) + 7u);
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  static unsigned getHashValue(
+      const Fortran::evaluate::Add<Fortran::evaluate::Type<TC, KIND>> &x) {
+    return (getHashValue(x.left()) + getHashValue(x.right())) * 23u +
+           static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  static unsigned getHashValue(
+      const Fortran::evaluate::Subtract<Fortran::evaluate::Type<TC, KIND>> &x) {
+    return (getHashValue(x.left()) - getHashValue(x.right())) * 19u +
+           static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  static unsigned getHashValue(
+      const Fortran::evaluate::Multiply<Fortran::evaluate::Type<TC, KIND>> &x) {
+    return (getHashValue(x.left()) + getHashValue(x.right())) * 29u +
+           static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  static unsigned getHashValue(
+      const Fortran::evaluate::Divide<Fortran::evaluate::Type<TC, KIND>> &x) {
+    return (getHashValue(x.left()) - getHashValue(x.right())) * 31u +
+           static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  static unsigned getHashValue(
+      const Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>> &x) {
+    return (getHashValue(x.left()) - getHashValue(x.right())) * 37u +
+           static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  static unsigned getHashValue(
+      const Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>> &x) {
+    return (getHashValue(x.left()) + getHashValue(x.right())) * 41u +
+           static_cast<unsigned>(TC) + static_cast<unsigned>(KIND) +
+           static_cast<unsigned>(x.ordering) * 7u;
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  static unsigned getHashValue(
+      const Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>
+          &x) {
+    return (getHashValue(x.left()) - getHashValue(x.right())) * 43u +
+           static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+  }
+  template <int KIND>
+  static unsigned
+  getHashValue(const Fortran::evaluate::ComplexConstructor<KIND> &x) {
+    return (getHashValue(x.left()) - getHashValue(x.right())) * 47u +
+           static_cast<unsigned>(KIND);
+  }
+  template <int KIND>
+  static unsigned getHashValue(const Fortran::evaluate::Concat<KIND> &x) {
+    return (getHashValue(x.left()) - getHashValue(x.right())) * 53u +
+           static_cast<unsigned>(KIND);
+  }
+  template <int KIND>
+  static unsigned getHashValue(const Fortran::evaluate::SetLength<KIND> &x) {
+    return (getHashValue(x.left()) - getHashValue(x.right())) * 59u +
+           static_cast<unsigned>(KIND);
+  }
+  static unsigned getHashValue(const Fortran::semantics::SymbolRef &sym) {
+    return getHashValue(sym.get());
+  }
+  static unsigned getHashValue(const Fortran::evaluate::Substring &x) {
+    return 61u * std::visit([&](const auto &p) { return getHashValue(p); },
+                            x.parent()) -
+           getHashValue(x.lower()) - (getHashValue(x.lower()) + 1u);
+  }
+  static unsigned
+  getHashValue(const Fortran::evaluate::StaticDataObject::Pointer &x) {
+    return llvm::hash_value(x->name());
+  }
+  static unsigned getHashValue(const Fortran::evaluate::SpecificIntrinsic &x) {
+    return llvm::hash_value(x.name);
+  }
+  template <typename A>
+  static unsigned getHashValue(const Fortran::evaluate::Constant<A> &x) {
+    // FIXME: Should hash the content.
+    return 103u;
+  }
+  static unsigned getHashValue(const Fortran::evaluate::ActualArgument &x) {
+    if (const Fortran::evaluate::Symbol *sym = x.GetAssumedTypeDummy())
+      return getHashValue(*sym);
+    return getHashValue(*x.UnwrapExpr());
+  }
+  static unsigned
+  getHashValue(const Fortran::evaluate::ProcedureDesignator &x) {
+    return std::visit([&](const auto &v) { return getHashValue(v); }, x.u);
+  }
+  static unsigned getHashValue(const Fortran::evaluate::ProcedureRef &x) {
+    unsigned args = 13u;
+    for (const std::optional<Fortran::evaluate::ActualArgument> &v :
+         x.arguments())
+      args -= getHashValue(v);
+    return getHashValue(x.proc()) * 101u - args;
+  }
+  template <typename A>
+  static unsigned
+  getHashValue(const Fortran::evaluate::ArrayConstructor<A> &x) {
+    // FIXME: hash the contents.
+    return 127u;
+  }
+  static unsigned getHashValue(const Fortran::evaluate::ImpliedDoIndex &x) {
+    return llvm::hash_value(toStringRef(x.name).str()) * 131u;
+  }
+  static unsigned getHashValue(const Fortran::evaluate::TypeParamInquiry &x) {
+    return getHashValue(x.base()) * 137u - getHashValue(x.parameter()) * 3u;
+  }
+  static unsigned getHashValue(const Fortran::evaluate::DescriptorInquiry &x) {
+    return getHashValue(x.base()) * 139u -
+           static_cast<unsigned>(x.field()) * 13u +
+           static_cast<unsigned>(x.dimension());
+  }
+  static unsigned
+  getHashValue(const Fortran::evaluate::StructureConstructor &x) {
+    // FIXME: hash the contents.
+    return 149u;
+  }
+  template <int KIND>
+  static unsigned getHashValue(const Fortran::evaluate::Not<KIND> &x) {
+    return getHashValue(x.left()) * 61u + static_cast<unsigned>(KIND);
+  }
+  template <int KIND>
+  static unsigned
+  getHashValue(const Fortran::evaluate::LogicalOperation<KIND> &x) {
+    unsigned result = getHashValue(x.left()) + getHashValue(x.right());
+    return result * 67u + static_cast<unsigned>(x.logicalOperator) * 5u;
+  }
+  template <Fortran::common::TypeCategory TC, int KIND>
+  static unsigned getHashValue(
+      const Fortran::evaluate::Relational<Fortran::evaluate::Type<TC, KIND>>
+          &x) {
+    return (getHashValue(x.left()) + getHashValue(x.right())) * 71u +
+           static_cast<unsigned>(TC) + static_cast<unsigned>(KIND) +
+           static_cast<unsigned>(x.opr) * 11u;
+  }
+  template <typename A>
+  static unsigned getHashValue(const Fortran::evaluate::Expr<A> &x) {
+    return std::visit([&](const auto &v) { return getHashValue(v); }, x.u);
+  }
+  static unsigned getHashValue(
+      const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &x) {
+    return std::visit([&](const auto &v) { return getHashValue(v); }, x.u);
+  }
+  template <typename A>
+  static unsigned getHashValue(const Fortran::evaluate::Designator<A> &x) {
+    return std::visit([&](const auto &v) { return getHashValue(v); }, x.u);
+  }
+  template <int BITS>
+  static unsigned
+  getHashValue(const Fortran::evaluate::value::Integer<BITS> &x) {
+    return static_cast<unsigned>(x.ToSInt());
+  }
+  static unsigned getHashValue(const Fortran::evaluate::NullPointer &x) {
+    return ~179u;
+  }
+};
+} // namespace
+
+unsigned Fortran::lower::getHashValue(
+    const Fortran::lower::ExplicitIterSpace::ArrayBases &x) {
+  return std::visit(
+      [&](const auto *p) { return HashEvaluateExpr::getHashValue(*p); }, x);
+}
+
+unsigned Fortran::lower::getHashValue(Fortran::lower::FrontEndExpr x) {
+  return HashEvaluateExpr::getHashValue(*x);
+}
+
+namespace {
+// Define the is equals test for using Fortran::evaluate::Expr values with
+// llvm::DenseMap.
+class IsEqualEvaluateExpr {
+public:
+  // A Se::Symbol is the only part of an Fortran::evaluate::Expr with an
+  // identity property.
+  static bool isEqual(const Fortran::semantics::Symbol &x,
+                      const Fortran::semantics::Symbol &y) {
+    return isEqual(&x, &y);
+  }
+  static bool isEqual(const Fortran::semantics::Symbol *x,
+                      const Fortran::semantics::Symbol *y) {
+    return x == y;
+  }
+  template <typename A, bool COPY>
+  static bool isEqual(const Fortran::common::Indirection<A, COPY> &x,
+                      const Fortran::common::Indirection<A, COPY> &y) {
+    return isEqual(x.value(), y.value());
+  }
+  template <typename A>
+  static bool isEqual(const std::optional<A> &x, const std::optional<A> &y) {
+    if (x.has_value() && y.has_value())
+      return isEqual(x.value(), y.value());
+    return !x.has_value() && !y.has_value();
+  }
+  template <typename A>
+  static bool isEqual(const std::vector<A> &x, const std::vector<A> &y) {
+    if (x.size() != y.size())
+      return false;
+    const std::size_t size = x.size();
+    for (std::remove_const_t<decltype(size)> i = 0; i < size; ++i)
+      if (!isEqual(x[i], y[i]))
+        return false;
+    return true;
+  }
+  static bool isEqual(const Fortran::evaluate::Subscript &x,
+                      const Fortran::evaluate::Subscript &y) {
+    return std::visit(
+        [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);
+  }
+  static bool isEqual(const Fortran::evaluate::Triplet &x,
+                      const Fortran::evaluate::Triplet &y) {
+    return isEqual(x.lower(), y.lower()) && isEqual(x.upper(), y.upper()) &&
+           isEqual(x.stride(), y.stride());
+  }
+  static bool isEqual(const Fortran::evaluate::Component &x,
+                      const Fortran::evaluate::Component &y) {
+    return isEqual(x.base(), y.base()) &&
+           isEqual(x.GetLastSymbol(), y.GetLastSymbol());
+  }
+  static bool isEqual(const Fortran::evaluate::ArrayRef &x,
+                      const Fortran::evaluate::ArrayRef &y) {
+    return isEqual(x.base(), y.base()) && isEqual(x.subscript(), y.subscript());
+  }
+  static bool isEqual(const Fortran::evaluate::CoarrayRef &x,
+                      const Fortran::evaluate::CoarrayRef &y) {
+    return isEqual(x.base(), y.base()) &&
+           isEqual(x.subscript(), y.subscript()) &&
+           isEqual(x.cosubscript(), y.cosubscript()) &&
+           isEqual(x.stat(), y.stat()) && isEqual(x.team(), y.team());
+  }
+  static bool isEqual(const Fortran::evaluate::NamedEntity &x,
+                      const Fortran::evaluate::NamedEntity &y) {
+    if (x.IsSymbol() && y.IsSymbol())
+      return isEqual(x.GetFirstSymbol(), y.GetFirstSymbol());
+    return !x.IsSymbol() && !y.IsSymbol() &&
+           isEqual(x.GetComponent(), y.GetComponent());
+  }
+  static bool isEqual(const Fortran::evaluate::DataRef &x,
+                      const Fortran::evaluate::DataRef &y) {
+    return std::visit(
+        [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);
+  }
+  static bool isEqual(const Fortran::evaluate::ComplexPart &x,
+                      const Fortran::evaluate::ComplexPart &y) {
+    return isEqual(x.complex(), y.complex()) && x.part() == y.part();
+  }
+  template <typename A, Fortran::common::TypeCategory TC2>
+  static bool isEqual(const Fortran::evaluate::Convert<A, TC2> &x,
+                      const Fortran::evaluate::Convert<A, TC2> &y) {
+    return isEqual(x.left(), y.left());
+  }
+  template <int KIND>
+  static bool isEqual(const Fortran::evaluate::ComplexComponent<KIND> &x,
+                      const Fortran::evaluate::ComplexComponent<KIND> &y) {
+    return isEqual(x.left(), y.left()) &&
+           x.isImaginaryPart == y.isImaginaryPart;
+  }
+  template <typename T>
+  static bool isEqual(const Fortran::evaluate::Parentheses<T> &x,
+                      const Fortran::evaluate::Parentheses<T> &y) {
+    return isEqual(x.left(), y.left());
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Negate<A> &x,
+                      const Fortran::evaluate::Negate<A> &y) {
+    return isEqual(x.left(), y.left());
+  }
+  template <typename A>
+  static bool isBinaryEqual(const A &x, const A &y) {
+    return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right());
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Add<A> &x,
+                      const Fortran::evaluate::Add<A> &y) {
+    return isBinaryEqual(x, y);
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Subtract<A> &x,
+                      const Fortran::evaluate::Subtract<A> &y) {
+    return isBinaryEqual(x, y);
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Multiply<A> &x,
+                      const Fortran::evaluate::Multiply<A> &y) {
+    return isBinaryEqual(x, y);
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Divide<A> &x,
+                      const Fortran::evaluate::Divide<A> &y) {
+    return isBinaryEqual(x, y);
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Power<A> &x,
+                      const Fortran::evaluate::Power<A> &y) {
+    return isBinaryEqual(x, y);
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Extremum<A> &x,
+                      const Fortran::evaluate::Extremum<A> &y) {
+    return isBinaryEqual(x, y);
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::RealToIntPower<A> &x,
+                      const Fortran::evaluate::RealToIntPower<A> &y) {
+    return isBinaryEqual(x, y);
+  }
+  template <int KIND>
+  static bool isEqual(const Fortran::evaluate::ComplexConstructor<KIND> &x,
+                      const Fortran::evaluate::ComplexConstructor<KIND> &y) {
+    return isBinaryEqual(x, y);
+  }
+  template <int KIND>
+  static bool isEqual(const Fortran::evaluate::Concat<KIND> &x,
+                      const Fortran::evaluate::Concat<KIND> &y) {
+    return isBinaryEqual(x, y);
+  }
+  template <int KIND>
+  static bool isEqual(const Fortran::evaluate::SetLength<KIND> &x,
+                      const Fortran::evaluate::SetLength<KIND> &y) {
+    return isBinaryEqual(x, y);
+  }
+  static bool isEqual(const Fortran::semantics::SymbolRef &x,
+                      const Fortran::semantics::SymbolRef &y) {
+    return isEqual(x.get(), y.get());
+  }
+  static bool isEqual(const Fortran::evaluate::Substring &x,
+                      const Fortran::evaluate::Substring &y) {
+    return std::visit(
+               [&](const auto &p, const auto &q) { return isEqual(p, q); },
+               x.parent(), y.parent()) &&
+           isEqual(x.lower(), y.lower()) && isEqual(x.lower(), y.lower());
+  }
+  static bool isEqual(const Fortran::evaluate::StaticDataObject::Pointer &x,
+                      const Fortran::evaluate::StaticDataObject::Pointer &y) {
+    return x->name() == y->name();
+  }
+  static bool isEqual(const Fortran::evaluate::SpecificIntrinsic &x,
+                      const Fortran::evaluate::SpecificIntrinsic &y) {
+    return x.name == y.name;
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Constant<A> &x,
+                      const Fortran::evaluate::Constant<A> &y) {
+    return x == y;
+  }
+  static bool isEqual(const Fortran::evaluate::ActualArgument &x,
+                      const Fortran::evaluate::ActualArgument &y) {
+    if (const Fortran::evaluate::Symbol *xs = x.GetAssumedTypeDummy()) {
+      if (const Fortran::evaluate::Symbol *ys = y.GetAssumedTypeDummy())
+        return isEqual(*xs, *ys);
+      return false;
+    }
+    return !y.GetAssumedTypeDummy() &&
+           isEqual(*x.UnwrapExpr(), *y.UnwrapExpr());
+  }
+  static bool isEqual(const Fortran::evaluate::ProcedureDesignator &x,
+                      const Fortran::evaluate::ProcedureDesignator &y) {
+    return std::visit(
+        [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);
+  }
+  static bool isEqual(const Fortran::evaluate::ProcedureRef &x,
+                      const Fortran::evaluate::ProcedureRef &y) {
+    return isEqual(x.proc(), y.proc()) && isEqual(x.arguments(), y.arguments());
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::ArrayConstructor<A> &x,
+                      const Fortran::evaluate::ArrayConstructor<A> &y) {
+    llvm::report_fatal_error("not implemented");
+  }
+  static bool isEqual(const Fortran::evaluate::ImpliedDoIndex &x,
+                      const Fortran::evaluate::ImpliedDoIndex &y) {
+    return toStringRef(x.name) == toStringRef(y.name);
+  }
+  static bool isEqual(const Fortran::evaluate::TypeParamInquiry &x,
+                      const Fortran::evaluate::TypeParamInquiry &y) {
+    return isEqual(x.base(), y.base()) && isEqual(x.parameter(), y.parameter());
+  }
+  static bool isEqual(const Fortran::evaluate::DescriptorInquiry &x,
+                      const Fortran::evaluate::DescriptorInquiry &y) {
+    return isEqual(x.base(), y.base()) && x.field() == y.field() &&
+           x.dimension() == y.dimension();
+  }
+  static bool isEqual(const Fortran::evaluate::StructureConstructor &x,
+                      const Fortran::evaluate::StructureConstructor &y) {
+    llvm::report_fatal_error("not implemented");
+  }
+  template <int KIND>
+  static bool isEqual(const Fortran::evaluate::Not<KIND> &x,
+                      const Fortran::evaluate::Not<KIND> &y) {
+    return isEqual(x.left(), y.left());
+  }
+  template <int KIND>
+  static bool isEqual(const Fortran::evaluate::LogicalOperation<KIND> &x,
+                      const Fortran::evaluate::LogicalOperation<KIND> &y) {
+    return isEqual(x.left(), y.left()) && isEqual(x.right(), x.right());
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Relational<A> &x,
+                      const Fortran::evaluate::Relational<A> &y) {
+    return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right());
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Expr<A> &x,
+                      const Fortran::evaluate::Expr<A> &y) {
+    return std::visit(
+        [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);
+  }
+  static bool
+  isEqual(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &x,
+          const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &y) {
+    return std::visit(
+        [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);
+  }
+  template <typename A>
+  static bool isEqual(const Fortran::evaluate::Designator<A> &x,
+                      const Fortran::evaluate::Designator<A> &y) {
+    return std::visit(
+        [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);
+  }
+  template <int BITS>
+  static bool isEqual(const Fortran::evaluate::value::Integer<BITS> &x,
+                      const Fortran::evaluate::value::Integer<BITS> &y) {
+    return x == y;
+  }
+  static bool isEqual(const Fortran::evaluate::NullPointer &x,
+                      const Fortran::evaluate::NullPointer &y) {
+    return true;
+  }
+  template <typename A, typename B,
+            std::enable_if_t<!std::is_same_v<A, B>, bool> = true>
+  static bool isEqual(const A &, const B &) {
+    return false;
+  }
+};
+} // namespace
+
+bool Fortran::lower::isEqual(
+    const Fortran::lower::ExplicitIterSpace::ArrayBases &x,
+    const Fortran::lower::ExplicitIterSpace::ArrayBases &y) {
+  return std::visit(
+      Fortran::common::visitors{
+          // Fortran::semantics::Symbol * are the exception here. These pointers
+          // have identity; if two Symbol * values are the same (different) then
+          // they are the same (different) logical symbol.
+          [&](Fortran::lower::FrontEndSymbol p,
+              Fortran::lower::FrontEndSymbol q) { return p == q; },
+          [&](const auto *p, const auto *q) {
+            if constexpr (std::is_same_v<decltype(p), decltype(q)>) {
+              LLVM_DEBUG(llvm::dbgs()
+                         << "is equal: " << p << ' ' << q << ' '
+                         << IsEqualEvaluateExpr::isEqual(*p, *q) << '\n');
+              return IsEqualEvaluateExpr::isEqual(*p, *q);
+            } else {
+              // Different subtree types are never equal.
+              return false;
+            }
+          }},
+      x, y);
+}
+
+bool Fortran::lower::isEqual(Fortran::lower::FrontEndExpr x,
+                             Fortran::lower::FrontEndExpr y) {
+  auto empty = llvm::DenseMapInfo<Fortran::lower::FrontEndExpr>::getEmptyKey();
+  auto tombstone =
+      llvm::DenseMapInfo<Fortran::lower::FrontEndExpr>::getTombstoneKey();
+  if (x == empty || y == empty || x == tombstone || y == tombstone)
+    return x == y;
+  return x == y || IsEqualEvaluateExpr::isEqual(*x, *y);
+}
+
+namespace {
+
+/// This class can recover the base array in an expression that contains
+/// explicit iteration space symbols. Most of the class can be ignored as it is
+/// boilerplate Fortran::evaluate::Expr traversal.
+class ArrayBaseFinder {
+public:
+  using RT = bool;
+
+  ArrayBaseFinder(llvm::ArrayRef<Fortran::lower::FrontEndSymbol> syms)
+      : controlVars(syms.begin(), syms.end()) {}
+
+  template <typename T>
+  void operator()(const T &x) {
+    (void)find(x);
+  }
+
+  /// Get the list of bases.
+  llvm::ArrayRef<Fortran::lower::ExplicitIterSpace::ArrayBases>
+  getBases() const {
+    LLVM_DEBUG(llvm::dbgs()
+               << "number of array bases found: " << bases.size() << '\n');
+    return bases;
+  }
+
+private:
+  // First, the cases that are of interest.
+  RT find(const Fortran::semantics::Symbol &symbol) {
+    if (symbol.Rank() > 0) {
+      bases.push_back(&symbol);
+      return true;
+    }
+    return {};
+  }
+  RT find(const Fortran::evaluate::Component &x) {
+    auto found = find(x.base());
+    if (!found && x.base().Rank() == 0 && x.Rank() > 0) {
+      bases.push_back(&x);
+      return true;
+    }
+    return found;
+  }
+  RT find(const Fortran::evaluate::ArrayRef &x) {
+    for (const auto &sub : x.subscript())
+      (void)find(sub);
+    if (x.base().IsSymbol()) {
+      if (x.Rank() > 0 || intersection(x.subscript())) {
+        bases.push_back(&x);
+        return true;
+      }
+      return {};
+    }
+    auto found = find(x.base());
+    if (!found && ((x.base().Rank() == 0 && x.Rank() > 0) ||
+                   intersection(x.subscript()))) {
+      bases.push_back(&x);
+      return true;
+    }
+    return found;
+  }
+  RT find(const Fortran::evaluate::Triplet &x) {
+    if (const auto *lower = x.GetLower())
+      (void)find(*lower);
+    if (const auto *upper = x.GetUpper())
+      (void)find(*upper);
+    return find(x.GetStride());
+  }
+  RT find(const Fortran::evaluate::IndirectSubscriptIntegerExpr &x) {
+    return find(x.value());
+  }
+  RT find(const Fortran::evaluate::Subscript &x) { return find(x.u); }
+  RT find(const Fortran::evaluate::DataRef &x) { return find(x.u); }
+  RT find(const Fortran::evaluate::CoarrayRef &x) {
+    assert(false && "coarray reference");
+    return {};
+  }
+
+  template <typename A>
+  bool intersection(const A &subscripts) {
+    return Fortran::lower::symbolsIntersectSubscripts(controlVars, subscripts);
+  }
+
+  // The rest is traversal boilerplate and can be ignored.
+  RT find(const Fortran::evaluate::Substring &x) { return find(x.parent()); }
+  template <typename A>
+  RT find(const Fortran::semantics::SymbolRef x) {
+    return find(*x);
+  }
+  RT find(const Fortran::evaluate::NamedEntity &x) {
+    if (x.IsSymbol())
+      return find(x.GetFirstSymbol());
+    return find(x.GetComponent());
+  }
+
+  template <typename A, bool C>
+  RT find(const Fortran::common::Indirection<A, C> &x) {
+    return find(x.value());
+  }
+  template <typename A>
+  RT find(const std::unique_ptr<A> &x) {
+    return find(x.get());
+  }
+  template <typename A>
+  RT find(const std::shared_ptr<A> &x) {
+    return find(x.get());
+  }
+  template <typename A>
+  RT find(const A *x) {
+    if (x)
+      return find(*x);
+    return {};
+  }
+  template <typename A>
+  RT find(const std::optional<A> &x) {
+    if (x)
+      return find(*x);
+    return {};
+  }
+  template <typename... A>
+  RT find(const std::variant<A...> &u) {
+    return std::visit([&](const auto &v) { return find(v); }, u);
+  }
+  template <typename A>
+  RT find(const std::vector<A> &x) {
+    for (auto &v : x)
+      (void)find(v);
+    return {};
+  }
+  RT find(const Fortran::evaluate::BOZLiteralConstant &) { return {}; }
+  RT find(const Fortran::evaluate::NullPointer &) { return {}; }
+  template <typename T>
+  RT find(const Fortran::evaluate::Constant<T> &x) {
+    return {};
+  }
+  RT find(const Fortran::evaluate::StaticDataObject &) { return {}; }
+  RT find(const Fortran::evaluate::ImpliedDoIndex &) { return {}; }
+  RT find(const Fortran::evaluate::BaseObject &x) {
+    (void)find(x.u);
+    return {};
+  }
+  RT find(const Fortran::evaluate::TypeParamInquiry &) { return {}; }
+  RT find(const Fortran::evaluate::ComplexPart &x) { return {}; }
+  template <typename T>
+  RT find(const Fortran::evaluate::Designator<T> &x) {
+    return find(x.u);
+  }
+  template <typename T>
+  RT find(const Fortran::evaluate::Variable<T> &x) {
+    return find(x.u);
+  }
+  RT find(const Fortran::evaluate::DescriptorInquiry &) { return {}; }
+  RT find(const Fortran::evaluate::SpecificIntrinsic &) { return {}; }
+  RT find(const Fortran::evaluate::ProcedureDesignator &x) { return {}; }
+  RT find(const Fortran::evaluate::ProcedureRef &x) {
+    (void)find(x.proc());
+    if (x.IsElemental())
+      (void)find(x.arguments());
+    return {};
+  }
+  RT find(const Fortran::evaluate::ActualArgument &x) {
+    if (const auto *sym = x.GetAssumedTypeDummy())
+      (void)find(*sym);
+    else
+      (void)find(x.UnwrapExpr());
+    return {};
+  }
+  template <typename T>
+  RT find(const Fortran::evaluate::FunctionRef<T> &x) {
+    (void)find(static_cast<const Fortran::evaluate::ProcedureRef &>(x));
+    return {};
+  }
+  template <typename T>
+  RT find(const Fortran::evaluate::ArrayConstructorValue<T> &) {
+    return {};
+  }
+  template <typename T>
+  RT find(const Fortran::evaluate::ArrayConstructorValues<T> &) {
+    return {};
+  }
+  template <typename T>
+  RT find(const Fortran::evaluate::ImpliedDo<T> &) {
+    return {};
+  }
+  RT find(const Fortran::semantics::ParamValue &) { return {}; }
+  RT find(const Fortran::semantics::DerivedTypeSpec &) { return {}; }
+  RT find(const Fortran::evaluate::StructureConstructor &) { return {}; }
+  template <typename D, typename R, typename O>
+  RT find(const Fortran::evaluate::Operation<D, R, O> &op) {
+    (void)find(op.left());
+    return false;
+  }
+  template <typename D, typename R, typename LO, typename RO>
+  RT find(const Fortran::evaluate::Operation<D, R, LO, RO> &op) {
+    (void)find(op.left());
+    (void)find(op.right());
+    return false;
+  }
+  RT find(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &x) {
+    (void)find(x.u);
+    return {};
+  }
+  template <typename T>
+  RT find(const Fortran::evaluate::Expr<T> &x) {
+    (void)find(x.u);
+    return {};
+  }
+
+  llvm::SmallVector<Fortran::lower::ExplicitIterSpace::ArrayBases> bases;
+  llvm::SmallVector<Fortran::lower::FrontEndSymbol> controlVars;
+};
+
+} // namespace
+
+void Fortran::lower::ExplicitIterSpace::leave() {
+  ccLoopNest.pop_back();
+  --forallContextOpen;
+  conditionalCleanup();
+}
+
+void Fortran::lower::ExplicitIterSpace::addSymbol(
+    Fortran::lower::FrontEndSymbol sym) {
+  assert(!symbolStack.empty());
+  symbolStack.back().push_back(sym);
+}
+
+void Fortran::lower::ExplicitIterSpace::exprBase(Fortran::lower::FrontEndExpr x,
+                                                 bool lhs) {
+  ArrayBaseFinder finder(collectAllSymbols());
+  finder(*x);
+  llvm::ArrayRef<Fortran::lower::ExplicitIterSpace::ArrayBases> bases =
+      finder.getBases();
+  if (rhsBases.empty())
+    endAssign();
+  if (lhs) {
+    if (bases.empty()) {
+      lhsBases.push_back(llvm::None);
+      return;
+    }
+    assert(bases.size() >= 1 && "must detect an array reference on lhs");
+    if (bases.size() > 1)
+      rhsBases.back().append(bases.begin(), bases.end() - 1);
+    lhsBases.push_back(bases.back());
+    return;
+  }
+  rhsBases.back().append(bases.begin(), bases.end());
+}
+
+void Fortran::lower::ExplicitIterSpace::endAssign() { rhsBases.emplace_back(); }
+
+void Fortran::lower::ExplicitIterSpace::pushLevel() {
+  symbolStack.push_back(llvm::SmallVector<Fortran::lower::FrontEndSymbol>{});
+}
+
+void Fortran::lower::ExplicitIterSpace::popLevel() { symbolStack.pop_back(); }
+
+void Fortran::lower::ExplicitIterSpace::conditionalCleanup() {
+  if (forallContextOpen == 0) {
+    // Exiting the outermost FORALL context.
+    // Cleanup any residual mask buffers.
+    outermostContext().finalize();
+    // Clear and reset all the cached information.
+    symbolStack.clear();
+    lhsBases.clear();
+    rhsBases.clear();
+    loadBindings.clear();
+    ccLoopNest.clear();
+    innerArgs.clear();
+    outerLoop = llvm::None;
+    clearLoops();
+    counter = 0;
+  }
+}
+
+llvm::Optional<size_t>
+Fortran::lower::ExplicitIterSpace::findArgPosition(fir::ArrayLoadOp load) {
+  if (lhsBases[counter].hasValue()) {
+    auto ld = loadBindings.find(lhsBases[counter].getValue());
+    llvm::Optional<size_t> optPos;
+    if (ld != loadBindings.end() && ld->second == load)
+      optPos = static_cast<size_t>(0u);
+    assert(optPos.hasValue() && "load does not correspond to lhs");
+    return optPos;
+  }
+  return llvm::None;
+}
+
+llvm::SmallVector<Fortran::lower::FrontEndSymbol>
+Fortran::lower::ExplicitIterSpace::collectAllSymbols() {
+  llvm::SmallVector<Fortran::lower::FrontEndSymbol> result;
+  for (llvm::SmallVector<FrontEndSymbol> vec : symbolStack)
+    result.append(vec.begin(), vec.end());
+  return result;
+}
+
+llvm::raw_ostream &
+Fortran::lower::operator<<(llvm::raw_ostream &s,
+                           const Fortran::lower::ImplicitIterSpace &e) {
+  for (const llvm::SmallVector<
+           Fortran::lower::ImplicitIterSpace::FrontEndMaskExpr> &xs :
+       e.getMasks()) {
+    s << "{ ";
+    for (const Fortran::lower::ImplicitIterSpace::FrontEndMaskExpr &x : xs)
+      x->AsFortran(s << '(') << "), ";
+    s << "}\n";
+  }
+  return s;
+}
+
+llvm::raw_ostream &
+Fortran::lower::operator<<(llvm::raw_ostream &s,
+                           const Fortran::lower::ExplicitIterSpace &e) {
+  auto dump = [&](const auto &u) {
+    std::visit(Fortran::common::visitors{
+                   [&](const Fortran::semantics::Symbol *y) {
+                     s << "  " << *y << '\n';
+                   },
+                   [&](const Fortran::evaluate::ArrayRef *y) {
+                     s << "  ";
+                     if (y->base().IsSymbol())
+                       s << y->base().GetFirstSymbol();
+                     else
+                       s << y->base().GetComponent().GetLastSymbol();
+                     s << '\n';
+                   },
+                   [&](const Fortran::evaluate::Component *y) {
+                     s << "  " << y->GetLastSymbol() << '\n';
+                   }},
+               u);
+  };
+  s << "LHS bases:\n";
+  for (const llvm::Optional<Fortran::lower::ExplicitIterSpace::ArrayBases> &u :
+       e.lhsBases)
+    if (u.hasValue())
+      dump(u.getValue());
+  s << "RHS bases:\n";
+  for (const llvm::SmallVector<Fortran::lower::ExplicitIterSpace::ArrayBases>
+           &bases : e.rhsBases) {
+    for (const Fortran::lower::ExplicitIterSpace::ArrayBases &u : bases)
+      dump(u);
+    s << '\n';
+  }
+  return s;
+}
+
+void Fortran::lower::ImplicitIterSpace::dump() const {
+  llvm::errs() << *this << '\n';
+}
+
+void Fortran::lower::ExplicitIterSpace::dump() const {
+  llvm::errs() << *this << '\n';
+}

flang/lib/Optimizer/Builder/FIRBuilder.cpp

return exv.match(
       [&](const fir::MutableBoxValue &) -> mlir::Value {
         // MutableBoxValue must be read into another category to work with them
         // outside of allocation/assignment contexts.
         fir::emitFatalError(loc, "createShape on MutableBoxValue");
       },
       [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
 }
 
+mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc,
+                                           const fir::ExtendedValue &exv,
+                                           mlir::ValueRange triples,
+                                           mlir::ValueRange path) {
+  if (triples.empty()) {
+    // If there is no slicing by triple notation, then take the whole array.
+    auto fullShape = [&](const llvm::ArrayRef<mlir::Value> lbounds,
+                         llvm::ArrayRef<mlir::Value> extents) -> mlir::Value {
+      llvm::SmallVector<mlir::Value> trips;
+      auto idxTy = getIndexType();
+      auto one = createIntegerConstant(loc, idxTy, 1);
+      if (lbounds.empty()) {
+        for (auto v : extents) {
+          trips.push_back(one);
+          trips.push_back(v);
+          trips.push_back(one);
+        }
+        return create<fir::SliceOp>(loc, trips, path);
+      }
+      for (auto [lbnd, extent] : llvm::zip(lbounds, extents)) {
+        auto lb = createConvert(loc, idxTy, lbnd);
+        auto ext = createConvert(loc, idxTy, extent);
+        auto shift = create<mlir::arith::SubIOp>(loc, lb, one);
+        auto ub = create<mlir::arith::AddIOp>(loc, ext, shift);
+        trips.push_back(lb);
+        trips.push_back(ub);
+        trips.push_back(one);
+      }
+      return create<fir::SliceOp>(loc, trips, path);
+    };
+    return exv.match(
+        [&](const fir::ArrayBoxValue &box) {
+          return fullShape(box.getLBounds(), box.getExtents());
+        },
+        [&](const fir::CharArrayBoxValue &box) {
+          return fullShape(box.getLBounds(), box.getExtents());
+        },
+        [&](const fir::BoxValue &box) {
+          auto extents = fir::factory::readExtents(*this, loc, box);
+          return fullShape(box.getLBounds(), extents);
+        },
+        [&](const fir::MutableBoxValue &) -> mlir::Value {
+          // MutableBoxValue must be read into another category to work with
+          // them outside of allocation/assignment contexts.
+          fir::emitFatalError(loc, "createSlice on MutableBoxValue");
+        },
+        [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
+  }
+  return create<fir::SliceOp>(loc, triples, path);
+}
+
 mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
                                          const fir::ExtendedValue &exv) {
   mlir::Value itemAddr = fir::getBase(exv);
   if (itemAddr.getType().isa<fir::BoxType>())
     return itemAddr;
   auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());
   if (!elementType) {
     mlir::emitError(loc, "internal: expected a memory reference type ")
return box.match(
         // outside of allocation/assignment contexts.
         fir::emitFatalError(loc, "readExtents on MutableBoxValue");
       },
       [&](const auto &) -> mlir::Value {
         fir::emitFatalError(loc, "extent inquiry on scalar");
       });
 }
 
+mlir::Value fir::factory::readLowerBound(fir::FirOpBuilder &builder,
+                                         mlir::Location loc,
+                                         const fir::ExtendedValue &box,
+                                         unsigned dim,
+                                         mlir::Value defaultValue) {
+  assert(box.rank() > dim);
+  auto lb = box.match(
+      [&](const fir::ArrayBoxValue &x) -> mlir::Value {
+        return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
+      },
+      [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
+        return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
+      },
+      [&](const fir::BoxValue &x) -> mlir::Value {
+        return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
+      },
+      [&](const fir::MutableBoxValue &x) -> mlir::Value {
+        return readLowerBound(builder, loc,
+                              fir::factory::genMutableBoxRead(builder, loc, x),
+                              dim, defaultValue);
+      },
+      [&](const auto &) -> mlir::Value {
+        fir::emitFatalError(loc, "lower bound inquiry on scalar");
+      });
+  if (lb)
+    return lb;
+  return defaultValue;
+}
+
 llvm::SmallVector<mlir::Value>
 fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc,
                           const fir::BoxValue &box) {
   llvm::SmallVector<mlir::Value> result;
   auto explicitExtents = box.getExplicitExtents();
   if (!explicitExtents.empty()) {
     result.append(explicitExtents.begin(), explicitExtents.end());
     return result;
fir::factory::createExtents(fir::FirOpBuilder &builder, mlir::Location loc,
   for (auto ext : seqTy.getShape())
     extents.emplace_back(
         ext == fir::SequenceType::getUnknownExtent()
             ? builder.create<fir::UndefOp>(loc, idxTy).getResult()
             : builder.createIntegerConstant(loc, idxTy, ext));
   return extents;
 }
 
+// FIXME: This needs some work. To correctly determine the extended value of a
+// component, one needs the base object, its type, and its type parameters. (An
+// alternative would be to provide an already computed address of the final
+// component rather than the base object's address, the point being the result
+// will require the address of the final component to create the extended
+// value.) One further needs the full path of components being applied. One
+// needs to apply type-based expressions to type parameters along this said
+// path. (See applyPathToType for a type-only derivation.) Finally, one needs to
+// compose the extended value of the terminal component, including all of its
+// parameters: array lower bounds expressions, extents, type parameters, etc.
+// Any of these properties may be deferred until runtime in Fortran. This
+// operation may therefore generate a sizeable block of IR, including calls to
+// type-based helper functions, so caching the result of this operation in the
+// client would be advised as well.
+fir::ExtendedValue fir::factory::componentToExtendedValue(
+    fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value component) {
+  auto fieldTy = component.getType();
+  if (auto ty = fir::dyn_cast_ptrEleTy(fieldTy))
+    fieldTy = ty;
+  if (fieldTy.isa<fir::BoxType>()) {
+    llvm::SmallVector<mlir::Value> nonDeferredTypeParams;
+    auto eleTy = fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(fieldTy));
+    if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
+      auto lenTy = builder.getCharacterLengthType();
+      if (charTy.hasConstantLen())
+        nonDeferredTypeParams.emplace_back(
+            builder.createIntegerConstant(loc, lenTy, charTy.getLen()));
+      // TODO: Starting, F2003, the dynamic character length might be dependent
+      // on a PDT length parameter. There is no way to make a difference with
+      // deferred length here yet.
+    }
+    if (auto recTy = eleTy.dyn_cast<fir::RecordType>())
+      if (recTy.getNumLenParams() > 0)
+        TODO(loc, "allocatable and pointer components non deferred length "
+                  "parameters");
+
+    return fir::MutableBoxValue(component, nonDeferredTypeParams,
+                                /*mutableProperties=*/{});
+  }
+  llvm::SmallVector<mlir::Value> extents;
+  if (auto seqTy = fieldTy.dyn_cast<fir::SequenceType>()) {
+    fieldTy = seqTy.getEleTy();
+    auto idxTy = builder.getIndexType();
+    for (auto extent : seqTy.getShape()) {
+      if (extent == fir::SequenceType::getUnknownExtent())
+        TODO(loc, "array component shape depending on length parameters");
+      extents.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));
+    }
+  }
+  if (auto charTy = fieldTy.dyn_cast<fir::CharacterType>()) {
+    auto cstLen = charTy.getLen();
+    if (cstLen == fir::CharacterType::unknownLen())
+      TODO(loc, "get character component length from length type parameters");
+    auto len = builder.createIntegerConstant(
+        loc, builder.getCharacterLengthType(), cstLen);
+    if (!extents.empty())
+      return fir::CharArrayBoxValue{component, len, extents};
+    return fir::CharBoxValue{component, len};
+  }
+  if (auto recordTy = fieldTy.dyn_cast<fir::RecordType>())
+    if (recordTy.getNumLenParams() != 0)
+      TODO(loc,
+           "lower component ref that is a derived type with length parameter");
+  if (!extents.empty())
+    return fir::ArrayBoxValue{component, extents};
+  return component;
+}
+
+fir::ExtendedValue fir::factory::arrayElementToExtendedValue(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const fir::ExtendedValue &array, mlir::Value element) {
+  return array.match(
+      [&](const fir::CharBoxValue &cb) -> fir::ExtendedValue {
+        return cb.clone(element);
+      },
+      [&](const fir::CharArrayBoxValue &bv) -> fir::ExtendedValue {
+        return bv.cloneElement(element);
+      },
+      [&](const fir::BoxValue &box) -> fir::ExtendedValue {
+        if (box.isCharacter()) {
+          auto len = fir::factory::readCharLen(builder, loc, box);
+          return fir::CharBoxValue{element, len};
+        }
+        if (box.isDerivedWithLengthParameters())
+          TODO(loc, "get length parameters from derived type BoxValue");
+        return element;
+      },
+      [&](const auto &) -> fir::ExtendedValue { return element; });
+}
+
+fir::ExtendedValue fir::factory::arraySectionElementToExtendedValue(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice) {
+  if (!slice)
+    return arrayElementToExtendedValue(builder, loc, array, element);
+  auto sliceOp = mlir::dyn_cast_or_null<fir::SliceOp>(slice.getDefiningOp());
+  assert(sliceOp && "slice must be a sliceOp");
+  if (sliceOp.getFields().empty())
+    return arrayElementToExtendedValue(builder, loc, array, element);
+  // For F95, using componentToExtendedValue will work, but when PDTs are
+  // lowered. It will be required to go down the slice to propagate the length
+  // parameters.
+  return fir::factory::componentToExtendedValue(builder, loc, element);
+}
+
 mlir::TupleType
 fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {
   mlir::IntegerType i64Ty = builder.getIntegerType(64);
   auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1);
   auto buffTy = fir::HeapType::get(arrTy);
   auto extTy = fir::SequenceType::get(i64Ty, 1);
   auto shTy = fir::HeapType::get(extTy);
   return mlir::TupleType::get(builder.getContext(), {i64Ty, buffTy, shTy});

flang/test/Lower/assignment.f90

 ! CHECK-LABEL: func @_QPcomplex_constant()
 ! CHECK:         %[[A:.*]] = fir.alloca !fir.complex<4> {bindc_name = "a", uniq_name = "_QFcomplex_constantEa"}
 ! CHECK:         %[[C0:.*]] = arith.constant 0.000000e+00 : f32
 ! CHECK:         %[[C1:.*]] = arith.constant 1.000000e+00 : f32
 ! CHECK:         %[[UNDEF:.*]] = fir.undefined !fir.complex<4>
 ! CHECK:         %[[INS0:.*]] = fir.insert_value %[[UNDEF]], %[[C0]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
 ! CHECK:         %[[INS1:.*]] = fir.insert_value %[[INS0]], %[[C1]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
 ! CHECK:         fir.store %[[INS1]] to %[[A]] : !fir.ref<!fir.complex<4>>
+
+subroutine sub1_arr(a)
+  integer :: a(10)
+  a(2) = 10
+end
+
+! CHECK-LABEL: func @_QPsub1_arr(
+! CHECK-SAME:    %[[A:.*]]: !fir.ref<!fir.array<10xi32>> {fir.bindc_name = "a"})
+! CHECK-DAG:     %[[C10:.*]] = arith.constant 10 : i32
+! CHECK-DAG:     %[[C2:.*]] = arith.constant 2 : i64
+! CHECK-DAG:     %[[C1:.*]] = arith.constant 1 : i64
+! CHECK:         %[[ZERO_BASED_INDEX:.*]] = arith.subi %[[C2]], %[[C1]] : i64
+! CHECK:         %[[COORD:.*]] = fir.coordinate_of %[[A]], %[[ZERO_BASED_INDEX]] : (!fir.ref<!fir.array<10xi32>>, i64) -> !fir.ref<i32>
+! CHECK:         fir.store %[[C10]] to %[[COORD]] : !fir.ref<i32>
+! CHECK:         return
+
+subroutine sub2_arr(a)
+  integer :: a(10)
+  a = 10
+end
+
+! CHECK-LABEL: func @_QPsub2_arr(
+! CHECK-SAME:    %[[A:.*]]: !fir.ref<!fir.array<10xi32>> {fir.bindc_name = "a"})
+! CHECK-DAG:     %[[C10_0:.*]] = arith.constant 10 : index
+! CHECK:         %[[SHAPE:.*]] = fir.shape %[[C10_0]] : (index) -> !fir.shape<1>
+! CHECK:         %[[LOAD:.*]] = fir.array_load %[[A]](%[[SHAPE]]) : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>) -> !fir.array<10xi32>
+! CHECK-DAG:     %[[C10_1:.*]] = arith.constant 10 : i32
+! CHECK-DAG:     %[[C1:.*]] = arith.constant 1 : index
+! CHECK-DAG:     %[[C0:.*]] = arith.constant 0 : index
+! CHECK-DAG:     %[[UB:.*]] = arith.subi %[[C10_0]], %c1 : index
+! CHECK:         %[[DO_RES:.*]] = fir.do_loop %[[ARG1:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG2:.*]] = %[[LOAD]]) -> (!fir.array<10xi32>) {
+! CHECK:           %[[RES:.*]] = fir.array_update %[[ARG2]], %[[C10_1]], %[[ARG1]] : (!fir.array<10xi32>, i32, index) -> !fir.array<10xi32>
+! CHECK:           fir.result %[[RES]] : !fir.array<10xi32>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[LOAD]], %[[DO_RES]] to %[[A]] : !fir.array<10xi32>, !fir.array<10xi32>, !fir.ref<!fir.array<10xi32>>
+! CHECK:         return

flang/test/Lower/basic-function.f90

 
 function fct_iarr2()
   integer, dimension(10, 20) :: fct_iarr2
 end
 
 ! CHECK-LABEL: func @_QPfct_iarr2() -> !fir.array<10x20xi32>
 ! CHECK:         return %{{.*}} : !fir.array<10x20xi32>
 
-function fct_iarr3()
-  integer, dimension(:, :), allocatable :: fct_iarr3
-end
-
-! CHECK-LABEL: func @_QPfct_iarr3() -> !fir.box<!fir.heap<!fir.array<?x?xi32>>>
-! CHECK:        return %{{.*}} : !fir.box<!fir.heap<!fir.array<?x?xi32>>>
-
-function fct_iarr4()
-  integer, dimension(:), pointer :: fct_iarr4
-end
-
-! CHECK-LABEL: func @_QPfct_iarr4() -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
-! CHECK:         return %{{.*}} : !fir.box<!fir.ptr<!fir.array<?xi32>>>
-
 logical(1) function lfct1()
 end
 ! CHECK-LABEL: func @_QPlfct1() -> !fir.logical<1>
 ! CHECK:         return %{{.*}} : !fir.logical<1>
 
 logical(2) function lfct2()
 end
 ! CHECK-LABEL: func @_QPlfct2() -> !fir.logical<2>