purescript-lua · Unisay · Jul 4, 2026 · Jul 4, 2026 · Jul 4, 2026
diff --git a/changelog.d/20260704_130000_unisay_bottom_up_rewrite_driver.md b/changelog.d/20260704_130000_unisay_bottom_up_rewrite_driver.md
@@ -0,0 +1,21 @@
+### Changed
+
+- The IR rewrite driver is now bottom-up and `Maybe`-based. Rules return
+  `Nothing` (did not fire) or `Just` a rewritten node, replacing the bespoke
+  `Rewritten NoChange/Recurse/Stop` tri-state that conflated change reporting
+  with descent control; the driver rewrites children before their parent and
+  re-applies rules to their own results, so one optimizer pass is complete and
+  idempotent, and the driver's change flag is precise — the groundwork for
+  replacing the whole-module `Eq` fixpoint check (#144). The magic-do and
+  deep-bind-flattening lowerings keep a (`Maybe`-based) top-down driver, since
+  they consume chains from the outermost head. Generated code can differ in
+  minted-name numbering and in the shapes the reordered rules normalize;
+  runtime behavior is unchanged (all eval oracles hold).
+
+### Fixed
+
+- Three optimizer rules no longer report a rewrite when they change nothing:
+  the DCE lambda rule fired on every unused-parameter lambda (#145), the DCE
+  `Let` rule fired on every `Let`, and `inlineLocalBindings` fired on every
+  `Let` even when nothing was inlined. A zero-occurrence inline substitution is
+  now recognized as the no-op it is.
diff --git a/lib/Language/PureScript/Backend/IR/DCE.hs b/lib/Language/PureScript/Backend/IR/DCE.hs
@@ -9,7 +9,7 @@ import Data.DList qualified as DL
 import Data.Graph (Graph, Vertex, graphFromEdges, reachable)
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as Map
-import Data.Set (member, notMember)
+import Data.Set (member)
 import Data.Set qualified as Set
 import Language.PureScript.Backend.IR.Linker (UberModule (..))
 import Language.PureScript.Backend.IR.Names
@@ -24,11 +24,9 @@ import Language.PureScript.Backend.IR.Types
   , Grouping (..)
   , Parameter (..)
   , RawExp (..)
-  , RewriteMod (..)
-  , Rewritten (..)
   , getAnn
   , listGrouping
-  , rewriteExpTopDown
+  , rewriteExpBottomUp
   , subexpressions
   )
 
@@ -121,73 +119,53 @@ eliminateDeadCode uber@UberModule {..} =
   annotatedForeignBindings ∷ [(QName, AExp)] =
     [b | b@(_qname, ObjectProp {}) ← annotatedForeigns]
 
+  -- Bottom-up ('rewriteExpBottomUp'): a Let is decided only after its
+  -- body has been fully processed, so when every binding is dropped and
+  -- the node collapses to its body, a body that is itself a Let has
+  -- already had its own dead bindings dropped — the Recurse-escape bug
+  -- class (issue #149) cannot arise, and no rebuild cascade is needed.
+  -- Both rules observe the honesty contract of 'RewriteRule': they fire
+  -- only when a binder is actually blanked or dropped (issue #145), so
+  -- the driver's change flag is a sound fixpoint signal (issue #144).
   dceAnnotatedExp ∷ AExp → Exp
   dceAnnotatedExp =
-    deannotateExp <$> rewriteExpTopDown do
-      pure . \case
-        Abs ann param b
-          | not (paramId `member` reachableIds) →
-              Rewritten Recurse (Abs ann param' b)
-         where
-          paramId ∷ Id =
-            case param of
-              ParamUnused (pid, _) → pid
-              ParamNamed (pid, _) _name → pid
-          -- Under GUC a dead binder is unreferenced by definition, so
-          -- blanking its name touches no reference elsewhere (the
-          -- hazard behind issue #56).
-          param' =
-            case param of
-              ParamUnused pann → ParamUnused pann
-              ParamNamed pann _name → ParamUnused pann
-        Let ann binds body →
-          Rewritten Recurse (rebuild ann (preserveLetBinds (toList binds) body))
-         where
-          -- 'Rewritten Recurse' descends into the result's children without
-          -- re-applying the rule to the result itself, so when every binding
-          -- of the Let is dropped and the node collapses to its body, a body
-          -- that is itself a Let would escape the rule: its dead bindings
-          -- would be kept, while the parameters of lambdas inside them get
-          -- blanked (their ids are unreachable), leaving unbound references
-          -- behind. Process such a body here; the collapse can cascade.
-          rebuild ann' = \case
-            ([], Let ann'' binds' body') →
-              rebuild ann'' (preserveLetBinds (toList binds') body')
-            ([], body') → body'
-            (b : bs, body') → Let ann' (b :| bs) body'
-
-          -- Under GUC dropping a dead binder touches no reference
-          -- elsewhere in the Let (later grouping RHSs or the body): a
-          -- dropped binder is unreferenced by definition, same as the
-          -- Abs case above (pre-GUC this required 'unshift'ing the
-          -- tail, issue #56).
-          preserveLetBinds
-            ∷ [Grouping ((Id, Ann), Name, AExp)]
-            → AExp
-            → ([Grouping ((Id, Ann), Name, AExp)], AExp)
-          preserveLetBinds groupings body' = case groupings of
-            [] → ([], body')
-            g : gs → case g of
-              Standalone ((expId, _ann), _name, _expr)
-                | not (expId `member` reachableIds) →
-                    preserveLetBinds gs body'
-              RecursiveGroup recBinds
-                | any
-                    (\((nameId, _ann), _, _) → nameId `notMember` reachableIds)
-                    (toList recBinds) →
-                    preserveLetBinds remainingGs body'
-               where
-                keptBinds =
-                  [ b
-                  | b@((nameId, _), _, _) ← toList recBinds
-                  , nameId `member` reachableIds
-                  ]
-                remainingGs =
-                  case NE.nonEmpty keptBinds of
-                    Nothing → gs
-                    Just kept → RecursiveGroup kept : gs
-              _keep → first (g :) (preserveLetBinds gs body')
-        _ → NoChange
+    deannotateExp . fst . rewriteExpBottomUp \case
+      -- Under GUC a dead binder is unreferenced by definition, so
+      -- blanking its name touches no reference elsewhere (the hazard
+      -- behind issue #56). Requiring 'ParamNamed' keeps the rule
+      -- honest: an already-blank parameter is left alone (issue #145).
+      Abs ann (ParamNamed pann@(paramId, _) _name) b
+        | not (paramId `member` reachableIds) →
+            Just (Abs ann (ParamUnused pann) b)
+      Let ann binds body
+        -- Under GUC dropping a dead binder touches no reference
+        -- elsewhere in the Let (later grouping RHSs or the body): a
+        -- dropped binder is unreferenced by definition, same as the
+        -- Abs case above (pre-GUC this required 'unshift'ing the
+        -- tail, issue #56).
+        | let kept = preservedGroupings (toList binds)
+        , members kept < members (toList binds) →
+            Just case NE.nonEmpty kept of
+              Nothing → body
+              Just keptNE → Let ann keptNE body
+      _ → Nothing
+   where
+    preservedGroupings
+      ∷ [Grouping ((Id, Ann), Name, AExp)]
+      → [Grouping ((Id, Ann), Name, AExp)]
+    preservedGroupings = mapMaybe \case
+      g@(Standalone ((nameId, _ann), _name, _expr)) →
+        g <$ guard (nameId `member` reachableIds)
+      RecursiveGroup recBinds →
+        RecursiveGroup
+          <$> NE.nonEmpty
+            [ b
+            | b@((nameId, _ann), _name, _expr) ← toList recBinds
+            , nameId `member` reachableIds
+            ]
+
+    members ∷ [Grouping ((Id, Ann), Name, AExp)] → Int
+    members = length . (listGrouping =<<)
 
   reachableIds ∷ Set Id =
     Set.fromList

diff --git a/lib/Language/PureScript/Backend/IR/FlattenDeepBinds.hs b/lib/Language/PureScript/Backend/IR/FlattenDeepBinds.hs
@@ -92,7 +92,7 @@ longer than 'threshold'); a bind chain hides its depth under lambdas, so its
 application-spine depth is tiny and Strategy B never fires on it. Strategy B
 then fires on any remaining contiguous 'App' spine deeper than 'threshold'.
 Both emit segments shallower than 'threshold', and B's output binds every 'App'
-to a depth-1 right-hand side, so the 'Recurse' rewrite cannot re-fire on its own
+to a depth-1 right-hand side, so the top-down rewrite cannot re-fire on its own
 output.
 
 == GUC safety: no shifting, fresh helper parameters
@@ -123,7 +123,7 @@ the magic-do statement sequence.
 Lambda-lifting bounds /nesting/ but the innermost closure of a segment captures
 the segment's own binders plus the forwarded live set as upvalues, and Lua 5.1
 caps a function at 60 upvalues (@LUAI_MAXUPVALUES@, see @docs\/QUIRKS.md@). When
-the live set at a cut is too large Strategy A bails (returns 'NoChange', leaving
+the live set at a cut is too large Strategy A bails (returns 'Nothing', leaving
 the chain nested): the program then overflows exactly as it does today, now
 caught by the post-codegen nesting detector
 ('Language.PureScript.Backend.Lua.NestingCheck'). Strategy B introduces only
@@ -150,9 +150,7 @@ import Language.PureScript.Backend.IR.Types
   , Grouping (..)
   , Parameter (..)
   , RawExp (..)
-  , RewriteMod (..)
   , RewriteRuleM
-  , Rewritten (..)
   , countFreeRefs
   , noAnn
   , refLocal
@@ -174,6 +172,11 @@ flattenDeepBindsM uber@UberModule {uberModuleBindings, uberModuleExports} = do
   exports' ← traverse (traverse rewrite) uberModuleExports
   pure uber {uberModuleBindings = bindings', uberModuleExports = exports'}
  where
+  -- Top-down deliberately: a chain/spine must be measured and cut from
+  -- its outermost node (every suffix of a chain is itself a chain, so a
+  -- bottom-up driver would segment the deep tails first and the
+  -- remaining upper chain would never reach 'threshold' as one piece).
+  -- See 'rewriteExpTopDownM'.
   rewrite ∷ Exp → SupplyM Exp
   rewrite = rewriteExpTopDownM flattenRule
 
@@ -183,17 +186,17 @@ flattenDeepBindsM uber@UberModule {uberModuleBindings, uberModuleExports} = do
 {- | Dispatch the two strategies. Strategy A handles a recognised continuation
 chain longer than 'threshold' (depth under trailing lambdas); a bind chain's
 application-spine depth is tiny, so Strategy B only ever sees the remaining deep
-'App' spines. Either may leave the expression unchanged ('NoChange'), in which
+'App' spines. Either may leave the expression unchanged ('Nothing'), in which
 case 'Language.PureScript.Backend.Lua.NestingCheck' remains the backstop.
 -}
 flattenRule ∷ RewriteRuleM SupplyM Ann
 flattenRule expr
   | (steps, finalAction) ← peelChain expr
   , length steps > threshold =
-      maybe NoChange (Rewritten Recurse) <$> lambdaLift steps finalAction
+      lambdaLift steps finalAction
   | spineDepth expr > threshold =
-      maybe NoChange (Rewritten Recurse) <$> sequentialiseSpine expr
-  | otherwise = pure NoChange
+      sequentialiseSpine expr
+  | otherwise = pure Nothing
 
 --------------------------------------------------------------------------------
 -- Strategy A: continuation lambda-lifting -------------------------------------
@@ -424,7 +427,7 @@ chunksOf n xs = let (h, t) = splitAt n xs in h : chunksOf n t
 {- | Only fire on chains\/spines deeper than this. Shorter ones are below Lua's
 nesting cap and are left untouched, so existing goldens do not churn. Must exceed
 'segmentSize' so the helper\/body segments Strategy A produces never re-fire
-(which guarantees termination of the 'Recurse' rewrite); Strategy B's output
+(which guarantees termination of the top-down rewrite); Strategy B's output
 binds every 'App' to a depth-1 right-hand side and so cannot re-fire either.
 -}
 threshold ∷ Int

diff --git a/lib/Language/PureScript/Backend/IR/MagicDo.hs b/lib/Language/PureScript/Backend/IR/MagicDo.hs
@@ -66,9 +66,7 @@ import Language.PureScript.Backend.IR.Types
   , Grouping (..)
   , Parameter (..)
   , RawExp (..)
-  , RewriteMod (..)
   , RewriteRuleM
-  , Rewritten (..)
   , noAnn
   , rewriteExpTopDownM
   , substituteMoveM
@@ -86,6 +84,10 @@ magicDo uber@UberModule {uberModuleBindings, uberModuleExports} = do
       , uberModuleExports = uberModuleExports'
       }
  where
+  -- Top-down deliberately: a chain must be consumed from its outermost
+  -- head (every tail of a chain is itself a chain head, so a bottom-up
+  -- driver would rewrite the tails first, nesting one thunk per step
+  -- and defeating the flattening). See 'rewriteExpTopDownM'.
   rewrite ∷ Exp → SupplyM Exp
   rewrite = rewriteExpTopDownM (magicDoRule resolve)
 
@@ -106,8 +108,8 @@ magicDoRule ∷ (QName → Maybe Exp) → RewriteRuleM SupplyM Ann
 magicDoRule resolve expr = do
   (statements, finalAction) ← peelChain resolve expr
   pure case statements of
-    [] → NoChange
-    _ → Rewritten Recurse (buildThunk statements finalAction)
+    [] → Nothing
+    _ → Just (buildThunk statements finalAction)
 
 {- | Wrap the flattened statements and final action into an Effect/ST thunk.