[flang-commits] [flang] [flang][OpenACC] Reland data-clause designator path handling (PR #220781)

[Eugene Epshteyn via flang-commits]

================
@@ -0,0 +1,496 @@
+//===-- lib/Evaluate/designator-path.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/Evaluate/designator-path.h"
+#include "flang/Common/idioms.h"
+#include "flang/Evaluate/fold.h"
+#include "flang/Evaluate/tools.h"
+#include "flang/Semantics/symbol.h"
+#include <cstdint>
+
+namespace Fortran::evaluate {
+
+namespace {
+// The values selected by a subscript with constant bounds and stride, as the
+// ascending arithmetic progression first, first + stride, ..., last.
+struct ConstantSection {
+  std::int64_t first;
+  std::int64_t last;
+  std::int64_t stride;
+};
+
+struct ConstantSubscriptRange {
+  std::int64_t lower;
+  std::int64_t upper;
+};
+} // namespace
+
+static DesignatorRelation ComparePartSymbols(const Symbol *x, const Symbol *y) {
+  if (x == y) {
+    return DesignatorRelation::Equal;
+  }
+  if (!x) {
+    return DesignatorRelation::Contains;
+  }
+  if (!y) {
+    return DesignatorRelation::ContainedBy;
+  }
+  return DesignatorRelation::Disjoint;
+}
+
+static bool IsFullTriplet(const Triplet &triplet) {
+  // Surface syntax `x(:)` maps to a Triplet with no lower or upper bound and
+  // an implicit stride of one.
+  auto stride{ToInt64(triplet.GetStride())};
+  return !triplet.GetLower() && !triplet.GetUpper() && stride && *stride == 1;
+}
+
+static bool IsFullSubscriptList(const std::vector<Subscript> &subscripts) {
+  if (subscripts.empty()) {
+    return false;
+  }
+  for (const Subscript &subscript : subscripts) {
+    const auto *triplet{std::get_if<Triplet>(&subscript.u)};
+    if (!triplet || !IsFullTriplet(*triplet)) {
+      return false;
+    }
+  }
+  return true;
+}
+
+static bool IsFullSlicePart(const DesignatorPath::Part &part) {
+  return !part.symbol && IsFullSubscriptList(part.subscripts);
+}
+
+static bool AreAllFullSliceParts(
+    const std::vector<DesignatorPath::Part> &parts, std::size_t first) {
+  for (std::size_t i{first}; i < parts.size(); ++i) {
+    if (!IsFullSlicePart(parts[i])) {
+      return false;
+    }
+  }
+  return true;
+}
+
+static std::optional<ConstantSubscriptRange> GetConstantSubscriptRange(
+    const Subscript &subscript) {
+  // Surface syntax `x(i)` maps to a scalar Subscript that holds the integer
+  // expression `i`, not a Triplet.
+  if (const auto *expr{
+          std::get_if<IndirectSubscriptIntegerExpr>(&subscript.u)}) {
+    if (auto value{ToInt64(expr->value())}) {
+      return ConstantSubscriptRange{*value, *value};
+    }
+  } else if (const auto *triplet{std::get_if<Triplet>(&subscript.u)}) {
+    // Surface syntax `x(l:u)` maps to a Triplet with explicit lower and upper
+    // bounds and an implicit stride of one. Syntax like `x(:u)`, `x(l:)`, and
+    // `x(:)` maps to missing lower and/or upper bounds, so it is not a
+    // constant finite range here.
+    const auto *lowerExpr{triplet->GetLower()};
+    const auto *upperExpr{triplet->GetUpper()};
+    auto lower{lowerExpr ? ToInt64(*lowerExpr) : std::nullopt};
+    auto upper{upperExpr ? ToInt64(*upperExpr) : std::nullopt};
+    // Surface syntax `x(l:u:s)` maps to the same Triplet representation with a
+    // non-optional stride expression.
+    auto stride{ToInt64(triplet->GetStride())};
+    if (lower && upper && stride && *stride == 1) {
+      return ConstantSubscriptRange{*lower, *upper};
+    }
+  }
+  return std::nullopt;
+}
+
+// Like GetConstantSubscriptRange, but accepts any nonzero constant stride.
+// Returns nothing for a selection with a nonconstant or missing bound or
+// stride, and for an empty section.
+static std::optional<ConstantSection> GetConstantSection(
+    const Subscript &subscript) {
+  if (const auto *expr{
+          std::get_if<IndirectSubscriptIntegerExpr>(&subscript.u)}) {
+    if (auto value{ToInt64(expr->value())}) {
+      return ConstantSection{*value, *value, 1};
+    }
+    return std::nullopt;
+  }
+  const auto *triplet{std::get_if<Triplet>(&subscript.u)};
+  if (!triplet || !triplet->GetLower() || !triplet->GetUpper()) {
+    return std::nullopt;
+  }
+  auto lower{ToInt64(*triplet->GetLower())};
+  auto upper{ToInt64(*triplet->GetUpper())};
+  auto stride{ToInt64(triplet->GetStride())};
+  if (!lower || !upper || !stride || *stride == 0) {
+    return std::nullopt;
+  }
+  if (*stride > 0) {
+    if (*lower > *upper) {
+      return std::nullopt;
+    }
+    std::int64_t count{(*upper - *lower) / *stride};
+    return ConstantSection{*lower, *lower + count * *stride, *stride};
+  }
+  if (*lower < *upper) {
+    return std::nullopt;
+  }
+  std::int64_t count{(*lower - *upper) / -*stride};
+  return ConstantSection{*lower + count * *stride, *lower, -*stride};
+}
+
+// Every value of y is a value of x. The values of y are an arithmetic
+// progression, so they lie in x exactly when the ends do and, if y has more
+// than one value, the step of y is a multiple of the step of x.
+static bool SectionContains(
+    const ConstantSection &x, const ConstantSection &y) {
+  auto inX{[&](std::int64_t value) {
+    return value >= x.first && value <= x.last &&
+        (value - x.first) % x.stride == 0;
+  }};
+  return inX(y.first) && inX(y.last) &&
+      (y.first == y.last || y.stride % x.stride == 0);
+}
+
+static DesignatorRelation CompareSubscripts(
+    const Subscript &x, const Subscript &y) {
+  if (x == y) {
+    return DesignatorRelation::Equal;
+  }
+  const auto *xTriplet{std::get_if<Triplet>(&x.u)};
+  const auto *yTriplet{std::get_if<Triplet>(&y.u)};
+  if (xTriplet && IsFullTriplet(*xTriplet)) {
+    if (yTriplet && IsFullTriplet(*yTriplet)) {
+      return DesignatorRelation::Equal;
+    }
+    return DesignatorRelation::Contains;
+  }
+  if (yTriplet && IsFullTriplet(*yTriplet)) {
+    return DesignatorRelation::ContainedBy;
+  }
+  auto xRange{GetConstantSubscriptRange(x)};
+  auto yRange{GetConstantSubscriptRange(y)};
+  if (!xRange || !yRange) {
+    // Nonconstant selectors and constant triplets with non-unit strides cannot
+    // be compared precisely, so report them as Disjoint for now. Callers must
+    // not read that as proof that the selections do not overlap. Constant
+    // triplets could be made more precise by expanding them into index sets.
+    return DesignatorRelation::Disjoint;
+  }
+  if (xRange->upper < yRange->lower || yRange->upper < xRange->lower) {
+    return DesignatorRelation::Disjoint;
+  }
+  if (xRange->lower == yRange->lower && xRange->upper == yRange->upper) {
+    return DesignatorRelation::Equal;
+  }
+  if (xRange->lower <= yRange->lower && xRange->upper >= yRange->upper) {
+    return DesignatorRelation::Contains;
+  }
+  if (yRange->lower <= xRange->lower && yRange->upper >= xRange->upper) {
+    return DesignatorRelation::ContainedBy;
+  }
+  return DesignatorRelation::Overlaps;
+}
+
+static bool SubscriptMayContain(const Subscript &x, const Subscript &y) {
+  if (x == y) {
+    return true;
+  }
+  const auto *xTriplet{std::get_if<Triplet>(&x.u)};
+  const auto *yTriplet{std::get_if<Triplet>(&y.u)};
+  if (xTriplet && IsFullTriplet(*xTriplet)) {
+    return true;
+  }
+  if (yTriplet && IsFullTriplet(*yTriplet)) {
+    return false;
+  }
+  // Decide exactly whenever both selections are constant, including a scalar
+  // against a one-element triplet and any constant stride.
+  auto xSection{GetConstantSection(x)};
+  auto ySection{GetConstantSection(y)};
+  if (xSection && ySection) {
+    return SectionContains(*xSection, *ySection);
+  }
----------------
eugeneepshteyn wrote:

(This comment was generated with the help of AI)

Returning nothing for a known-empty section makes `SubscriptMayContain` optimistic about it, so a clause that covers no elements now satisfies DEFAULT(NONE). This was rejected before this revision and is accepted now:

```fortran
subroutine s(a)
  real :: a(10)
  !$acc parallel default(none) copy(a(5:1))
  a(3) = 1.0
  !$acc end parallel
end subroutine
```

`copy(a(5:1))` covers nothing, so the reference to `a(3)` should still require a listing. Distinguishing known-empty (covers nothing) from cannot-decide (stay optimistic) restores the diagnostic; accepting an empty *reference* remains fine.

https://github.com/llvm/llvm-project/pull/220781