Upstream support for POINTER assignment in FORALL.

Reviewed By: vdonaldson, PeteSteinfeld

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

Author: schweitzpgi

flang/include/flang/Lower/AbstractConverter.h

@@ -103,37 +103,51 @@ class AbstractConverter {
   // Expressions
   //===--------------------------------------------------------------------===//
 
-  /// Generate the address of the location holding the expression, someExpr.
-  virtual fir::ExtendedValue genExprAddr(const SomeExpr &, StatementContext &,
+  /// Generate the address of the location holding the expression, \p expr.
+  /// If \p expr is a Designator that is not compile time contiguous, the
+  /// address returned is the one of a contiguous temporary storage holding the
+  /// expression value. The clean-up for this temporary is added to \p context.
+  virtual fir::ExtendedValue genExprAddr(const SomeExpr &expr,
+                                         StatementContext &context,
                                          mlir::Location *loc = nullptr) = 0;
-  /// Generate the address of the location holding the expression, someExpr
-  fir::ExtendedValue genExprAddr(const SomeExpr *someExpr,
-                                 StatementContext &stmtCtx,
-                                 mlir::Location loc) {
-    return genExprAddr(*someExpr, stmtCtx, &loc);
+
+  /// Generate the address of the location holding the expression, \p expr.
+  fir::ExtendedValue genExprAddr(mlir::Location loc, const SomeExpr *expr,
+                                 StatementContext &stmtCtx) {
+    return genExprAddr(*expr, stmtCtx, &loc);
+  }
+  fir::ExtendedValue genExprAddr(mlir::Location loc, const SomeExpr &expr,
+                                 StatementContext &stmtCtx) {
+    return genExprAddr(expr, stmtCtx, &loc);
   }
 
-  /// Generate the computations of the expression to produce a value
-  virtual fir::ExtendedValue genExprValue(const SomeExpr &, StatementContext &,
+  /// Generate the computations of the expression to produce a value.
+  virtual fir::ExtendedValue genExprValue(const SomeExpr &expr,
+                                          StatementContext &context,
                                           mlir::Location *loc = nullptr) = 0;
-  /// Generate the computations of the expression, someExpr, to produce a value
-  fir::ExtendedValue genExprValue(const SomeExpr *someExpr,
-                                  StatementContext &stmtCtx,
-                                  mlir::Location loc) {
-    return genExprValue(*someExpr, stmtCtx, &loc);
+
+  /// Generate the computations of the expression, \p expr, to produce a value.
+  fir::ExtendedValue genExprValue(mlir::Location loc, const SomeExpr *expr,
+                                  StatementContext &stmtCtx) {
+    return genExprValue(*expr, stmtCtx, &loc);
+  }
+  fir::ExtendedValue genExprValue(mlir::Location loc, const SomeExpr &expr,
+                                  StatementContext &stmtCtx) {
+    return genExprValue(expr, stmtCtx, &loc);
   }
 
   /// Generate or get a fir.box describing the expression. If SomeExpr is
   /// a Designator, the fir.box describes an entity over the Designator base
   /// storage without making a temporary.
-  virtual fir::ExtendedValue genExprBox(const SomeExpr &, StatementContext &,
-                                        mlir::Location) = 0;
+  virtual fir::ExtendedValue genExprBox(mlir::Location loc,
+                                        const SomeExpr &expr,
+                                        StatementContext &stmtCtx) = 0;
 
   /// Generate the address of the box describing the variable designated
   /// by the expression. The expression must be an allocatable or pointer
   /// designator.
   virtual fir::MutableBoxValue genExprMutableBox(mlir::Location loc,
-                                                 const SomeExpr &) = 0;
+                                                 const SomeExpr &expr) = 0;
 
   /// Get FoldingContext that is required for some expression
   /// analysis.

flang/include/flang/Lower/Allocatable.h

@@ -13,6 +13,7 @@
 #ifndef FORTRAN_LOWER_ALLOCATABLE_H
 #define FORTRAN_LOWER_ALLOCATABLE_H
 
+#include "flang/Lower/AbstractConverter.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "llvm/ADT/StringRef.h"
 
@@ -23,55 +24,55 @@ class Location;
 } // namespace mlir
 
 namespace fir {
-class MutableBoxValue;
-}
+class FirOpBuilder;
+} // namespace fir
 
-namespace Fortran::parser {
+namespace Fortran {
+namespace parser {
 struct AllocateStmt;
 struct DeallocateStmt;
-} // namespace Fortran::parser
+} // namespace parser
 
-namespace Fortran::evaluate {
-template <typename T>
-class Expr;
-struct SomeType;
-} // namespace Fortran::evaluate
+namespace lower {
+struct SymbolBox;
 
-namespace Fortran::lower {
-class AbstractConverter;
 class StatementContext;
 
-namespace pft {
-struct Variable;
-}
+bool isArraySectionWithoutVectorSubscript(const SomeExpr &expr);
 
 /// Lower an allocate statement to fir.
-void genAllocateStmt(Fortran::lower::AbstractConverter &,
-                     const Fortran::parser::AllocateStmt &, mlir::Location);
+void genAllocateStmt(AbstractConverter &converter,
+                     const parser::AllocateStmt &stmt, mlir::Location loc);
 
 /// Lower a deallocate statement to fir.
-void genDeallocateStmt(Fortran::lower::AbstractConverter &,
-                       const Fortran::parser::DeallocateStmt &, mlir::Location);
+void genDeallocateStmt(AbstractConverter &converter,
+                       const parser::DeallocateStmt &stmt, mlir::Location loc);
 
 /// Create a MutableBoxValue for an allocatable or pointer entity.
 /// If the variables is a local variable that is not a dummy, it will be
 /// initialized to unallocated/diassociated status.
-fir::MutableBoxValue createMutableBox(Fortran::lower::AbstractConverter &,
-                                      mlir::Location,
-                                      const Fortran::lower::pft::Variable &var,
+fir::MutableBoxValue createMutableBox(AbstractConverter &converter,
+                                      mlir::Location loc,
+                                      const pft::Variable &var,
                                       mlir::Value boxAddr,
                                       mlir::ValueRange nonDeferredParams);
 
-/// Update a MutableBoxValue to describe the entity designated by the expression
-/// \p source. This version takes care of \p source lowering.
-/// If \lbounds is not empty, it is used to defined the MutableBoxValue
-/// lower bounds, otherwise, the lower bounds from \p source are used.
-void associateMutableBox(
-    Fortran::lower::AbstractConverter &, mlir::Location,
-    const fir::MutableBoxValue &,
-    const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &source,
-    mlir::ValueRange lbounds, Fortran::lower::StatementContext &);
-
-} // namespace Fortran::lower
+/// Assign a boxed value to a boxed variable, \p box (known as a
+/// MutableBoxValue). Expression \p source will be lowered to build the
+/// assignment. If \p lbounds is not empty, it is used to define the result's
+/// lower bounds. Otherwise, the lower bounds from \p source will be used.
+void associateMutableBox(AbstractConverter &converter, mlir::Location loc,
+                         const fir::MutableBoxValue &box,
+                         const SomeExpr &source, mlir::ValueRange lbounds,
+                         StatementContext &stmtCtx);
+
+/// Is \p expr a reference to an entity with the ALLOCATABLE attribute?
+bool isWholeAllocatable(const SomeExpr &expr);
+
+/// Is \p expr a reference to an entity with the POINTER attribute?
+bool isWholePointer(const SomeExpr &expr);
+
+} // namespace lower
+} // namespace Fortran
 
 #endif // FORTRAN_LOWER_ALLOCATABLE_H

flang/include/flang/Lower/ComponentPath.h

@@ -27,8 +27,7 @@ class ImplicitSubscripts {};
 
 using PathComponent =
     std::variant<const evaluate::ArrayRef *, const evaluate::Component *,
-                 const Fortran::evaluate::ComplexPart *,
-                 details::ImplicitSubscripts>;
+                 const evaluate::ComplexPart *, details::ImplicitSubscripts>;
 
 /// Collection of components.
 ///
@@ -37,17 +36,24 @@ using PathComponent =
 /// arguments.
 class ComponentPath {
 public:
+  using ExtendRefFunc = std::function<mlir::Value(const mlir::Value &)>;
+
   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(); }
+  bool isSlice() const { return !trips.empty() || hasComponents(); }
+  bool hasComponents() const { return !suffixComponents.empty(); }
   void clear();
 
+  bool hasExtendCoorRef() const { return extendCoorRef.hasValue(); }
+  ExtendRefFunc getExtendCoorRef() const;
+  void resetExtendCoorRef() { extendCoorRef = llvm::None; }
+  void resetPC();
+
   llvm::SmallVector<PathComponent> reversePath;
   const evaluate::Substring *substring = nullptr;
   bool applied = false;
@@ -57,6 +63,13 @@ class ComponentPath {
   llvm::SmallVector<mlir::Value> suffixComponents;
   std::function<IterationSpace(const IterationSpace &)> pc;
 
+  /// In the case where a path of components involves members that are POINTER
+  /// or ALLOCATABLE, a dereference is required in FIR for semantic correctness.
+  /// This optional continuation allows the generation of those dereferences.
+  /// These accesses are always on Fortran entities of record types, which are
+  /// implicitly in-memory objects.
+  llvm::Optional<ExtendRefFunc> extendCoorRef = llvm::None;
+
 private:
   void setPC(bool isImplicit);
 };

flang/include/flang/Lower/ConvertExpr.h

@@ -164,22 +164,6 @@ void createAnyMaskedArrayAssignment(AbstractConverter &converter,
                                     ImplicitIterSpace &implicitIterSpace,
                                     SymMap &symMap, StatementContext &stmtCtx);
 
-/// In the context of a FORALL, a pointer assignment is allowed. The pointer
-/// assignment can be elementwise on an array of pointers. The bounds
-/// expressions as well as the component path may contain references to the
-/// concurrent control variables. The explicit iteration space must be defined.
-void createAnyArrayPointerAssignment(
-    AbstractConverter &converter, const SomeExpr &lhs, const SomeExpr &rhs,
-    const evaluate::Assignment::BoundsSpec &bounds,
-    ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
-    SymMap &symMap);
-/// Support the bounds remapping flavor of pointer assignment.
-void createAnyArrayPointerAssignment(
-    AbstractConverter &converter, const SomeExpr &lhs, const SomeExpr &rhs,
-    const evaluate::Assignment::BoundsRemapping &bounds,
-    ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
-    SymMap &symMap);
-
 /// 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.
@@ -190,6 +174,17 @@ void createAllocatableArrayAssignment(AbstractConverter &converter,
                                       SymMap &symMap,
                                       StatementContext &stmtCtx);
 
+/// Lower a pointer assignment in an explicit iteration space. The explicit
+/// space iterates over a data structure with a type of `!fir.array<...
+/// !fir.box<!fir.ptr<T>> ...>`. Lower the assignment by copying the rhs box
+/// value to each array element.
+void createArrayOfPointerAssignment(
+    AbstractConverter &converter, const SomeExpr &lhs, const SomeExpr &rhs,
+    ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
+    const llvm::SmallVector<mlir::Value> &lbounds,
+    llvm::Optional<llvm::SmallVector<mlir::Value>> ubounds, SymMap &symMap,
+    StatementContext &stmtCtx);
+
 /// Lower an array expression with "parallel" semantics. Such a rhs expression
 /// is fully evaluated prior to being assigned back to a temporary array.
 fir::ExtendedValue createSomeArrayTempValue(AbstractConverter &converter,

flang/include/flang/Lower/Support/Utils.h

@@ -79,4 +79,17 @@ ignoreEvConvert(const Fortran::evaluate::Expr<Fortran::evaluate::Type<
   return std::visit([](const auto &v) { return ignoreEvConvert(v); }, x.u);
 }
 
+/// Zip two containers of the same size together and flatten the pairs. `flatZip
+/// [1;2] [3;4]` yields `[1;3;2;4]`.
+template <typename A>
+A flatZip(const A &container1, const A &container2) {
+  assert(container1.size() == container2.size());
+  A result;
+  for (auto [e1, e2] : llvm::zip(container1, container2)) {
+    result.emplace_back(e1);
+    result.emplace_back(e2);
+  }
+  return result;
+}
+
 #endif // FORTRAN_LOWER_SUPPORT_UTILS_H