Fold constant chains within a sweep instead of one fixpoint round per layer (#361)

Unisay · web-flow · commit e96fa34dcc3a · 2026-07-30T13:36:52.000+02:00
* test(ir): pin the constant-chain fold against per-round layering (#328) A chain of let-bound constructors nested one in another -- the shape a folded monadic bind chain reaches -- collapses one layer per bottom-up sweep, so the whole chain needs as many optimize+dce rounds as it has layers. This pins the intended behaviour instead: eight nested layers fold to their final constant in a single optimizedExpression sweep. Red at this commit: the sweep folds the innermost layer only, leaving Let ($field0 = 0) (Just 1) where the enclosing layer's fold wants a bare constructor. * feat(optimizer): drop unread let bindings in the sweep that folds them (#328) Every fold that eliminates a let-bound constructor leaves the payload behind in a spent field-binder Let that nothing reads: propagating the constructor binds each read field to a fresh $field binder, the trivial ones then paste into their reads, and the binding is left unreferenced. Only the separate dce pass dropped that residue, one pass later in the round -- and until it did, the enclosing layer's right-hand side was a Let rather than the constructor it wraps, so the fold there declined and a chain advanced by exactly one layer per whole-module round. Dropping an unread binding is now a rewrite too (removeUnusedLetBindings), on the licence dce already took: an effect run stays because dropping it would discard the effect, anything else is evaluated for a value nothing wants. Bindings are decided right to left, so one kept alive only by a binding itself dropped goes with it, and sequential scoping puts a binder in scope for the groupings after it and the body, never the ones before. Recursive groups are left to dce, which can see a dead group as a whole. Convergence no longer scales with chain depth: Golden.LongBindFlipped's specialize+dce fixpoint goes from 301 rounds to 3, the same count the three-deep Golden.MaybeChain takes, and the deepest fixpoint over all 348 goldens takes 4. maxFixpointIterations therefore returns to 100, close enough to real work that a pass which over-reports changes is caught in 100 sweeps rather than 1000. Compiling Golden.LongApplyChain drops from 42.6s to 1.2s, Golden.LongBindFlipped from 8.2s to 1.2s, and the golden suite from 81.9s to 30.2s. 346 of the 348 goldens are byte-identical. Golden.LongWriterBind moves, and in the direction the collapse intends: its 200-deep Writer chain compiled to a nest of closures over tell/discard plus the Data.Identity dictionary tables, and now compiles to straight-line code -- the result's first component is the literal 42, the log a flat concatArray spine, the dictionaries gone, 847 lines of Lua down to 234. Its eval oracle (42) is unchanged, so the collapse is semantics-preserving where it is checked by execution.
diff --git a/changelog.d/20260728_120000_unisay_default_directive_pack.md b/changelog.d/20260728_120000_unisay_default_directive_pack.md
@@ -17,7 +17,3 @@
 - Directive targets may now contain `_` and `'`, matching PureScript
   identifier syntax (previously `Effect.Ref.modify_` or a primed name could
   not be named by any pragma or directives file).
-- The optimizer fixpoint iteration backstop is raised from 100 to 1000
-  rounds: directive-driven inlining folds a constant chain one layer per
-  round, so legitimate iteration counts scale with the deepest such chain
-  in the module (the ~300-deep golden stress chains need several hundred).
diff --git a/changelog.d/20260730_120000_unisay_fold_chains_within_sweep.md b/changelog.d/20260730_120000_unisay_fold_chains_within_sweep.md
@@ -0,0 +1,40 @@
+### Changed
+
+- The IR optimizer no longer needs one whole-module sweep per layer of a
+  constant chain, so compile time stops scaling with the depth of the deepest
+  such chain (#328). Every fold that eliminates a let-bound constructor leaves
+  the payload behind in a spent field-binder — a `Let` nothing reads any more:
+
+  ```
+  let v = Just 2 in                     ->   let $field = 2 in
+    if justTag == reflectCtor v              Just 3
+      then Just (arg0 v + 1) else Nothing
+  ```
+
+  Only the separate dead-code-elimination pass dropped that residue, one pass
+  later in the round. Until it did, the enclosing layer's right-hand side was a
+  `Let` rather than the `Just 3` it wraps, so the fold there declined and the
+  chain advanced by exactly one layer per round. Dropping an unread binding is
+  now also a rewrite (`removeUnusedLetBindings`), on the licence dead-code
+  elimination already used — an effect run stays, anything else is evaluated
+  for a value nothing wants — so the whole cascade completes inside one sweep.
+
+  A ~300-deep chain now converges in as many rounds as a three-deep one:
+  `Golden.LongBindFlipped`'s `specialize+dce` fixpoint goes from 301 rounds to
+  3, and the deepest fixpoint over the whole golden corpus takes 4. Compiling
+  `Golden.LongApplyChain` drops from 42.6s to 1.2s, `Golden.LongBindFlipped`
+  from 8.2s to 1.2s, and the golden suite as a whole from 81.9s to 30.2s.
+
+- The optimizer fixpoint iteration backstop (`maxFixpointIterations`) is 100
+  rounds. Legitimate convergence no longer scales with chain depth, so the
+  bound can sit close to real work (4 rounds at the corpus maximum) and a pass
+  that over-reports changes or genuinely loops is caught after 100 sweeps
+  rather than 1000.
+
+- Collapsing the chains within the sweep unblocks a fold the growth veto used
+  to stall: `Golden.LongWriterBind` compiled a 200-deep `Writer` chain into a
+  nest of closures over `tell`/`discard` plus the `Data.Identity` dictionary
+  tables, and now compiles to straight-line code — the result's first component
+  is the literal `42`, the log a flat `concatArray` spine, and the dictionaries
+  are gone (847 lines of Lua down to 234). The module's execution output is
+  unchanged.
diff --git a/lib/Language/PureScript/Backend/IR/Optimizer.hs b/lib/Language/PureScript/Backend/IR/Optimizer.hs
@@ -1457,6 +1457,7 @@ optimizedExpressionWithPastes ctorTags canon pastes policy env =
         `thenRewrite` pushIfCondIntoBranches
         `thenRewrite` pushEliminatorIntoIfBranches
         `thenRewrite` inlineLocalBindings
+        `thenRewrite` removeUnusedLetBindings
     )
 
 {- | Tier 2 of Note [Canonical Effect/ST heads]: rewrite an Effect/ST
@@ -3424,6 +3425,64 @@ inlineLocalBinding rhsRefCounts grouping (body, inlined) =
       occurrences ∷ Natural
       occurrences = usageTotal usage
 
+{- | Drop the 'Standalone' bindings of a Let that nothing reads any more.
+
+Dead local bindings are the residue of the folds around them: the
+constructor propagation of 'propagateKnownCtorThroughLet' binds each
+read field to a fresh field-binder, 'inlineLocalBindings' then pastes a
+trivial one into its reads, and a pruned branch takes its reads with it
+— each leaving a binding no reference names. Dropping them is dead-code
+elimination, which the @dce@ pass also does; doing it here as a rewrite
+is what lets a /cascade/ complete inside one sweep. A layer of a
+constant chain folds to its result wrapped in the spent field-binder
+Let, and the enclosing layer's right-hand side is then a Let rather
+than the constructor it wraps, so the fold there declines: while the
+residue survives to the end of the sweep, one whole-module round
+advances the chain by exactly one layer, and rounds scale with chain
+depth (issue #328).
+
+The licence to discard an unread binding's right-hand side is the one
+dead-code elimination already takes
+('Language.PureScript.Backend.IR.DCE.eliminateDeadCode'): an effect run
+stays, because dropping it would silently discard the effect
+('isEffectRun'), and anything else is evaluated for a value nothing
+wants. Bindings are decided right to left, so one that is kept alive
+only by a binding itself dropped goes with it; sequential scoping puts a
+binder in scope for the groupings after it and the body, never the ones
+before (Note [Sequential scoping of Let bindings]).
+
+Recursive groups are left alone. Their members reference each other, so
+a dead group is only recognisable as a whole, and the shapes that block
+a cascade bind values rather than recursive closures — the @dce@ pass
+collects a group nothing calls at the end of the round.
+-}
+removeUnusedLetBindings ∷ Applicative m ⇒ RewriteRuleM m Ann
+removeUnusedLetBindings =
+  pure . \case
+    Let ann groupings body
+      | let kept = snd (foldr keep (countFreeRefs body, []) groupings)
+      , length kept < length groupings →
+          Just case nonEmpty kept of
+            Nothing → body
+            Just keptNE → Let ann keptNE body
+    _ → Nothing
+ where
+  keep
+    ∷ Grouping (Ann, Name, Exp)
+    → (Map (Qualified Name) Natural, [Grouping (Ann, Name, Exp)])
+    → (Map (Qualified Name) Natural, [Grouping (Ann, Name, Exp)])
+  keep grouping (refs, kept) = case grouping of
+    Standalone (_ann, name, rhs)
+      | Local name `Map.notMember` refs
+      , not (isEffectRun rhs) →
+          (refs, kept)
+    _ →
+      ( Map.unionsWith
+          (+)
+          (refs : [countFreeRefs rhs | (_ann, _n, rhs) ← listGrouping grouping])
+      , grouping : kept
+      )
+
 {- Note [Complexity and Capture gate inlining]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Two small lattices refine the inlining heuristics beyond exact use
diff --git a/lib/Language/PureScript/Backend/IR/Pass.hs b/lib/Language/PureScript/Backend/IR/Pass.hs
@@ -162,17 +162,23 @@ renderPassCheckFailure = \case
       ["Optimized module contains dangling imported references:"]
         <> (show <$> toList violations)
 
-{- | Iteration backstop for 'RunFixpoint'. Convergence normally takes a
-handful of rounds, but directive-driven inlining folds a constant chain
-one layer per round, so legitimate rounds scale with the deepest such
-chain in the module (the ~300-deep golden stress chains need several
-hundred). Hitting the backstop anyway means a pass over-reports changes
-or genuinely loops — a bug, which the checked runner turns into a
+{- | Iteration backstop for 'RunFixpoint'. Legitimate rounds do not
+scale with the size or shape of the module: a rewrite cascade completes
+inside one sweep, so the deepest golden stress chains (~300 constant
+folds nested one in another) converge in as many rounds as a three-deep
+one. The whole golden corpus peaks at four, so this sits far clear of
+real work, and hitting it means a pass over-reports changes or genuinely
+loops — a bug, which the checked runner turns into a
 'FixpointDivergence' while the production runner accepts the (correct,
 possibly under-optimized) module reached.
+
+The bound is what keeps that bug cheap to find: each round is a sweep of
+the whole module, so a backstop generous enough to hide depth-scaled
+convergence would also make a loop burn hundreds of sweeps before
+reporting.
 -}
 maxFixpointIterations ∷ Natural
-maxFixpointIterations = 1000
+maxFixpointIterations = 100
 
 --------------------------------------------------------------------------------
 -- Runners ---------------------------------------------------------------------
diff --git a/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs b/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs
@@ -861,6 +861,30 @@ spec = describe "IR Optimizer" do
               )
       optimizedExpression original `shouldSatisfy` alphaEq expected
 
+    it "collapses a chain of nested let-bound constructors in one sweep" do
+      -- Folding one layer leaves the payload behind in a spent field-binder
+      -- Let: the binder's reads are folded and then inlined, so nothing
+      -- reads it any more, yet the Let node stands. The enclosing layer's
+      -- right-hand side is then that Let rather than the constructor it
+      -- wraps, so the fold declines there — and a chain of depth N advances
+      -- one layer per whole-module sweep instead of collapsing in this one.
+      let layer ∷ Int → Exp → Exp
+          layer i inner =
+            let v = Name ("v" <> show i)
+             in let1 v inner $
+                  ifThenElse
+                    (eq (literalString justTag) (reflectCtor (refLocal v)))
+                    ( just
+                        ( primBinOp
+                            PrimAdd
+                            (dataArgumentByIndex SumType 0 (refLocal v))
+                            (literalInt 1)
+                        )
+                    )
+                    nothingCtor
+      optimizedExpression (foldr layer (just (literalInt 0)) [1 .. 8])
+        `shouldBe` just (literalInt 8)
+
     it "declines when the binder is read as a whole value" do
       -- v flows into a function as a whole value, so it cannot be dropped
       -- (nor is it inlinable, so the binding survives untouched).
@@ -2123,22 +2147,22 @@ spec = describe "IR Optimizer" do
       runIdentity (pushEliminatorIntoIfBranches original) `shouldBe` Nothing
 
   describe "inlines expressions" do
+    -- The Let itself is gone from each result below: pasting the body's
+    -- only reference leaves the binding unread, and an unread binding is
+    -- dropped in the same sweep ('removeUnusedLetBindings'). A result
+    -- still carrying the Let would mean the paste never happened.
     test "inlines literals" do
       name ← forAll Gen.name
       inlinee ← forAll Gen.scalarExp
-      let original = let1 name inlinee (refLocal name)
-          expected = let1 name inlinee inlinee
-      optimizedExpression original === expected
+      optimizedExpression (let1 name inlinee (refLocal name)) === inlinee
 
     test "inlines references" do
       name ← forAll Gen.name
       -- A reference to the binding's own name is the one reference that
       -- must NOT be inlined (see the self-inlining test below), so the
       -- inlinee is drawn from the other names.
       inlinee ← refLocal <$> forAll (mfilter (/= name) Gen.name)
-      let original = let1 name inlinee (refLocal name)
-          expected = let1 name inlinee inlinee
-      optimizedExpression original === expected
+      optimizedExpression (let1 name inlinee (refLocal name)) === inlinee
 
     -- Regression: substituting @x := x@ is a textual no-op, so the
     -- occurrence count of @x@ never reaches zero and an unguarded rule
@@ -2164,13 +2188,11 @@ spec = describe "IR Optimizer" do
                 && countFreeRef (Local name) e == 0
           )
           Gen.exp
-      let body = refLocal name
-          original = let1 name inlinee body
-          expected = let1 name inlinee inlinee
-      annotateShow body
+      let original = let1 name inlinee (refLocal name)
+      annotateShow original
       -- The inserted copy gets fresh binder names ('substituteCopyM'
       -- freshens every insertion), so compare up to alpha-equivalence.
-      diff (optimizedExpression original) alphaEq expected
+      diff (optimizedExpression original) alphaEq inlinee
 
     test "doesn't inline expressions referenced more than once" do
       name ← forAll Gen.name
@@ -2383,8 +2405,9 @@ spec = describe "IR Optimizer" do
                 PrimAdd
                 (application (refLocal incName) (literalInt 1))
                 (application (refLocal incName) (literalInt 2))
-      optimizedExpression original
-        `shouldSatisfy` alphaEq (let1 incName incExpr (literalInt 5))
+      -- Both call sites fold, so nothing reads the binding and it goes
+      -- with them — the same result the beta-reduced spelling below has.
+      optimizedExpression original `shouldSatisfy` alphaEq (literalInt 5)
 
     it "beta-reduces a small closed lambda argument used twice" do
       let body =
diff --git a/test/ps/output/Golden.LongWriterBind.Test/golden.ir b/test/ps/output/Golden.LongWriterBind.Test/golden.ir
diff --git a/test/ps/output/Golden.LongWriterBind.Test/golden.lua b/test/ps/output/Golden.LongWriterBind.Test/golden.lua
