[flang-commits] [flang] [flang] Enumeration Type: (PR 4/5) Lowering (PR #193571)

[Eugene Epshteyn via flang-commits]

================
@@ -2884,6 +2887,135 @@ class ElementalIntrinsicCallBuilder
   fir::IntrinsicHandlerEntry intrinsicEntry;
   const bool isFunction;
 };
+
+// Compute the NEXT (min(ordinal+1, count)) or PREVIOUS (max(ordinal-1, 1))
+// ordinal, and an i1 telling whether ordinal was at the last/first enumerator.
+static std::pair<mlir::Value, mlir::Value>
+genEnumOrdinalStep(fir::FirOpBuilder &builder, mlir::Location loc,
+                   mlir::Value ordinal, mlir::Type resType, int count,
+                   bool isNext) {
+  mlir::Value one = builder.createIntegerConstant(loc, resType, 1);
+  if (isNext) {
+    mlir::Value maxVal = builder.createIntegerConstant(loc, resType, count);
+    mlir::Value incremented =
+        mlir::arith::AddIOp::create(builder, loc, ordinal, one);
+    mlir::Value cmp = mlir::arith::CmpIOp::create(
+        builder, loc, mlir::arith::CmpIPredicate::sle, incremented, maxVal);
+    mlir::Value result =
+        mlir::arith::SelectOp::create(builder, loc, cmp, incremented, maxVal);
+    mlir::Value atBoundary = mlir::arith::CmpIOp::create(
+        builder, loc, mlir::arith::CmpIPredicate::eq, ordinal, maxVal);
+    return {result, atBoundary};
+  }
+  mlir::Value decremented =
+      mlir::arith::SubIOp::create(builder, loc, ordinal, one);
+  mlir::Value cmp = mlir::arith::CmpIOp::create(
+      builder, loc, mlir::arith::CmpIPredicate::sge, decremented, one);
+  mlir::Value result =
+      mlir::arith::SelectOp::create(builder, loc, cmp, decremented, one);
+  mlir::Value atBoundary = mlir::arith::CmpIOp::create(
+      builder, loc, mlir::arith::CmpIPredicate::eq, ordinal, one);
+  return {result, atBoundary};
+}
+
+// NEXT/PREVIOUS of an F2023 enumeration type. As elemental intrinsics they are
+// pure; only a present STAT (elemental INTENT(OUT)) forces element order.
+// NOTE: STAT is listed as "scalar", but also as INTENT(OUT) and is in an
+// elemental function.  Taking them together, this means that, by
+// F2023 15.9.1 ¶4, it should be a conforming argument to A.
+class EnumerationStepCallBuilder
+    : public ElementalCallBuilder<EnumerationStepCallBuilder> {
+public:
+  EnumerationStepCallBuilder(int count, bool isNext)
+      : count{count}, isNext{isNext} {}
+
+  std::optional<hlfir::Entity>
+  genElementalKernel(Fortran::lower::PreparedActualArguments &loweredActuals,
+                     CallContext &callContext) {
+    mlir::Location loc = callContext.loc;
+    fir::FirOpBuilder &builder = callContext.getBuilder();
+    hlfir::Entity arg = loweredActuals[0]->getActual(loc, builder);
+    std::optional<hlfir::AssociateOp> associate;
+    if (!arg.isVariable()) {
+      associate = hlfir::genAssociateExpr(loc, builder, arg, arg.getType(),
+                                          ".enum.arg");
+      arg = hlfir::Entity{associate->getBase()};
+    }
+    mlir::Value ordinal = hlfir::loadTrivialScalar(
+        loc, builder,
+        Fortran::lower::genEnumerationOrdinalDesignator(loc, builder, arg));
+    if (associate)
+      hlfir::EndAssociateOp::create(builder, loc, *associate);
+    std::pair<mlir::Value, mlir::Value> step = genEnumOrdinalStep(
+        builder, loc, ordinal, ordinal.getType(), count, isNext);
+    mlir::Value result = step.first;
+    mlir::Value atBoundary = step.second;
+    auto genBoundaryFatal = [&]() {
+      builder.genIfThen(loc, atBoundary)
+          .genThen([&]() {
+            fir::runtime::genReportFatalUserError(
+                builder, loc,
+                "NEXT or PREVIOUS of enumeration type at boundary without "
+                "STAT=");
+          })
+          .end();
+    };
+    std::optional<Fortran::lower::PreparedActualArgument> &stat =
+        loweredActuals[1];
+    if (!stat) {
+      genBoundaryFatal();
+    } else {
+      auto genStatAssign = [&]() {
+        hlfir::Entity statVar = stat->getActual(loc, builder);
+        mlir::Type statType = statVar.getFortranElementType();
+        mlir::Value statValue = mlir::arith::SelectOp::create(
+            builder, loc, atBoundary,
+            builder.createIntegerConstant(
+                loc, statType, 112 /* FORTRAN_RUNTIME_STAT_ENUM_BOUNDARY */),
+            builder.createIntegerConstant(loc, statType, 0));
+        hlfir::AssignOp::create(builder, loc, statValue, statVar);
----------------
eugeneepshteyn wrote:

(This comment was generated with the help of AI)

Confirmed on an independent build, and it breaks in both directions.

The mirror case — a body statement that *precedes* the `NEXT` and must therefore see the pre-`FORALL` values — reads what the later statement wrote:

```fortran
program test
  enumeration type :: color
    enumerator :: red, green, blue
  end enumeration type
  type(color) :: a(3), n(3)
  integer :: st(3), t(3), i
  a = [red, green, blue]
  st = -1
  forall (i = 1:3)
    t(i) = st(4-i)                 ! must see the pre-FORALL -1
    n(i) = next(a(i), stat=st(i))
  end forall
  print *, t                       ! -O0: -1 -1 -1   -O2: -1 -1 0
end program
```

Both of these programs are correct at `-O0` and wrong at `-O2`. I did not probe the `-O0` STAT-based mask recomputation you mention; that looks like a separate shape.

The premise that breaks is in `ScheduleOrderedAssignments.cpp`:

```c++
const bool leafRegionsMayOnlyRead =
    mlir::isa<hlfir::ForallOp>(root.getOperation());
```

For a `FORALL` root this is an unconditional commitment that leaf-region write effects can be ignored when scheduling — the comment directly above it says as much. `NEXT`/`PREVIOUS` with `STAT=` are the first standard elemental intrinsic *functions* that define an argument, so they are the first thing to break that commitment; assignment fusion above `-O0` then merges the two body statements, against F2023 10.2.4.2.4 p1.

Since the scheduler predates this PR and this PR does not touch it, it may be cleaner to correct the scheduling premise in a separate prerequisite change, with its own FIR scheduling test, and keep this PR to the lowering.


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