purescript-lua · Unisay · Jul 30, 2026 · Jul 30, 2026 · Jul 30, 2026
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 =