From be0dd04601bbdcac85b2cbc0c63e2e7c65ae530d Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Mon, 15 Jun 2026 20:52:21 +0900
Subject: [PATCH 01/16] [Perf] FreeVars: thread the in-scope set as a Set, not
 an Array

---
 .../src/PureScript/Backend/Wasm/Codegen.purs  | 23 ++++++++++++-------
 .../Backend/Wasm/MiddleEnd/FreeVars.purs      | 14 +++++++----
 2 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/compiler/src/PureScript/Backend/Wasm/Codegen.purs b/compiler/src/PureScript/Backend/Wasm/Codegen.purs
index 1a8ccaa2..e40c38b1 100644
--- a/compiler/src/PureScript/Backend/Wasm/Codegen.purs
+++ b/compiler/src/PureScript/Backend/Wasm/Codegen.purs
@@ -29,7 +29,9 @@ import Prelude
 
 import Binaryen as B
 import Data.Array as Array
-import Data.Foldable (foldr, traverse_)
+import Data.Foldable (foldl, foldr, traverse_)
+import Data.List (List(..), (:))
+import Data.List as List
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
@@ -480,7 +482,10 @@ addExportWrapper ctx exportSigs fn = case fn.export of
 -- | Generate a function body. `Let`s become `local.set` statements sequenced in
 -- | a `block` whose value is the tail (`Return` atom or `Switch`).
 genBody :: Ctx -> AnfExpr -> Effect B.Expression
-genBody ctx = go []
+-- Statements accumulate in a `List`, prepended most-recent-first (O(1) per `Let`) and
+-- reversed once at `seal` — an `Array` accumulator (`snoc`) copies the whole prefix per
+-- binding, i.e. O(n²) on the long `Let` chains a large function's ANF body becomes.
+genBody ctx = go Nil
   where
   go statements = case _ of
     -- A returned atom is coerced to the function's result representation.
@@ -505,23 +510,25 @@ genBody ctx = go []
     Let (Slot index) _ rhs k -> do
       e <- genRhs ctx rhs >>= coerce ctx (rhsRep ctx rhs) (slotRep ctx index)
       stmt <- B.localSet ctx.mod index e
-      go (Array.snoc statements stmt) k
+      go (stmt : statements) k
     LetRec recBinds k -> do
       let groupSlots = map (\(RecBind (Slot s) _ _) -> s) recBinds
       allocs <- traverse (allocRecClosure ctx groupSlots) recBinds
       patches <- traverse (patchRecClosure ctx groupSlots) recBinds
-      go (statements <> allocs <> Array.concat patches) k
+      go (foldl (flip (:)) statements (allocs <> Array.concat patches)) k
     -- A join point (ADR 0022): generate the `producer` as a value-producing block
     -- (its tails yield `rep`, and `return_call` is disabled so it cannot escape the
     -- function), store it into the join slot, then continue the (single) continuation.
     LetJoin (Slot slot) rep producer k -> do
       producerExpr <- genBody (ctx { funcResult = rep, tailPos = false }) producer
       stmt <- B.localSet ctx.mod slot producerExpr
-      go (Array.snoc statements stmt) k
-  -- the body / branch block produces the function's result (a tail position)
+      go (stmt : statements) k
+  -- the body / branch block produces the function's result (a tail position); `statements`
+  -- is most-recent-first, so `value : statements` reversed is emission order with the value last.
   seal statements value =
-    if Array.null statements then pure value
-    else B.block ctx.mod (Array.snoc statements value) (repType ctx ctx.funcResult)
+    case statements of
+      Nil -> pure value
+      _ -> B.block ctx.mod (Array.fromFoldable (List.reverse (value : statements))) (repType ctx ctx.funcResult)
 
 -- | Is this captured atom a forward reference to another member of the same
 -- | `LetRec` group (and thus a slot to back-patch)?
diff --git a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs
index 5e9e9e80..1c9555c9 100644
--- a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs
+++ b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs
@@ -13,6 +13,7 @@ import Prelude
 import Data.Array as Array
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
+import Data.Set as Set
 import Data.Tuple (Tuple(..))
 import PureScript.Backend.Wasm.MiddleEnd.IR as M
 import PureScript.CoreFn (Binder(..), Literal(..), Qualified(..))
@@ -22,16 +23,19 @@ import PureScript.CoreFn (Binder(..), Literal(..), Qualified(..))
 -- | Order is first-appearance, deduplicated — it indexes a closure's captures, so
 -- | it must be deterministic.
 freeVars :: Array String -> M.Expr -> Array String
-freeVars bound = Array.nub <<< goExpr bound
+-- The in-scope set is threaded as a `Set` (not an `Array`): membership and extension
+-- happen at every node and every binder, so an `Array` `elem`/`<>` makes the walk
+-- O(nodes × scope-size) — quadratic on the deeply-nested bodies large modules produce.
+freeVars bound = Array.nub <<< goExpr (Set.fromFoldable bound)
   where
   goExpr bnd = case _ of
-    M.Var (Qualified Nothing x) -> if Array.elem x bnd then [] else [ x ]
+    M.Var (Qualified Nothing x) -> if Set.member x bnd then [] else [ x ]
     M.Var _ -> []
     M.Lit lit -> goLit bnd lit
     M.Constructor _ _ _ -> []
     M.Accessor _ e -> goExpr bnd e
     M.Update e _ updates -> goExpr bnd e <> (updates >>= \(Tuple _ v) -> goExpr bnd v)
-    M.Abs params e -> goExpr (bnd <> params) e
+    M.Abs params e -> goExpr (Set.union bnd (Set.fromFoldable params)) e
     M.App head args -> goExpr bnd head <> (args >>= goExpr bnd)
     M.Perform e -> goExpr bnd e
     M.Case scruts alts -> (scruts >>= goExpr bnd) <> (alts >>= goAlt bnd)
@@ -40,7 +44,7 @@ freeVars bound = Array.nub <<< goExpr bound
       -- right-hand sides and the body (exact for recursive `let`, a safe
       -- over-approximation otherwise).
       let
-        bnd' = bnd <> (binds >>= bindNames)
+        bnd' = Set.union bnd (Set.fromFoldable (binds >>= bindNames))
       in
         (binds >>= bindExprs >>= goExpr bnd') <> goExpr bnd' body
   goLit bnd = case _ of
@@ -49,7 +53,7 @@ freeVars bound = Array.nub <<< goExpr bound
     _ -> []
   goAlt bnd alt =
     let
-      bnd' = bnd <> (alt.binders >>= binderVars)
+      bnd' = Set.union bnd (Set.fromFoldable (alt.binders >>= binderVars))
     in
       case alt.result of
         Right e -> goExpr bnd' e

From 2d764849ae31a9c3baad76f56b31d3f36fac8d28 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 06:34:58 +0900
Subject: [PATCH 02/16] [Bugfix] Impurify: make the Effect rewrite stack-safe
 via Trampoline

---
 compiler/spago.yaml                           |  1 +
 .../Wasm/MiddleEnd/Optimize/Impurify.purs     | 91 +++++++++++--------
 spago.lock                                    |  1 +
 3 files changed, 56 insertions(+), 37 deletions(-)

diff --git a/compiler/spago.yaml b/compiler/spago.yaml
index 9d7336bb..057232a4 100644
--- a/compiler/spago.yaml
+++ b/compiler/spago.yaml
@@ -17,6 +17,7 @@ package:
     - foldable-traversable
     - foreign
     - foreign-object
+    - free
     - functions
     - identity
     - integers
diff --git a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Optimize/Impurify.purs b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Optimize/Impurify.purs
index 97cb1fee..84d7b454 100644
--- a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Optimize/Impurify.purs
+++ b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Optimize/Impurify.purs
@@ -19,6 +19,7 @@ module PureScript.Backend.Wasm.MiddleEnd.Optimize.Impurify
 
 import Prelude
 
+import Control.Monad.Trampoline (Trampoline, delay, done, runTrampoline)
 import Data.Array as Array
 import Data.Either (Either(..))
 import Data.Map (Map)
@@ -26,6 +27,7 @@ import Data.Map as Map
 import Data.Maybe (Maybe(..), isJust)
 import Data.Set (Set)
 import Data.Set as Set
+import Data.Traversable (traverse)
 import PureScript.Backend.Wasm.MiddleEnd.FreeVars (freeVars)
 import PureScript.Backend.Wasm.MiddleEnd.IR as M
 import PureScript.Backend.Wasm.MiddleEnd.Optimize.Analysis (qkey)
@@ -59,8 +61,8 @@ impurifyProgram :: Map String Int -> Array M.Module -> Array M.Module
 impurifyProgram effArities = map \m -> m { decls = map impurifyBind m.decls }
   where
   impurifyBind = case _ of
-    M.NonRec meta i e -> M.NonRec meta i (go e)
-    M.Rec rs -> M.Rec (map (\r -> r { expr = go r.expr }) rs)
+    M.NonRec meta i e -> M.NonRec meta i (runTrampoline (go e))
+    M.Rec rs -> M.Rec (map (\r -> r { expr = runTrampoline (go r.expr) }) rs)
 
   -- The value-arity of an effectful **host** foreign (so a full application is an `Effect`
   -- value). The monad-glue foreigns (`bindE`/`pureE`/`unsafePerformEffect`) are excluded —
@@ -70,66 +72,87 @@ impurifyProgram effArities = map \m -> m { decls = map impurifyBind m.decls }
     Just k | k /= bindEKey, k /= pureEKey, k /= performKey -> Map.lookup k effArities
     _ -> Nothing
 
+  -- Recursion runs through the `Trampoline` monad: each descent into a child is `delay`ed, so
+  -- the rewrite is driven by `runTrampoline`'s heap loop rather than the native call stack —
+  -- compiler-sized modules nest expressions deep enough to otherwise overflow it.
+  goSub :: M.Expr -> Trampoline M.Expr
+  goSub e = join (delay \_ -> go e)
+
+  goArgs :: Array M.Expr -> Trampoline (Array M.Expr)
+  goArgs es = traverse goSub es
+
   -- Rewrite top-down: an applied primitive is recognised at the `App` node; an unapplied
   -- reference is eta-expanded to its lambda form so it never reaches lowering as a bare
   -- foreign. Performed host foreigns are kept (not re-reflected — keeps reflection idempotent
   -- across rounds); host foreigns in value position are reflected to a thunk.
+  go :: M.Expr -> Trampoline M.Expr
   go expr = case expr of
     -- a host foreign already under a run stays performed (recurse args only). This is what
     -- makes the reflection below idempotent: `Π(reflect \_ -> Π(f)) → Π(f)` (Simplify β),
     -- and re-running impurify must not wrap it again.
-    M.Perform (M.App (M.Var q) args) | isJust (effArity q) -> M.Perform (M.App (M.Var q) (map go args))
-    M.Perform (M.Var q) | effArity q == Just 0 -> M.Perform (M.Var q)
+    M.Perform (M.App (M.Var q) args) | isJust (effArity q) ->
+      (\args' -> M.Perform (M.App (M.Var q) args')) <$> goArgs args
+    M.Perform (M.Var q) | effArity q == Just 0 -> done expr
     M.App (M.Var q) args
       | qkey q == Just pureEKey
-      , Just { head: a, tail } <- Array.uncons args -> reapply (thunk (go a)) (map go tail)
+      , Just { head: a, tail } <- Array.uncons args ->
+          (\a' tail' -> reapply (thunk a') tail') <$> goSub a <*> goArgs tail
       | qkey q == Just performKey
-      , Just { head: e, tail } <- Array.uncons args -> reapply (perform (go e)) (map go tail)
+      , Just { head: e, tail } <- Array.uncons args ->
+          (\e' tail' -> reapply (perform e') tail') <$> goSub e <*> goArgs tail
       | qkey q == Just bindEKey
       , Just { head: m, tail: t1 } <- Array.uncons args
-      , Just { head: k, tail: rest } <- Array.uncons t1 -> reapply (thunk (bindBody (go m) (go k))) (map go rest)
+      , Just { head: k, tail: rest } <- Array.uncons t1 ->
+          (\m' k' rest' -> reapply (thunk (bindBody m' k')) rest') <$> goSub m <*> goSub k <*> goArgs rest
       -- generalized effect reflection (ADR 0019): a fully-applied effectful host foreign is
       -- already an opaque `Effect` (`log "a" ≡ reflect (\_ -> Π(log "a"))`), so in value
       -- position it becomes a thunk; a directly-performed one β-reduces back (Simplify ~130).
-      | Just n <- effArity q, Array.length args == n -> reflect (M.App (M.Var q) (map go args))
+      | Just n <- effArity q, Array.length args == n ->
+          (\args' -> reflect (M.App (M.Var q) args')) <$> goArgs args
     -- `functorEffect.map f m` = `bindE m (\a -> pure (f a))` → `\$ev -> let a = perform m in f a`
     M.App (M.Accessor "map" (M.Var q)) args
       | qkey q == Just functorEffectKey
       , Just { head: f, tail: t1 } <- Array.uncons args
-      , Just { head: m, tail: rest } <- Array.uncons t1 -> reapply (mapBody (go f) (go m)) (map go rest)
+      , Just { head: m, tail: rest } <- Array.uncons t1 ->
+          (\f' m' rest' -> reapply (mapBody f' m') rest') <$> goSub f <*> goSub m <*> goArgs rest
     -- `applyEffect.apply mf ma` = `bindE mf (\f -> bindE ma (\a -> pure (f a)))`
     M.App (M.Accessor "apply" (M.Var q)) args
       | qkey q == Just applyEffectKey
       , Just { head: mf, tail: t1 } <- Array.uncons args
-      , Just { head: ma, tail: rest } <- Array.uncons t1 -> reapply (applyBody (go mf) (go ma)) (map go rest)
+      , Just { head: ma, tail: rest } <- Array.uncons t1 ->
+          (\mf' ma' rest' -> reapply (applyBody mf' ma') rest') <$> goSub mf <*> goSub ma <*> goArgs rest
     M.Var q
-      | qkey q == Just pureEKey -> etaPure
-      | qkey q == Just bindEKey -> etaBind
-      | qkey q == Just performKey -> etaPerform
+      | qkey q == Just pureEKey -> done etaPure
+      | qkey q == Just bindEKey -> done etaBind
+      | qkey q == Just performKey -> done etaPerform
       -- a nullary effectful host foreign (e.g. `random :: Effect a`) is itself an `Effect`
-      | effArity q == Just 0 -> reflect (M.Var q)
+      | effArity q == Just 0 -> done (reflect (M.Var q))
     _ -> descend expr
 
+  descend :: M.Expr -> Trampoline M.Expr
   descend = case _ of
-    M.Lit lit -> M.Lit (mapLit go lit)
-    e@(M.Var _) -> e
-    e@(M.Constructor _ _ _) -> e
-    M.Accessor l e -> M.Accessor l (go e)
-    M.Update e cf kvs -> M.Update (go e) cf (map (map go) kvs)
-    M.Abs ps b -> M.Abs ps (go b)
-    M.App f args -> M.App (go f) (map go args)
-    M.Case ss alts -> M.Case (map go ss) (map goAlt alts)
-    M.Let bs body -> M.Let (map goBind bs) (go body)
-    M.Perform e -> M.Perform (go e)
+    M.Lit lit -> M.Lit <$> goLit lit
+    e@(M.Var _) -> done e
+    e@(M.Constructor _ _ _) -> done e
+    M.Accessor l e -> M.Accessor l <$> goSub e
+    M.Update e cf kvs -> (\e' kvs' -> M.Update e' cf kvs') <$> goSub e <*> traverse (traverse goSub) kvs
+    M.Abs ps b -> M.Abs ps <$> goSub b
+    M.App f args -> (\f' args' -> M.App f' args') <$> goSub f <*> goArgs args
+    M.Case ss alts -> (\ss' alts' -> M.Case ss' alts') <$> goArgs ss <*> traverse goAlt alts
+    M.Let bs body -> (\bs' body' -> M.Let bs' body') <$> traverse goBind bs <*> goSub body
+    M.Perform e -> M.Perform <$> goSub e
     where
-    goAlt alt = alt
-      { result = case alt.result of
-          Right e -> Right (go e)
-          Left gs -> Left (map (\g -> { guard: go g.guard, expression: go g.expression }) gs)
-      }
+    goLit = case _ of
+      LitArray es -> LitArray <$> goArgs es
+      LitObject kvs -> LitObject <$> traverse (traverse goSub) kvs
+      other -> done other
+    goAlt alt = case alt.result of
+      Right e -> (\e' -> alt { result = Right e' }) <$> goSub e
+      Left gs -> (\gs' -> alt { result = Left gs' }) <$> traverse goGuard gs
+    goGuard g = (\gu ge -> { guard: gu, expression: ge }) <$> goSub g.guard <*> goSub g.expression
     goBind = case _ of
-      M.NonRec meta i e -> M.NonRec meta i (go e)
-      M.Rec rs -> M.Rec (map (\r -> r { expr = go r.expr }) rs)
+      M.NonRec meta i e -> (\e' -> M.NonRec meta i e') <$> goSub e
+      M.Rec rs -> M.Rec <$> traverse (\r -> (\e' -> r { expr = e' }) <$> goSub r.expr) rs
 
 -- | Reflect an `Effect` value into its thunk encoding: `reflect m = \$ev -> Π(m)` — a thunk
 -- | that, when performed, runs `m` (ADR 0019).
@@ -202,12 +225,6 @@ applyBody mf ma =
           (M.Let [ M.NonRec Nothing a (perform ma) ] (M.App (M.Var (Qualified Nothing f)) [ M.Var (Qualified Nothing a) ]))
       )
 
-mapLit :: (M.Expr -> M.Expr) -> Literal M.Expr -> Literal M.Expr
-mapLit f = case _ of
-  LitArray es -> LitArray (map f es)
-  LitObject kvs -> LitObject (map (map f) kvs)
-  other -> other
-
 allVars :: M.Expr -> Set String
 allVars e = Set.fromFoldable (freeVars [] e)
 
diff --git a/spago.lock b/spago.lock
index 15ac4fb0..be40c214 100644
--- a/spago.lock
+++ b/spago.lock
@@ -60,6 +60,7 @@
             "foldable-traversable",
             "foreign",
             "foreign-object",
+            "free",
             "functions",
             "identity",
             "integers",

From 9f5339e457c18c71f3313d62d298f3001a99e4d8 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 08:47:38 +0900
Subject: [PATCH 03/16] [Perf] FreeVars: memoize the scope-independent free-var
 set by node identity

---
 .../Backend/Wasm/MiddleEnd/FreeVars.js        | 14 ++++
 .../Backend/Wasm/MiddleEnd/FreeVars.purs      | 72 +++++++++++++------
 2 files changed, 63 insertions(+), 23 deletions(-)
 create mode 100644 compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.js

diff --git a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.js b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.js
new file mode 100644
index 00000000..f3826459
--- /dev/null
+++ b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.js
@@ -0,0 +1,14 @@
+// Memoize a function of an `M.Expr` by reference identity (a `WeakMap`), so the
+// bound-agnostic free-variable computation visits each shared MIR node at most once
+// across all callers (lambda lifting and the lowering's closure conversion both
+// re-query it). Keys are GC'd with the expressions, so the cache adds no retention.
+export const unsafeMemoExpr = (f) => {
+  const cache = new WeakMap();
+  return (x) => {
+    const hit = cache.get(x);
+    if (hit !== undefined) return hit;
+    const v = f(x);
+    cache.set(x, v);
+    return v;
+  };
+};
diff --git a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs
index 1c9555c9..15210065 100644
--- a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs
+++ b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs
@@ -22,42 +22,63 @@ import PureScript.CoreFn (Binder(..), Literal(..), Qualified(..))
 -- | `Qualified Nothing` not bound by an enclosing lambda, `let`, or case binder.
 -- | Order is first-appearance, deduplicated — it indexes a closure's captures, so
 -- | it must be deterministic.
+-- |
+-- | Computed as the *scope-independent* free set (`rawFreeVars`) minus the given
+-- | `bound`. The raw set is the same for every caller of a given node regardless of
+-- | their `bound`, so memoizing it (below) lets lowering re-query a nested lambda's
+-- | body without re-walking it once per enclosing lambda — the difference between
+-- | O(n²) and O(n) on the deeply-nested bodies large modules produce.
 freeVars :: Array String -> M.Expr -> Array String
--- The in-scope set is threaded as a `Set` (not an `Array`): membership and extension
--- happen at every node and every binder, so an `Array` `elem`/`<>` makes the walk
--- O(nodes × scope-size) — quadratic on the deeply-nested bodies large modules produce.
-freeVars bound = Array.nub <<< goExpr (Set.fromFoldable bound)
+freeVars bound = case Array.null bound of
+  true -> rawFreeVars
+  false ->
+    let
+      boundSet = Set.fromFoldable bound
+    in
+      Array.filter (\x -> not (Set.member x boundSet)) <<< rawFreeVars
+
+-- | The free variables of an expression with *nothing* externally bound, in
+-- | first-appearance order with duplicates removed at every node (so the result is
+-- | small and the global first-appearance order is preserved). Memoized by node
+-- | identity (`unsafeMemoExpr`): a shared MIR subtree — e.g. a lambda body that the
+-- | enclosing lambda's analysis already visited — is computed at most once.
+rawFreeVars :: M.Expr -> Array String
+rawFreeVars = unsafeMemoExpr go
   where
-  goExpr bnd = case _ of
-    M.Var (Qualified Nothing x) -> if Set.member x bnd then [] else [ x ]
+  dedup = Array.nub
+  go = case _ of
+    M.Var (Qualified Nothing x) -> [ x ]
     M.Var _ -> []
-    M.Lit lit -> goLit bnd lit
+    M.Lit lit -> goLit lit
     M.Constructor _ _ _ -> []
-    M.Accessor _ e -> goExpr bnd e
-    M.Update e _ updates -> goExpr bnd e <> (updates >>= \(Tuple _ v) -> goExpr bnd v)
-    M.Abs params e -> goExpr (Set.union bnd (Set.fromFoldable params)) e
-    M.App head args -> goExpr bnd head <> (args >>= goExpr bnd)
-    M.Perform e -> goExpr bnd e
-    M.Case scruts alts -> (scruts >>= goExpr bnd) <> (alts >>= goAlt bnd)
+    M.Accessor _ e -> rawFreeVars e
+    M.Update e _ updates -> dedup (rawFreeVars e <> (updates >>= \(Tuple _ v) -> rawFreeVars v))
+    M.Abs params e -> Array.filter (\x -> not (Array.elem x params)) (rawFreeVars e)
+    M.App head args -> dedup (rawFreeVars head <> (args >>= rawFreeVars))
+    M.Perform e -> rawFreeVars e
+    M.Case scruts alts -> dedup ((scruts >>= rawFreeVars) <> (alts >>= goAlt))
     M.Let binds body ->
       -- Conservative scoping: every let-bound name is in scope for both the
       -- right-hand sides and the body (exact for recursive `let`, a safe
       -- over-approximation otherwise).
       let
-        bnd' = Set.union bnd (Set.fromFoldable (binds >>= bindNames))
+        names = binds >>= bindNames
       in
-        (binds >>= bindExprs >>= goExpr bnd') <> goExpr bnd' body
-  goLit bnd = case _ of
-    LitArray es -> es >>= goExpr bnd
-    LitObject kvs -> kvs >>= \(Tuple _ v) -> goExpr bnd v
+        Array.filter (\x -> not (Array.elem x names))
+          (dedup ((binds >>= bindExprs >>= rawFreeVars) <> rawFreeVars body))
+  goLit = case _ of
+    LitArray es -> dedup (es >>= rawFreeVars)
+    LitObject kvs -> dedup (kvs >>= \(Tuple _ v) -> rawFreeVars v)
     _ -> []
-  goAlt bnd alt =
+  goAlt alt =
     let
-      bnd' = Set.union bnd (Set.fromFoldable (alt.binders >>= binderVars))
+      names = alt.binders >>= binderVars
     in
-      case alt.result of
-        Right e -> goExpr bnd' e
-        Left guards -> guards >>= \g -> goExpr bnd' g.guard <> goExpr bnd' g.expression
+      Array.filter (\x -> not (Array.elem x names))
+        ( case alt.result of
+            Right e -> rawFreeVars e
+            Left guards -> dedup (guards >>= \g -> rawFreeVars g.guard <> rawFreeVars g.expression)
+        )
   bindNames = case _ of
     M.NonRec _ n _ -> [ n ]
     M.Rec rs -> map _.ident rs
@@ -65,6 +86,11 @@ freeVars bound = Array.nub <<< goExpr (Set.fromFoldable bound)
     M.NonRec _ _ e -> [ e ]
     M.Rec rs -> map _.expr rs
 
+-- | Memoize a function of an `M.Expr` by reference identity. Observationally pure
+-- | (the MIR is immutable and the function is pure), so it is wrapped and never
+-- | exported; only the pure `freeVars` is.
+foreign import unsafeMemoExpr :: (M.Expr -> Array String) -> M.Expr -> Array String
+
 -- | The variables a binder brings into scope.
 binderVars :: Binder -> Array String
 binderVars = case _ of

From 25ebebba78dfc593427eb51cb52efe4f355eb75f Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 09:09:36 +0900
Subject: [PATCH 04/16] [Perf] LambdaLift: apply lifted-group substitutions in
 one pass

---
 .../Wasm/MiddleEnd/Optimize/LambdaLift.purs   | 89 ++++++++++++-------
 1 file changed, 55 insertions(+), 34 deletions(-)

diff --git a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Optimize/LambdaLift.purs b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Optimize/LambdaLift.purs
index 3820a135..7c2d8a85 100644
--- a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Optimize/LambdaLift.purs
+++ b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Optimize/LambdaLift.purs
@@ -31,6 +31,8 @@ import Control.Monad.State (State, gets, modify_, runState)
 import Data.Array as Array
 import Data.Either (Either(..))
 import Data.Foldable (foldl, for_)
+import Data.Map (Map)
+import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..))
@@ -122,7 +124,7 @@ liftSelfRecFn modName ident params body = do
     repl = mkApp liftedVar (map localVar frees)
   -- inside the lifted body the self reference becomes the same partial application
   -- (the captures resolve to the leading parameters there), then lift nested locals
-  body' <- liftExpr modName (substVar ident repl body)
+  body' <- liftExpr modName (substMany (Map.singleton ident repl) body)
   let lambda' = M.Abs (frees <> params) body'
   modify_ \s -> s { lifted = Array.snoc s.lifted (M.NonRec Nothing liftedIdent lambda') }
   pure (Tuple ident repl)
@@ -162,47 +164,66 @@ liftMutualRecGroup modName members = do
 -- substitution ---------------------------------------------------------------
 
 applySubs :: Array Sub -> M.Expr -> M.Expr
-applySubs subs e = foldl (\acc (Tuple n r) -> substVar n r acc) e subs
+applySubs subs = substMany (Map.fromFoldable subs)
 
 substBind :: Array Sub -> M.Bind -> M.Bind
 substBind subs = case _ of
   M.NonRec meta i e -> M.NonRec meta i (applySubs subs e)
   M.Rec rs -> M.Rec (map (\r -> r { expr = applySubs subs r.expr }) rs)
 
--- | Replace free occurrences of the local `name` with `repl`, stopping at any
--- | binder that rebinds `name` (capture avoidance). `repl` only references
--- | already-in-scope names, so no further freshening is needed.
-substVar :: String -> M.Expr -> M.Expr -> M.Expr
-substVar name repl = go
+-- | Replace free occurrences of each substituted local with its replacement, in a
+-- | *single* traversal, stopping at any binder that rebinds the name (capture
+-- | avoidance) by dropping it from the scope's map. Each replacement only references
+-- | already-in-scope names, so no freshening is needed — and the replacements never
+-- | introduce another substituted name (the lifted idents are excluded from the
+-- | captured frees), so applying them all at once equals folding them one at a time.
+-- | A per-substitution fold instead re-walked the expression once per lifted group,
+-- | i.e. O(groups × size) on a `let`/`where` with many recursive functions.
+substMany :: Map String M.Expr -> M.Expr -> M.Expr
+substMany = go
   where
-  go = case _ of
-    e@(M.Var (Qualified Nothing n)) -> if n == name then repl else e
-    e@(M.Var _) -> e
-    M.Lit lit -> M.Lit (goLit lit)
-    e@(M.Constructor _ _ _) -> e
-    M.Accessor l e -> M.Accessor l (go e)
-    M.Update e cf kvs -> M.Update (go e) cf (map (map go) kvs)
-    M.Abs ps b -> if Array.elem name ps then M.Abs ps b else M.Abs ps (go b)
-    -- a substituted head may itself be an application; keep `App` flat
-    M.App f a -> mkApp (go f) (map go a)
-    M.Perform e -> M.Perform (go e)
-    M.Case ss alts -> M.Case (map go ss) (map goAlt alts)
-    M.Let binds body ->
-      if Array.elem name (binds >>= boundNames) then M.Let binds body
-      else M.Let (map goBind binds) (go body)
-  goLit = case _ of
-    LitArray es -> LitArray (map go es)
-    LitObject kvs -> LitObject (map (map go) kvs)
+  go subs e
+    | Map.isEmpty subs = e
+    | otherwise = case e of
+        M.Var (Qualified Nothing n) -> case Map.lookup n subs of
+          Just r -> r
+          Nothing -> e
+        M.Var _ -> e
+        M.Lit lit -> M.Lit (goLit subs lit)
+        M.Constructor _ _ _ -> e
+        M.Accessor l x -> M.Accessor l (go subs x)
+        M.Update x cf kvs -> M.Update (go subs x) cf (map (map (go subs)) kvs)
+        M.Abs ps b ->
+          let
+            subs' = dropNames ps subs
+          in
+            if Map.isEmpty subs' then e else M.Abs ps (go subs' b)
+        -- a substituted head may itself be an application; keep `App` flat
+        M.App f a -> mkApp (go subs f) (map (go subs) a)
+        M.Perform x -> M.Perform (go subs x)
+        M.Case ss alts -> M.Case (map (go subs) ss) (map (goAlt subs) alts)
+        M.Let binds body ->
+          let
+            subs' = dropNames (binds >>= boundNames) subs
+          in
+            if Map.isEmpty subs' then e
+            else M.Let (map (goBind subs') binds) (go subs' body)
+  goLit subs = case _ of
+    LitArray es -> LitArray (map (go subs) es)
+    LitObject kvs -> LitObject (map (map (go subs)) kvs)
     other -> other
-  goAlt alt =
-    if Array.elem name (alt.binders >>= binderVars) then alt
-    else alt { result = goResult alt.result }
-  goResult = case _ of
-    Right e -> Right (go e)
-    Left gs -> Left (map (\g -> { guard: go g.guard, expression: go g.expression }) gs)
-  goBind = case _ of
-    M.NonRec meta i e -> M.NonRec meta i (go e)
-    M.Rec rs -> M.Rec (map (\r -> r { expr = go r.expr }) rs)
+  goAlt subs alt =
+    let
+      subs' = dropNames (alt.binders >>= binderVars) subs
+    in
+      if Map.isEmpty subs' then alt else alt { result = goResult subs' alt.result }
+  goResult subs = case _ of
+    Right e -> Right (go subs e)
+    Left gs -> Left (map (\g -> { guard: go subs g.guard, expression: go subs g.expression }) gs)
+  goBind subs = case _ of
+    M.NonRec meta i e -> M.NonRec meta i (go subs e)
+    M.Rec rs -> M.Rec (map (\r -> r { expr = go subs r.expr }) rs)
+  dropNames names subs = foldl (flip Map.delete) subs names
 
 -- | Smart application that preserves the MIR invariant that an `App` head is never
 -- | itself an `App`: applying to an existing application extends its argument list.

From 4652fb07c5ac5d001dc24b04c241d2c0489a713f Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 11:22:57 +0900
Subject: [PATCH 05/16] [Docs] ADR-0035: Detailed architecture towards
 reduction-aware inlining

---
 .../0020-reduction-aware-inliner.md           |   7 +
 ...35-sharing-nbe-reduction-aware-inlining.md | 189 ++++++++++++++++++
 docs/design-decisions/README.md               |   7 +-
 3 files changed, 201 insertions(+), 2 deletions(-)
 create mode 100644 docs/design-decisions/0035-sharing-nbe-reduction-aware-inlining.md

diff --git a/docs/design-decisions/0020-reduction-aware-inliner.md b/docs/design-decisions/0020-reduction-aware-inliner.md
index f37f0d60..51565ee5 100644
--- a/docs/design-decisions/0020-reduction-aware-inliner.md
+++ b/docs/design-decisions/0020-reduction-aware-inliner.md
@@ -15,6 +15,13 @@
 > implemented here is the **NbE reducer core** (steps 1–2, per the Progress note); the reduction-aware
 > *inlining decision* (step 3) remains future work. So this ADR is **not** superseded — read its
 > whole-program-loop framing (Invariant 1, step 4) as historical context that 0021 overtook.
+>
+> **Update (2026-06-16, → [ADR 0035](0035-sharing-nbe-reduction-aware-inlining.md)):** stage 3 now
+> has a concrete realization in [ADR 0035](0035-sharing-nbe-reduction-aware-inlining.md). Self-compiling
+> `purs-wasm` surfaced that the stage-1/2 NbE core is **itself exponential** for lack of memoization
+> (it recomputes values on every `eval`/`quote` traversal), independent of the fusion motivation
+> here. ADR 0035 sequences the fix: a behaviour-neutral **sharing/memo** pass (the scalability gate)
+> first, then this ADR's reduction-aware inline-or-share **policy** on top.
 
 ## Context
 
diff --git a/docs/design-decisions/0035-sharing-nbe-reduction-aware-inlining.md b/docs/design-decisions/0035-sharing-nbe-reduction-aware-inlining.md
new file mode 100644
index 00000000..d2f6ece1
--- /dev/null
+++ b/docs/design-decisions/0035-sharing-nbe-reduction-aware-inlining.md
@@ -0,0 +1,189 @@
+# 0035. Sharing/memoizing the NbE reducer, then reduction-aware inlining
+
+- Status: Proposed
+- Date: 2026-06-16
+
+> Realizes **stage 3** of [ADR 0020](0020-reduction-aware-inliner.md) (whose NbE core landed as
+> stages 1–2). [ADR 0020](0020-reduction-aware-inliner.md) motivated reduction-aware inlining from
+> *fusion* programs; this record adds a second, independently sufficient motivation discovered by
+> self-compilation — the NbE reducer is **itself exponential** for lack of sharing — and sequences
+> the fix so the scalability gate is opened *before* the inline-policy rewrite.
+
+## Context
+
+Compiling `purs-wasm` with itself (806 modules in `output/`, 286 reachable from `Main` — vs the
+`metatheory` bench's ~250 small modules) wedged the optimizer: the build hangs (100% reproducible,
+high memory) inside `MiddleEnd.runOpt` while optimizing the **`Optimize.Specialize`** module
+(module 261/286). Toggling `DictElim.useNbE = false` makes the hang vanish (it is then replaced by
+an unrelated stack overflow in `Impurify` — a separate, tracked bug), which isolates the hang to
+the **NbE reducer** (`MiddleEnd.Optimize.Semantics`, [ADR 0020](0020-reduction-aware-inliner.md)).
+With a raised heap it does not OOM — it stops contracting and spins — so the defect is **time/work
+exponential**, not a memory leak.
+
+The root cause is a single property: **the NbE reducer never memoizes — it recomputes a value on
+every traversal.** It surfaces along two paths.
+
+- **M1 — `eval` re-evaluates an inline binding at every use site.** `Semantics.purs` `evalVar`:
+
+  ```purescript
+  | Just body <- Map.lookup k ctx.inline ->
+      if Set.member k visited then SNeu (NTop q) else go (Set.insert k visited) Map.empty body
+  ```
+
+  Every reference to an inline-set top-level binding re-runs `eval` over its whole `body`. The
+  inline set is acyclic by construction (`DictElim.buildCtx`: `acceptHelper` drops any candidate that
+  references another candidate; `isCandidate` excludes self-recursion) but it **admits diamonds**
+  `f → {g, h} → … → E`, so `E` is evaluated once per path = Θ(2^depth). A *neutral* `case`
+  compounds this: `evalCase` evaluates **every** alternative (`map (evalAlt …) alts`), so with
+  branching `k` the cost is Θ(k^depth) on nested-case-in-lambda — exactly the shape of the
+  recursion-scheme code in `Optimize.Specialize` / `Impurify`.
+
+- **M2 — `quote` re-evaluates shared values.** `quote (SLam ps fn)` reifies a lambda by *applying*
+  it to fresh neutrals — `fn (map (SNeu <<< NLocal) ps')` — which runs `eval` over the body again;
+  `SLet`/`SLetRec` likewise re-invoke their continuation. `quote` keeps no memo, so a value reached
+  along *n* paths of the semantic DAG is re-quoted (and its lambda bodies re-evaluated) *n* times.
+
+These compose: **memoizing eval (M1) alone is insufficient**, because even after eval produces a
+shared DAG, `quote` still walks every path of that DAG and re-quotes the shared bottom node an
+exponential number of times. Killing the exponential requires sharing in **both** eval and quote.
+
+This is the same non-contraction [ADR 0020](0020-reduction-aware-inliner.md) found via CPS fusion,
+seen from the other side: there the *inliner* duplicated a diamond's leaf `2^depth` times in the
+**output**; here the *reducer* duplicates the **work** of building it. [ADR 0020](0020-reduction-aware-inliner.md)
+already establishes that a size/use threshold cannot fix the inlining (the State/dict collapses and
+the fusion explosion have identical size/use profiles; the discriminator is *whether the inline
+reduces*). The present record takes that as given and focuses on **how** to realize the
+sharing-and-reduction-awareness against the actual `Semantics` shapes.
+
+`normalize` runs **per top-level declaration** (`DictElim.reduce`), twice in `localOpt`
+(simplify-with-inline → impurify → simplify-without-inline) and once in `finalizeModule`. The
+exponential lives entirely **within a single `normalize` of a single declaration**, so any memo
+table is scoped to one `normalize` call; no cross-call sharing is needed.
+
+## Decision
+
+**Make the NbE reducer share rather than recompute, in two stages, and only then move the
+inline-vs-share *decision* into `quote` (the [ADR 0020](0020-reduction-aware-inliner.md) stage-3
+policy).** Separating *sharing* (a behaviour-neutral scalability fix) from *policy* (a deliberate
+output change) lets the self-host gate open under the strong byte-equal guarantee, ahead of the
+riskier policy rewrite.
+
+### Layer A — memoized semantic environment (removes M1; behaviour-neutral)
+
+Evaluate each inline-set binding **once** per `normalize` call and share the resulting `Sem` at all
+use sites (a lazily-forced `Map String Sem` / memo table). An *in-progress* set replaces the
+per-path `visited` set: a reference to a binding currently being forced stays `SNeu (NTop q)`
+(a call), which breaks any residual self/mutual reference. Because the inline set is acyclic,
+keying the memo by binding name alone is sound — a diamond returns the same shared `Sem` on every
+path, independent of the path taken. The set of bindings that unfold is unchanged; they are merely
+not recomputed. Expected output: byte-identical modulo binder naming.
+
+### Layer B — sharing-preserving `quote` (removes M2): memo + join points
+
+Memoize `quote` by **`Sem` value identity**: the first time a shared value is quoted it is bound
+**once** to a fresh `let` and every further occurrence emits a reference (classic CSE); an `SLam`
+is applied-to-neutrals and quoted a single time, its result fixed to that `let`. For a neutral
+`NCase` whose **continuation** is shared across branches, the continuation is lifted to a *join
+point* (`let`-bound, referenced from each branch) rather than duplicated — the MIR-level analogue
+of the argument-position join points lowering already uses ([ADR 0022](0022-join-points-for-case-in-argument-position.md)).
+A + B together make `normalize` polynomial; **this is the gate** — once it lands, the default
+(`useNbE = true`) self-host path stops exploding.
+
+The identity mechanism (reference equality vs. ids assigned during `eval`) is an implementation
+choice settled at build time; the requirement is only that two references to the *same* evaluated
+value quote to the *same* shared binding.
+
+### Layer C — reduction-aware inline/share (the [ADR 0020](0020-reduction-aware-inliner.md) policy)
+
+On the sharing base, replace the syntactic gates (`Semantics.inlineLet`, and the
+unconditional unfold in `evalVar`) with the reduction-aware decision: **unfold/inline a reference
+exactly when, in its continuation context, it reduces**; otherwise keep it shared (a retained
+`SLet`, or for a top-level binding a plain call `NTop`, never a copy). "Reduces" is decided from
+the use site's spine:
+
+- a lambda applied to saturating arguments → β fires;
+- a record/dictionary under an `Accessor` → projection fires;
+- a known constructor under a `case` scrutinee → known-case fires;
+- a variable alias / literal / a partial application that saturates to an intrinsic → trivial;
+- otherwise (a closure or constructor used as a value, an under-application) → **does not reduce →
+  share**.
+
+This needs the use-site continuation threaded into `eval` (the purs-backend-es `shouldInline` /
+spine approach). It both lands the fusion win [ADR 0020](0020-reduction-aware-inliner.md) targets
+and prevents diamonds from forming in the first place (a leaf is inlined only where it fires,
+called elsewhere), reducing the pressure on Layer B's sharing.
+
+### Invariants carried over (the risk surface)
+
+Per [ADR 0020](0020-reduction-aware-inliner.md) §"What must be carried over carefully", unchanged
+here:
+
+- **Effects ([ADR 0015](0015-effect-native-support.md) / [ADR 0019](0019-faithful-effect-lowering.md)).**
+  `performSem` / `NPerform` stay barriers. Memoization only touches the *pure* inline set
+  (effectful bindings are not inline candidates and stay neutral); a retained shared `let`
+  preserves single evaluation, so no `Perform` is dropped, duplicated, or reordered.
+- **TCE enablers.** `quote`'s `mergeAbs` and `floatAbsOutOfCase` still run; the reduction-aware
+  path emits saturated applications, which must still quote into the merged, arity-correct form so
+  lambda lifting + TCE fire.
+- **Recursion.** Recursive bindings are never unfolded — the in-progress set (Layer A) plus the
+  acyclic inline set guarantee it.
+- **Capture.** `quote`'s `fresh` discipline is retained; shared `let`s use fresh names.
+
+## Consequences
+
+- **The default-path self-host scalability gate opens at the end of Layer B** — `normalize`
+  becomes polynomial, so the `Optimize.Specialize`-class modules compile. This is the gating fix
+  among the self-host blockers (the others — `Impurify` stack-safety, the whole-program memory
+  floor, and lowering's super-linear passes — are independent and tracked separately).
+- **Sharing is separable from policy.** Layers A+B are behaviour-neutral scalability fixes
+  verifiable against the strict byte-equal gate; only Layer C deliberately changes output (and is
+  guarded by the fusion-converges + collapses-intact criteria of
+  [ADR 0020](0020-reduction-aware-inliner.md)).
+- **Quote may introduce more `let`s** (shared values that were previously copied). This is the
+  intended contraction; it interacts with lowering's own sharing and must not regress the tuned
+  collapses, which the bench gate checks.
+- It remains a central change to the optimizer core; staging keeps each step independently
+  verifiable, and [ADR 0020](0020-reduction-aware-inliner.md)'s blast-radius caveat stands.
+
+### Plan (each step gated: e2e + unit green, the 10-benchmark baseline — `countEffect` / `curry` /
+`mapFoldArray` are the fragile ones — unchanged, and the bench wasm byte-equal modulo `$specN`/`$q`
+renaming, the [ADR 0032](0032-caller-homed-specialization-for-incremental-builds.md) gate)
+
+1. **Layer A** — memoize inline-binding evaluation. Behaviour-neutral. Added gate: the self-host
+   `output/` build (286 modules from `Main`) reaches and **completes** the `Optimize.Specialize`
+   module in polynomial time, and a synthetic depth-*d* diamond inline DAG normalizes in O(*d*),
+   not O(2^*d*) (a new unit test, the exponential regression guard).
+2. **Layer B** — memoized/sharing `quote` + join points. `normalize` is polynomial; the default
+   self-host path no longer explodes.
+3. **Layer C** — reduction-aware inline/share. Fusion converges and shrinks; the State / dictionary
+   / comparison / Effect collapses stay intact.
+4. Demote the round/pass caps to a pure backstop (largely already gone under
+   [ADR 0021](0021-streaming-dependency-ordered-wpo.md)'s single-pass loop).
+
+An interim **total-size budget backstop** (stop unfolding once a term exceeds N× its input) can be
+landed before step 1 if the gate must open immediately; it is a safety net, not the fix, and is
+removed once Layer B lands.
+
+## Alternatives considered
+
+- **Memoize `eval` only (Layer A alone).** Insufficient: `quote` still walks every path of the
+  shared DAG and re-quotes the diamond leaf exponentially (M2). A is necessary, not sufficient.
+- **Go straight to the reduction-aware policy (Layer C first).** It would also prevent the
+  diamonds, but it is the largest, output-changing rewrite and needs the spine machinery; landing
+  it first couples the scalability gate to a risky policy change. Sharing-first opens the gate under
+  byte-equality and de-risks C. (Not chosen for the first cut.)
+- **Size/use threshold instead of reduction-awareness.** Rejected in
+  [ADR 0020](0020-reduction-aware-inliner.md): the collapses and the explosion share size/use
+  profiles. (Retained only as the interim backstop above.)
+- **Make the traversals iterative (stack-safe `descend`/`quote`).** Addresses a *stack-overflow*
+  failure mode, not this *exponential-work* one; orthogonal (and the subject of the separate
+  `Impurify` stack-safety fix). Deferred per [ADR 0020](0020-reduction-aware-inliner.md).
+
+## References
+
+- [ADR 0020](0020-reduction-aware-inliner.md) — reduction-aware inliner (parent; this realizes its stage 3)
+- [ADR 0005](0005-high-level-optimization-ir.md) — the optimization IR and `Simplify`
+- [ADR 0021](0021-streaming-dependency-ordered-wpo.md) — dependency-ordered single-pass optimization (the loop `normalize` runs in)
+- [ADR 0022](0022-join-points-for-case-in-argument-position.md) — join points for case in argument position (the lowering analogue of Layer B's continuation sharing)
+- [ADR 0015](0015-effect-native-support.md) / [ADR 0019](0019-faithful-effect-lowering.md) — the Effect barriers `eval`/`quote` must preserve
+- [ADR 0032](0032-caller-homed-specialization-for-incremental-builds.md) — the byte-equal-modulo-rename verification gate reused here
diff --git a/docs/design-decisions/README.md b/docs/design-decisions/README.md
index e2948931..1af438b4 100644
--- a/docs/design-decisions/README.md
+++ b/docs/design-decisions/README.md
@@ -82,6 +82,7 @@ language and are kept out of version control.)
 | 0032 | [Caller-homed specialization for per-module, incremental builds](0032-caller-homed-specialization-for-incremental-builds.md) | Accepted |
 | 0033 | [Shipping `ulib` as precompiled MIR (`.pmo`) artifacts](0033-precompiled-ulib-pmo-artifacts.md) | Proposed |
 | 0034 | [Split the module cache into `.pmi` interface and `.pmo` object](0034-pmi-interface-pmo-object-split.md) | Accepted |
+| 0035 | [Sharing/memoizing the NbE reducer, then reduction-aware inlining](0035-sharing-nbe-reduction-aware-inlining.md) | Proposed |
 
 ## Scope
 
@@ -98,7 +99,9 @@ runs on wasm. See [`docs/developers-guide/supported-features.md`](../developers-
 Current frontiers, tracked by the records above: streaming / incremental codegen (ADR 0021
 Phase 2 — reachability pruning and dependency-ordered single-pass optimization shipped; the
 **`.pmi`/`.pmo` incremental build cache** — default-on, decode-free for unchanged modules —
-shipped too, ADR 0032 phase 4 / ADR 0034); the reduction-aware inline-or-share selection
-(ADR 0020 — the NbE core is implemented, the reduction-driven decision is not); `wasi` packaging
+shipped too, ADR 0032 phase 4 / ADR 0034); a sharing/memoizing NbE reducer and the reduction-aware
+inline-or-share selection (ADR 0020's NbE core is implemented; ADR 0035 sequences the sharing fix
+that makes the reducer non-exponential — the self-compilation scalability gate — ahead of the
+reduction-driven decision, neither of which has landed); `wasi` packaging
 and the browser runtime/app split (ADR 0025 — `node` / `browser` / `standalone` packaging and `-E`
 have shipped); precompiled-`ulib` distribution (ADR 0033); and monomorphization.

From 715cca4ecb292d92560a80a479790dc2832155bb Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 13:37:12 +0900
Subject: [PATCH 06/16] [Refactor] FreeVars: drop the WeakMap memoization of
 rawFreeVars

---
 .../Backend/Wasm/MiddleEnd/FreeVars.js          | 14 --------------
 .../Backend/Wasm/MiddleEnd/FreeVars.purs        | 17 ++++-------------
 2 files changed, 4 insertions(+), 27 deletions(-)
 delete mode 100644 compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.js

diff --git a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.js b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.js
deleted file mode 100644
index f3826459..00000000
--- a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.js
+++ /dev/null
@@ -1,14 +0,0 @@
-// Memoize a function of an `M.Expr` by reference identity (a `WeakMap`), so the
-// bound-agnostic free-variable computation visits each shared MIR node at most once
-// across all callers (lambda lifting and the lowering's closure conversion both
-// re-query it). Keys are GC'd with the expressions, so the cache adds no retention.
-export const unsafeMemoExpr = (f) => {
-  const cache = new WeakMap();
-  return (x) => {
-    const hit = cache.get(x);
-    if (hit !== undefined) return hit;
-    const v = f(x);
-    cache.set(x, v);
-    return v;
-  };
-};
diff --git a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs
index 15210065..2ee8c9e4 100644
--- a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs
+++ b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/FreeVars.purs
@@ -24,10 +24,8 @@ import PureScript.CoreFn (Binder(..), Literal(..), Qualified(..))
 -- | it must be deterministic.
 -- |
 -- | Computed as the *scope-independent* free set (`rawFreeVars`) minus the given
--- | `bound`. The raw set is the same for every caller of a given node regardless of
--- | their `bound`, so memoizing it (below) lets lowering re-query a nested lambda's
--- | body without re-walking it once per enclosing lambda — the difference between
--- | O(n²) and O(n) on the deeply-nested bodies large modules produce.
+-- | `bound` — splitting out the bound-independent part keeps the result identical for
+-- | every caller of a node regardless of their `bound`.
 freeVars :: Array String -> M.Expr -> Array String
 freeVars bound = case Array.null bound of
   true -> rawFreeVars
@@ -39,11 +37,9 @@ freeVars bound = case Array.null bound of
 
 -- | The free variables of an expression with *nothing* externally bound, in
 -- | first-appearance order with duplicates removed at every node (so the result is
--- | small and the global first-appearance order is preserved). Memoized by node
--- | identity (`unsafeMemoExpr`): a shared MIR subtree — e.g. a lambda body that the
--- | enclosing lambda's analysis already visited — is computed at most once.
+-- | small and the global first-appearance order is preserved).
 rawFreeVars :: M.Expr -> Array String
-rawFreeVars = unsafeMemoExpr go
+rawFreeVars = go
   where
   dedup = Array.nub
   go = case _ of
@@ -86,11 +82,6 @@ rawFreeVars = unsafeMemoExpr go
     M.NonRec _ _ e -> [ e ]
     M.Rec rs -> map _.expr rs
 
--- | Memoize a function of an `M.Expr` by reference identity. Observationally pure
--- | (the MIR is immutable and the function is pure), so it is wrapped and never
--- | exported; only the pure `freeVars` is.
-foreign import unsafeMemoExpr :: (M.Expr -> Array String) -> M.Expr -> Array String
-
 -- | The variables a binder brings into scope.
 binderVars :: Binder -> Array String
 binderVars = case _ of

From 605d97ddf6416b1d2236eb15a332df73b3b7f221 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 16:49:26 +0900
Subject: [PATCH 07/16] [Bugfix] Lower/Match: pass stripNewtype through
 as-pattern

---
 .../PureScript/Backend/Wasm/Lower/Match.purs  |  7 +++++-
 .../PureScript/Backend/Wasm/Lower/Common.purs |  4 ++++
 .../PureScript/Backend/Wasm/Lower/Match.purs  | 24 +++++++++++++++++++
 3 files changed, 34 insertions(+), 1 deletion(-)

diff --git a/compiler/src/PureScript/Backend/Wasm/Lower/Match.purs b/compiler/src/PureScript/Backend/Wasm/Lower/Match.purs
index 7b1b18ac..d6faf493 100644
--- a/compiler/src/PureScript/Backend/Wasm/Lower/Match.purs
+++ b/compiler/src/PureScript/Backend/Wasm/Lower/Match.purs
@@ -380,11 +380,16 @@ litOf = case _ of
   _ -> Nothing
 
 -- | Erase newtype constructors: a newtype carries no runtime tag, so `NT b`
--- | matches transparently as `b` on the same occurrence.
+-- | matches transparently as `b` on the same occurrence. Recurse through an
+-- | as-pattern's inner binder too (`x@(NT b)` → `x@b`): `peelNamed` later strips the
+-- | `NamedBinder` and exposes that inner binder as a column without re-stripping it, so
+-- | a newtype left under a `NamedBinder` here would reach `requireCtor` as an
+-- | unregistered constructor.
 stripNewtype :: C.Binder -> C.Binder
 stripNewtype = case _ of
   C.ConstructorBinder ann _ _ subs
     | ann.meta == Just C.IsNewtype, [ sub ] <- subs -> stripNewtype sub
+  C.NamedBinder ann name b -> C.NamedBinder ann name (stripNewtype b)
   other -> other
 
 litPat :: C.Literal C.Binder -> Lower LitPat
diff --git a/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Common.purs b/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Common.purs
index 3cf6b6a5..f76b6e87 100644
--- a/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Common.purs
+++ b/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Common.purs
@@ -126,6 +126,10 @@ nullBinder = CF.NullBinder ann
 varBinder :: String -> CF.Binder
 varBinder = CF.VarBinder ann
 
+-- | An as-pattern binder `name@inner`.
+namedBinder :: String -> CF.Binder -> CF.Binder
+namedBinder name inner = CF.NamedBinder ann name inner
+
 -- | An `Int`-literal binder `n` (the pattern shape inside a multi-scrutinee case).
 intLitBinder :: Int -> CF.Binder
 intLitBinder n = CF.LiteralBinder ann (CF.LitInt n)
diff --git a/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Match.purs b/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Match.purs
index 36f1d5db..ce5dc6fa 100644
--- a/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Match.purs
+++ b/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Match.purs
@@ -32,6 +32,7 @@ import Test.Unit.PureScript.Backend.Wasm.Lower.Common
   , litSwitchOf
   , lower
   , lv
+  , namedBinder
   , newtypeBinder
   , nullBinder
   , projFieldIndices
@@ -92,6 +93,29 @@ spec = describe "PureScript.Backend.Wasm.Lower.Match (decision trees)" do
           Array.length (switchScrutinees fn.body) `shouldEqual` 1
           projFieldIndices fn.body `shouldEqual` [ 0 ]
 
+  it "erases a newtype constructor wrapped in an as-pattern (x@(NT v))" do
+    -- newtype NT = NT Int ; f w = case w of x@(NT v) -> v
+    -- The as-pattern binds `x` to the scrutinee and the newtype `NT` is erased, so
+    -- `v` is bound to the same occurrence: the whole match is irrefutable, no switch.
+    -- Regression for the `--no-opt` lowering hole where `stripNewtype` skipped past a
+    -- `NamedBinder` and `peelNamed` then exposed the newtype ctor unstripped, so it
+    -- reached `requireCtor` and failed with `UnknownConstructor`.
+    let
+      decls =
+        [ def "f"
+            ( lam "w"
+                ( caseOf (lv "w")
+                    [ binderAlt (namedBinder "x" (newtypeBinder "NT" [ varBinder "v" ])) (lv "v") ]
+                )
+            )
+        ]
+    case lower decls of
+      Left err -> fail (show err)
+      Right prog -> case exported "f" prog of
+        Nothing -> fail "expected an exported function f"
+        Just fn ->
+          Array.length (switchScrutinees fn.body) `shouldEqual` 0
+
   it "compiles an exhaustive constructor match to a Switch with no default" do
     -- data Ty = A | B ; f x = case x of A -> 1 ; B -> 2
     let

From 4ca41569beee633142156d230b4affc1db88fb26 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 16:55:36 +0900
Subject: [PATCH 08/16] [Bugfix] MiddleEnd,Lower: handle recursive-let function
 forms the middle-end normally normalizes (--no-opt)

---
 .../src/PureScript/Backend/Wasm/Lower.purs    | 72 +++++++++++++----
 .../Unit/PureScript/Backend/Wasm/Lower.purs   | 77 ++++++++++++++++++-
 .../PureScript/Backend/Wasm/Lower/Common.purs |  4 +
 3 files changed, 136 insertions(+), 17 deletions(-)

diff --git a/compiler/src/PureScript/Backend/Wasm/Lower.purs b/compiler/src/PureScript/Backend/Wasm/Lower.purs
index 54b43630..5eb07ba9 100644
--- a/compiler/src/PureScript/Backend/Wasm/Lower.purs
+++ b/compiler/src/PureScript/Backend/Wasm/Lower.purs
@@ -52,7 +52,7 @@ import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..), fst, snd)
 import Foreign.Object (Object)
 import Foreign.Object as Object
-import PureScript.Backend.Wasm.Intrinsics (qualifiedIntrinsic, foreignIntrinsic)
+import PureScript.Backend.Wasm.Intrinsics (Intrinsic(MkEffectFn), qualifiedIntrinsic, foreignIntrinsic)
 import PureScript.Backend.Wasm.Lower.Collect (collectCtors, collectDictCtors, collectEnumCtors, collectFuncs, collectLabels, functionDecls, reachableFunctions)
 import PureScript.Backend.Wasm.Lower.Env (Env)
 import PureScript.Backend.Wasm.Lower.IR (Atom(..), AnfExpr(..), ForeignImport, FuncName(..), IRFunc, MarshalKind(..), Program, RecBind(..), Rep(..), Rhs(..), Slot(..), VarRef(..))
@@ -428,7 +428,7 @@ lowerCoreLetK env binds body finish = case Array.uncons binds of
       lowerCoreLetK (env { locals = Object.insert ident atom env.locals }) tail body finish
   Just { head: Rec recBinds, tail } -> case recBinds of
     [ r ]
-      | M.Abs params recBody <- r.expr
+      | M.Abs params recBody <- recBindFunctionForm r.expr
       , Just { head: param, tail: rest } <- Array.uncons params -> do
           { codeName, captures } <- liftLambda (Just r.ident) env param (reAbs rest recBody)
           bindRhs (RMkClosure codeName captures) \fAtom ->
@@ -451,32 +451,72 @@ lowerCoreLetK env binds body finish = case Array.uncons binds of
 -- | already bound to its slot, so sibling references become forward references for
 -- | the `LetRec` to patch.
 lowerRecBind :: Env -> Tuple M.RecBinding Slot -> Lower RecBind
-lowerRecBind env (Tuple rb slot) = case rb.expr of
+lowerRecBind env (Tuple rb slot) = case recBindFunctionForm rb.expr of
   M.Abs params recBody
     | Just { head: param, tail: rest } <- Array.uncons params -> do
         { codeName, captures } <- liftLambda Nothing env param (reAbs rest recBody)
         pure (RecBind slot codeName captures)
   -- A point-free recursive *function* (e.g. purescript-run's `loop = resume f pure`): not a
-  -- syntactic lambda, but a known callable applied below its arity, so it is in fact a function.
-  -- Eta-expand it to a saturated lambda (`\x -> e x`) — sound by the eta law, since it has positive
-  -- residual arity — and lower through the normal Abs path above. Genuine recursive *values*
-  -- (residual arity 0, e.g. a self-referential `Tuple`/`data`) do not match and fall through to the
-  -- error; a cyclic top-level value is instead handled by CAF globalization (ADR 0006, `FibAnd`).
-  _
-    | Just residual <- recBindResidualArity env rb.expr
-    , residual >= 1 ->
-        lowerRecBind env (Tuple (rb { expr = etaExpand rb.expr residual }) slot)
+  -- syntactic lambda, but a known callable whose (partial or saturated-returning-a-function)
+  -- application is in fact a function. Eta-expand it (`\x -> e x`, sound by the eta law) and lower
+  -- through the normal Abs path above. A saturated *constructor* application is genuine recursive
+  -- data, not a function, so `recBindEtaArity` returns `Nothing` and it falls through to the error
+  -- (a cyclic top-level value is instead handled by CAF globalization — ADR 0006, `FibAnd`).
+  peeled
+    | Just etaN <- recBindEtaArity env peeled ->
+        lowerRecBind env (Tuple (rb { expr = etaExpand peeled etaN }) slot)
   _ -> throw (UnsupportedExpr ("a recursive let binding must be a function: " <> rb.ident))
 
+-- | Normalise a recursive `let` binding's defining expression toward the syntactic lambda it
+-- | denotes, so the `LetRec` machinery recognises it as a function:
+-- |
+-- |   * peel `Data.Function.Uncurried.mkFnN` / `Effect.Uncurried.mkEffectFnN`, which are the
+-- |     identity (the uncurried value *is* the curried `$Clo`, ADR 0018; an *applied* `mkFnN`
+-- |     lowers to the `RPrim MkEffectFn` no-op) — e.g. `Data.Map.Internal`'s `mkFn2`-wrapped folds;
+-- |   * float a `let` whose body is a function inward — `let H in \xs -> b` becomes
+-- |     `\xs -> let H in b`. Sound for this strict, pure IR: `H` was bound outside the lambda so
+-- |     it cannot capture `xs`, and re-evaluating its (pure) bindings per call only forgoes
+-- |     sharing — e.g. the `let goLit … in \v -> case v of …` a `where`-helper-rich recursive
+-- |     worker compiles to.
+-- |
+-- | The middle-end normalises both, so only the `--no-opt` path reaches lowering with one intact.
+recBindFunctionForm :: M.Expr -> M.Expr
+recBindFunctionForm = case _ of
+  M.App (M.Var q) [ inner ]
+    | Just (Tuple MkEffectFn _) <- qualifiedIntrinsic (qualifiedKeyOf q) -> recBindFunctionForm inner
+  M.Let binds body
+    | M.Abs params inner <- recBindFunctionForm body -> M.Abs params (M.Let binds inner)
+  other -> other
+
 -- | The residual arity of a non-lambda binding RHS: a known callable (function / constructor /
 -- | intrinsic / foreign) applied to fewer arguments than its arity still denotes a function, of
 -- | the leftover arity. `Nothing` when the head's arity is unknown — then we cannot prove it is a
 -- | function, so the caller keeps the conservative "must be a function" error.
-recBindResidualArity :: Env -> M.Expr -> Maybe Int
-recBindResidualArity env = case _ of
-  v@(M.Var _) -> headArity env v
-  M.App h args -> (_ - Array.length args) <$> headArity env h
+-- | The number of parameters to eta-expand a non-lambda recursive binding by, turning it into a
+-- | syntactic function — or `Nothing` if the binding denotes a value rather than a function.
+-- |
+-- | A *partial* application is always a function: eta by its residual arity (`Cons 1`, `resume f`).
+-- | A *saturated* (or over-) application splits on the head. A constructor builds data, so a
+-- | saturated `Ctor …` is a genuine recursive *value* — a cyclic *local* data binding would diverge
+-- | under strict evaluation, so the only real case is a top-level CAF (handled by globalization,
+-- | ADR 0006); reject it here. A function's result is itself a value that, for a non-diverging local
+-- | recursive `let`, must be a function (e.g. `loop = resume f pure`, whose result type is a
+-- | function), so eta-expand by one to apply it — `lowerApp`'s over-application path does the rest.
+recBindEtaArity :: Env -> M.Expr -> Maybe Int
+recBindEtaArity env = case _ of
+  M.Var q -> etaArity q 0
+  M.App (M.Var q) args -> etaArity q (Array.length args)
   _ -> Nothing
+  where
+  etaArity q@(Qualified (Just _) ident) nargs
+    | Just info <- Object.lookup (qualifiedKeyOf q) env.ctors =
+        let residual = info.arity - nargs in if residual >= 1 then Just residual else Nothing
+    | Just arity <- funcArity q ident = Just (max 1 (arity - nargs))
+  etaArity _ _ = Nothing
+  funcArity q ident =
+    Object.lookup (qualifiedKeyOf q) env.knownFuncs
+      <|> (snd <$> (qualifiedIntrinsic (qualifiedKeyOf q) <|> foreignIntrinsic ident))
+      <|> ((Array.length <<< _.params) <$> Object.lookup (qualifiedKeyOf q) env.foreignSigs)
 
 -- | The declared arity of an application head, resolved the same way `lowerApp` dispatches a call:
 -- | a constructor, a top-level/specialized function, an intrinsic, or a foreign import.
diff --git a/compiler/test/Unit/PureScript/Backend/Wasm/Lower.purs b/compiler/test/Unit/PureScript/Backend/Wasm/Lower.purs
index 3739a4ee..789fbdaf 100644
--- a/compiler/test/Unit/PureScript/Backend/Wasm/Lower.purs
+++ b/compiler/test/Unit/PureScript/Backend/Wasm/Lower.purs
@@ -16,7 +16,7 @@ import PureScript.Backend.Wasm.Lower.IR (Atom(..), FuncName(..), LitPat(..), Mar
 import PureScript.CoreFn as CF
 import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (fail, shouldEqual)
-import Test.Unit.PureScript.Backend.Wasm.Lower.Common (allRhs, ann, appE, blockAtoms, boolAlt, caseOf, closureCaptures, ctor, ctorAlt, def, dictCtorDecl, exportOf, exported, intAlt, isApply, isCallForeign, isPrim, lam, letRec2, liftedFuncs, litInt, litObj, litStr, litSwitchOf, lower, lowerForeign, lowerMany, lv, mkDataTags, newtypeCase, objUpdate, objUpdatePoly, projLabelIds, recSetLabelIds, qv, qvIn, recAlt, recordLabelIds, strAlt, switchOf, switchScrutinees, hasSwitch, accessor, varBinder, arrayLengths, callKnownArities, callKnownNames, countLitSwitches, letRecOf, case2, ctorBinder, alt2, nullBinder, wildAlt, moduleNamed)
+import Test.Unit.PureScript.Backend.Wasm.Lower.Common (allRhs, ann, appE, blockAtoms, boolAlt, caseOf, closureCaptures, ctor, ctorAlt, def, dictCtorDecl, exportOf, exported, intAlt, isApply, isCallForeign, isPrim, lam, letE, letRec, letRec2, liftedFuncs, litInt, litObj, litStr, litSwitchOf, lower, lowerForeign, lowerMany, lv, mkDataTags, newtypeCase, objUpdate, objUpdatePoly, projLabelIds, recSetLabelIds, qv, qvIn, recAlt, recordLabelIds, strAlt, switchOf, switchScrutinees, hasSwitch, accessor, varBinder, arrayLengths, callKnownArities, callKnownNames, countLitSwitches, letRecOf, case2, ctorBinder, alt2, nullBinder, wildAlt, moduleNamed)
 
 -- A function with a capturing lambda applied immediately:
 -- `f a b = (\y -> intAdd a y) b`. The lambda captures `a`.
@@ -122,6 +122,81 @@ spec = describe "PureScript.Backend.Wasm.Lower (lowering)" do
             -- two members, each capturing exactly its sibling
             Just rbs -> map (\(RecBind _ _ env) -> Array.length env) rbs `shouldEqual` [ 1, 1 ]
 
+    -- The next three are recursive-`let` shapes the middle-end normally normalizes, so only
+    -- the `--no-opt` lowering path meets them; each used to raise
+    -- `UnsupportedExpr "a recursive let binding must be a function"`.
+    it "lowers a recursive let whose body is a mkFnN-wrapped lambda" do
+      -- f x = let go = mkFn2 (\a b -> go) in go
+      -- `mkFn2` / `mkEffectFnN` are the identity (ADR 0018) — the uncurried value *is* the
+      -- curried closure — so `go` is a function and lowering peels the wrapper.
+      let
+        f = def "f"
+          ( lam "x"
+              ( letRec "go"
+                  (appE (qvIn "Data.Function.Uncurried" "mkFn2") (lam "a" (lam "b" (lv "go"))))
+                  (lv "go")
+              )
+          )
+      case lower [ f ] of
+        Left err -> fail (show err)
+        Right prog -> case exported "f" prog of
+          Nothing -> fail "expected an exported function f"
+          Just _ -> pure unit
+
+    it "lowers a recursive let whose body is a let-wrapped lambda" do
+      -- f x = let descend = (let h = \w -> w in \v -> descend (h v)) in descend
+      -- The `let` is floated into the lambda (`let H in \v -> b` ⟹ `\v -> let H in b`), so
+      -- `descend` is a function.
+      let
+        f = def "f"
+          ( lam "x"
+              ( letRec "descend"
+                  ( letE "h" (lam "w" (lv "w"))
+                      (lam "v" (appE (lv "descend") (appE (lv "h") (lv "v"))))
+                  )
+                  (lv "descend")
+              )
+          )
+      case lower [ f ] of
+        Left err -> fail (show err)
+        Right prog -> case exported "f" prog of
+          Nothing -> fail "expected an exported function f"
+          Just _ -> pure unit
+
+    it "eta-expands a saturated point-free recursive function" do
+      -- resume k j = k (arity 2) ; f x = let loop = resume (\a -> loop a) 0 in loop
+      -- `resume …` is saturated (residual 0) but its result is a function, so `loop` is a
+      -- function and is eta-expanded to `\z -> resume … z`.
+      let
+        resume = def "resume" (lam "k" (lam "j" (lv "k")))
+        f = def "f"
+          ( lam "x"
+              ( letRec "loop"
+                  (appE (appE (qv "resume") (lam "a" (appE (lv "loop") (lv "a")))) (litInt 0))
+                  (lv "loop")
+              )
+          )
+      case lower [ resume, f ] of
+        Left err -> fail (show err)
+        Right prog -> case exported "f" prog of
+          Nothing -> fail "expected an exported function f"
+          Just _ -> pure unit
+
+    it "rejects a saturated recursive constructor application as a value, not a function" do
+      -- data L = Nil | Cons Int L ; f x = let xs = Cons 1 xs in xs
+      -- A *saturated* constructor builds data, so `xs` is a genuine recursive value (a cyclic
+      -- local value would diverge; a top-level one is a CAF, ADR 0006) — not a function, so
+      -- lowering must reject it rather than eta-expand a non-function.
+      let
+        decls =
+          [ ctor "L" "Nil" []
+          , ctor "L" "Cons" [ "h", "t" ]
+          , def "f" (lam "x" (letRec "xs" (appE (appE (qv "Cons") (litInt 1)) (lv "xs")) (lv "xs")))
+          ]
+      case lower decls of
+        Left _ -> pure unit
+        Right _ -> fail "expected lowering to reject a saturated recursive constructor as a value"
+
   describe "data types" do
     it "assigns constructor tags by declaration order and erases the constructors" do
       -- data D = A | B Int ; mkA = A ; mkB x = B x
diff --git a/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Common.purs b/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Common.purs
index f76b6e87..e3db1cfd 100644
--- a/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Common.purs
+++ b/compiler/test/Unit/PureScript/Backend/Wasm/Lower/Common.purs
@@ -61,6 +61,10 @@ letRec2 :: String -> CF.Expr -> String -> CF.Expr -> CF.Expr -> CF.Expr
 letRec2 n1 e1 n2 e2 body =
   CF.Let ann [ CF.Rec [ { ann, ident: n1, expr: e1 }, { ann, ident: n2, expr: e2 } ] ] body
 
+-- | `let name = e in body`, as a single non-recursive `let`.
+letE :: String -> CF.Expr -> CF.Expr -> CF.Expr
+letE name e body = CF.Let ann [ CF.NonRec ann name e ] body
+
 litInt :: Int -> CF.Expr
 litInt n = CF.Literal ann (CF.LitInt n)
 

From e73fea342c32147a80a37d088cf68da476033d15 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 16:57:22 +0900
Subject: [PATCH 09/16] [Perf] MiddleEnd/Lower: improve space-complexity of the
 optimization-free compilation pass

---
 .../PureScript/Backend/Wasm/MiddleEnd.purs    |  7 ++-
 purs-wasm/src/PursWasm/CLI/Build.purs         | 44 ++++++++++++-------
 2 files changed, 34 insertions(+), 17 deletions(-)

diff --git a/compiler/src/PureScript/Backend/Wasm/MiddleEnd.purs b/compiler/src/PureScript/Backend/Wasm/MiddleEnd.purs
index 79271ec0..839a63e6 100644
--- a/compiler/src/PureScript/Backend/Wasm/MiddleEnd.purs
+++ b/compiler/src/PureScript/Backend/Wasm/MiddleEnd.purs
@@ -273,8 +273,11 @@ runOpt dictElim effectfulForeigns effArities cache traceTarget modules =
   if dictElim then { modules: result.finalized, trace: result.trace <> snap "after post-inline specialization" result.finalized, writes: result.writes }
   else { modules: lifted, trace: snap "initial (translated + lifted)" lifted, writes: [] }
   where
-  mir = map (\m -> { name: m.name, decls: map translBind m.decls } :: M.Module) modules
-  lifted = map lambdaLiftModule mir
+  -- Translate and lambda-lift each module in one step (`liftModule`) rather than materializing
+  -- the whole translated-but-unlifted `mir` array first: that intermediate is used nowhere else,
+  -- and holding a second full-program MIR copy alongside `lifted` is a real peak-memory cost on a
+  -- whole-program build (the `--no-opt` front half holds every module's MIR at once).
+  lifted = map liftModule modules
 
   -- Map a binding key to its defining module, over the lifted program — the same relation
   -- `topoOrder` uses for dependency ordering, reused here to scope a module's cache key to
diff --git a/purs-wasm/src/PursWasm/CLI/Build.purs b/purs-wasm/src/PursWasm/CLI/Build.purs
index b63faa31..2204857f 100644
--- a/purs-wasm/src/PursWasm/CLI/Build.purs
+++ b/purs-wasm/src/PursWasm/CLI/Build.purs
@@ -287,21 +287,35 @@ buildCmd cliRoot binaryenBinDir args = do
       -- liftEffect progressEndImpl
       br *> info (Log.blue "Linking (lower + codegen)…")
       liftEffect (finishLink opts roots allSigs foreignNames externs optimized.modules optimized.writes)
-    else do
-      -- Cold / `--no-opt` / `--dump-mir`: decode every module (no decode-free reuse).
-      info (Fmt.fmt @"Compiling {count} module(s)…" { count: Array.length srcInfos })
-      decodedModules <- map Array.catMaybes $ for srcInfos \i -> case parseModule i.src of
-        Left err -> logAndThrow (i.name <> ": " <> err)
-        Right m -> pure (Just m)
-      either logAndThrow pure (checkWasmBaseCompat decodedModules)
-      either logAndThrow pure (checkCorefnVersions decodedModules)
-      case args.dumpMir of
-        Nothing -> pure unit
-        Just target -> do
-          mirPath <- joinPath [ bundleDir, target <> ".mir.txt" ]
-          writeText mirPath (mirTrace opts decodedModules allSigs target)
-          info $ Log.blue ("✓ Wrote MIR trace for " <> target <> " to " <> mirPath)
-      liftEffect (linkModule opts roots decodedModules externs allSigs noCache)
+    else case args.dumpMir of
+      -- `--dump-mir` needs the whole CoreFn for the trace, so keep the decode-everything path
+      -- (a debugging build, where peak memory is not a concern).
+      Just target -> do
+        info (Fmt.fmt @"Compiling {count} module(s)…" { count: Array.length srcInfos })
+        decodedModules <- map Array.catMaybes $ for srcInfos \i -> case parseModule i.src of
+          Left err -> logAndThrow (i.name <> ": " <> err)
+          Right m -> pure (Just m)
+        either logAndThrow pure (checkWasmBaseCompat decodedModules)
+        either logAndThrow pure (checkCorefnVersions decodedModules)
+        mirPath <- joinPath [ bundleDir, target <> ".mir.txt" ]
+        writeText mirPath (mirTrace opts decodedModules allSigs target)
+        info $ Log.blue ("✓ Wrote MIR trace for " <> target <> " to " <> mirPath)
+        liftEffect (linkModule opts roots decodedModules externs allSigs noCache)
+      -- Cold / `--no-opt`: translate + lambda-lift each module and drop its CoreFn before the next,
+      -- so the whole program is never resident as CoreFn *and* MIR at once (copy-reduction — the
+      -- front-half memory floor that blocks self-compilation). `--no-opt` does no whole-program
+      -- optimization, so per-module `liftModule` is the full middle-end; reuse the precomputed
+      -- `foreignNames` and call `finishLink` directly, exactly as the cached path above does.
+      Nothing -> do
+        info (Fmt.fmt @"Compiling {count} module(s)…" { count: Array.length srcInfos })
+        either logAndThrow pure
+          (checkWasmBaseCompat (map (\i -> { name: i.mn, foreignNames: i.foreignNames }) srcInfos))
+        lifted <- map Array.catMaybes $ for srcInfos \i -> case parseModule i.src of
+          Left err -> logAndThrow (i.name <> ": " <> err)
+          Right m -> do
+            either logAndThrow pure (checkCorefnVersions [ m ])
+            pure (Just (liftModule m))
+        liftEffect (finishLink opts roots allSigs foreignNames externs lifted [])
   case linkResult of
     Left err -> logAndThrow err
     Right built -> do

From f0e1c317123773818fb11035773ba5f17cd33d0e Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 16:57:57 +0900
Subject: [PATCH 10/16] [Docs] Reduc-aware Inlining: Update ADR 0035/0036

---
 ...35-sharing-nbe-reduction-aware-inlining.md |   8 +-
 ...36-join-points-for-decision-tree-leaves.md | 159 ++++++++++++++++++
 docs/design-decisions/README.md               |   8 +-
 3 files changed, 170 insertions(+), 5 deletions(-)
 create mode 100644 docs/design-decisions/0036-join-points-for-decision-tree-leaves.md

diff --git a/docs/design-decisions/0035-sharing-nbe-reduction-aware-inlining.md b/docs/design-decisions/0035-sharing-nbe-reduction-aware-inlining.md
index d2f6ece1..3e1482bd 100644
--- a/docs/design-decisions/0035-sharing-nbe-reduction-aware-inlining.md
+++ b/docs/design-decisions/0035-sharing-nbe-reduction-aware-inlining.md
@@ -145,9 +145,11 @@ here:
 - It remains a central change to the optimizer core; staging keeps each step independently
   verifiable, and [ADR 0020](0020-reduction-aware-inliner.md)'s blast-radius caveat stands.
 
-### Plan (each step gated: e2e + unit green, the 10-benchmark baseline — `countEffect` / `curry` /
-`mapFoldArray` are the fragile ones — unchanged, and the bench wasm byte-equal modulo `$specN`/`$q`
-renaming, the [ADR 0032](0032-caller-homed-specialization-for-incremental-builds.md) gate)
+### Plan
+
+Each step is gated by: e2e + unit green; the 10-benchmark baseline unchanged (`countEffect` /
+`curry` / `mapFoldArray` are the fragile ones); and the bench wasm byte-equal modulo `$specN`/`$q`
+renaming (the [ADR 0032](0032-caller-homed-specialization-for-incremental-builds.md) gate).
 
 1. **Layer A** — memoize inline-binding evaluation. Behaviour-neutral. Added gate: the self-host
    `output/` build (286 modules from `Main`) reaches and **completes** the `Optimize.Specialize`
diff --git a/docs/design-decisions/0036-join-points-for-decision-tree-leaves.md b/docs/design-decisions/0036-join-points-for-decision-tree-leaves.md
new file mode 100644
index 00000000..09574370
--- /dev/null
+++ b/docs/design-decisions/0036-join-points-for-decision-tree-leaves.md
@@ -0,0 +1,159 @@
+# 0036. Parameterized join points for decision-tree leaves (kill the match-compilation blowup)
+
+- Status: **Proposed** (de-prioritized — see Update)
+- Date: 2026-06-16
+
+> **Update (2026-06-16): empirically NOT the `--no-opt` fix.** Direct measurement (a
+> `lowerBody` call counter vs static `alternatives` count) found a duplication ratio of only
+> **1.16×** on the 145-module subset that reaches lowering (`lowerBodyCalls=297 /
+> staticAlts=257`, guards included) — no `(B+1)^k` blowup in practice. Decisively, the full
+> `-e Main --no-opt -g` build **OOMs in the front half (decode + translate + MIR lambda-lift),
+> before `lowerModules` runs** (its `setStaticAlts` log never appears), so lowering-internal
+> duplication cannot be the `--no-opt` OOM cause — the process dies before any `AnfExpr` is
+> built. The `--no-opt` blocker is the **front-half whole-program memory floor (the separate
+> bug B)**, not this. This ADR may still matter for the *optimized* path's IR size / Binaryen
+> `-O` input, but only if an actual blowup is measured there; until then it is **not pursued**.
+> (The premise below was reasoned from the code mechanism before this measurement — kept for
+> the record, but superseded by the data.)
+
+## Context
+
+Self-compiling `purs-wasm` with itself surfaced a memory blowup in **lowering** that survives
+with *every* optimizer turned off — `--no-opt -g` (no middle-end, no Binaryen `-O`). Profiling
+the front half (decode → translate → lambda-lift → lower → codegen) showed the live backend IR
+(`Lower.IR.AnfExpr`) reaching **~250–270× the input corefn size** — far above the ~3-copy
+linear floor of holding CoreFn + MIR + backend IR at once. The excess is a single structure:
+the lowered program itself is super-linearly large.
+
+The cause is the **decision-tree compiler** (`Lower.Match`, a Maranget-style matrix
+compiler). It is a known weakness of naive Maranget compilation: **clause bodies are
+re-emitted at every decision-tree leaf they reach**, and a clause whose switched column is a
+variable/wildcard reaches *many* leaves.
+
+### The mechanism (file:line)
+
+- A leaf lowers its clause body by calling the continuation `ops.lowerBody`
+  (`Lower/Match.purs:113`, and `:134` for a guard's `then` expression). `lowerBody` is the
+  `finish` passed by `lowerCaseK` — in **tail** position it is `lowerTail` itself
+  (`Lower.purs:406`, `:515`, `:520-522`). So each leaf **re-lowers the source body into a fresh
+  `AnfExpr`**; there is no sharing of leaf actions.
+- A variable/wildcard row is **copied into every sub-matrix** during specialization:
+  `specializeCtor` keeps a `VarBinder`/`NullBinder` row in *every* constructor branch
+  (`Lower/Match.purs:263-266`), and `defaultMatrix` keeps it in the default branch too
+  (`:250-254`, `defaultRow` `:307-308`). With `B` constructors a wildcard row is duplicated into
+  `B+1` sub-matrices; over `k` consecutive switched columns the clause appears in up to
+  **`(B+1)^k` leaves**, each independently lowering the body.
+- `lowerBody = lowerTail`, so when a duplicated body **itself contains a `case`** (exactly the
+  deeply-`case`-nested ASTs a compiler is made of), its inner decision tree is re-expanded
+  inside every duplicate — the duplication **multiplies with nesting**.
+- A secondary axis: a guarded row recompiles the fallthrough matrix `rest` per row
+  (`Lower/Match.purs:117-119`), so chained guards re-compile the residual matrix in a nest.
+
+This is the same *class* of bug ADR 0022 measured for `genericShow` (one body lowered 18,616
+times), on a different axis. It surfaces now because the compiler's own modules — the parser,
+`Data.Variant`/`Run`, the CLI — match on wide, deeply-nested patterns; small programs and the
+`metatheory` bench do not stress it.
+
+### Why ADR 0022 does not cover it
+
+[ADR 0022](0022-join-points-for-case-in-argument-position.md)'s `LetJoin` shares the **outer
+continuation `k`** of a single *argument-position* `case` — it binds the case's result once so
+`k` is not copied into branches. The duplication here is different in two ways:
+
+1. it is the **inner clause bodies** duplicated across decision-tree *leaves*, not the outer
+   continuation; and
+2. it happens in **tail** position too (`lowerTail → lowerCaseK` never goes through `LetJoin`),
+   which ADR 0022 deliberately left untouched.
+
+Each leaf also binds **different** pattern variables (each leaf's occurrences), so a shared
+clause body must be **parameterized** — ADR 0022's slot-only, argument-less join cannot express
+it.
+
+## Decision
+
+Share each clause body the way Maranget/GHC do: **lower every clause body (and guard
+expression) exactly once into a parameterized join point, and make each decision-tree leaf a
+jump to it, passing that leaf's bound occurrence atoms.** The decision tree becomes a DAG over
+a fixed set of join points instead of a tree of duplicated bodies.
+
+### IR (`Lower.IR`)
+
+Add a parameterized join — the natural generalization of ADR 0022's `LetJoin`:
+
+```purescript
+-- | A group of parameterized join points in scope over `body` (the decision tree). Each join
+-- | `j` binds clause body `B_j` once; its `params` are canonical slots holding the clause's
+-- | pattern variables. The tree reaches a clause via `JoinJump j atoms`, which sets
+-- | `params_j := atoms` and runs `B_j`. `rep` is the value every `B_j` tail produces (the
+-- | case's result rep — the function result in tail position, the ADR 0022 join slot in
+-- | argument position).
+| LetJoins (Array { params :: Array Slot, rep :: Rep, body :: AnfExpr }) AnfExpr
+| JoinJump Int (Array Atom)   -- jump to the i-th join with these argument atoms
+```
+
+(ADR 0022's value-binding `LetJoin Slot Rep producer k` stays as-is for the argument-position
+outer continuation; the two compose — an argument-position `case` is a `LetJoin` whose
+*producer* is a `LetJoins` decision tree.)
+
+### Lowering (`Lower.Match`)
+
+`compile` lowers **each distinct clause once**, up front: bind its pattern variables to fresh
+canonical slots, lower its body (or its guard chain) to an `AnfExpr` in the case's position via
+the existing `finish`, and register it as a join. The matrix compiler then emits, at a leaf, a
+`JoinJump i occs` (the occurrence atoms bound along that leaf's path) instead of calling
+`lowerBody`. A guarded clause's fallthrough becomes a jump to the residual matrix's own join,
+so a chain of guards no longer re-compiles the residual per row. Net: the body of clause `i`
+is lowered **once**, regardless of how many leaves reach it.
+
+### Codegen (`Codegen.purs`)
+
+A `LetJoins` lowers to the standard nested-labeled-block join layout: one `block` label per
+join enclosing the decision tree, with each join body emitted after its block and falling
+through to a shared exit. `JoinJump i atoms` is `(local.set params_i atoms…) (br $join_i)` — a
+jump, not a call, reusing the block/`br` machinery (no closure, no call overhead), consistent
+with ADR 0022's block-based `LetJoin`. Tail position is preserved: a join body generated in
+tail position keeps its `Return` / `return_call`, so the constant-stack tail-recursion
+guarantee (ADR 0015) is unaffected — a `br` into a tail-positioned join body still tail-calls.
+
+### Representation analysis (`Lower.Unbox`)
+
+`LetJoins` / `JoinJump` add one case each to every `AnfExpr` walk (mechanical). Join `params`
+slots start `Boxed` (the universal `eqref` an occurrence already crosses), matching ADR 0022's
+join slot; unboxing them is a later refinement.
+
+## Consequences
+
+- **Decision-tree lowering becomes linear** in (number of clauses + decision-tree size)
+  instead of `(B+1)^k × body`. The `--no-opt -g` backend-IR floor drops to the genuine
+  ~3-copy linear level — the self-compilation memory gate for the `--no-opt` path.
+- **It also shrinks the *optimized* path's backend IR**, so a future default (optimized)
+  self-host hands Binaryen a smaller module — relevant to the separate Binaryen-`-O` memory
+  cost on the single whole-program module ([ADR 0009](0009-build-and-linking-model.md)).
+- **Output changes** (shared bodies via `br` instead of duplicated inline bodies), so this is
+  **not** byte-identical to the prior codegen. Acceptance is the [ADR 0034](0034-pmi-interface-pmo-object-split.md)
+  bar — **build determinism + e2e correctness + no benchmark regression** — not byte-identity.
+- **Tail recursion preserved by construction** (join bodies stay tail-positioned), so the
+  State/Effect/loop benches and ADR 0015's collapse are unaffected.
+- **Independent of [ADR 0035](0035-sharing-nbe-reduction-aware-inlining.md) (NbE).** That fixes
+  the optimizer's exponential *time*; this fixes lowering's exponential *space*. Both are
+  self-compilation scaling gates on different axes.
+- **New IR nodes** touched by every `AnfExpr` traversal (Codegen `genBody` / slot-rep
+  collection, Unbox analyses + rewrite) — one mechanical case each, plus the non-trivial
+  `LetJoins` codegen (nested block layout).
+
+## Alternatives considered
+
+- **Keep duplicating, cap the leaf count / bail.** Turns a blowup into a failed compile; does
+  not compile valid programs.
+- **Lift each clause body to a real (top-level or local) function and `call` it from leaves.**
+  Reuses existing call nodes — no new IR — but a clause body is a `Lower`-level continuation
+  over local occurrences and the surrounding env; lifting it with the right captures mid-match
+  is far more invasive (the same reason ADR 0022 rejected a "join function"), and a `call` is
+  heavier than `local.set` + `br`.
+- **A non-duplicating match compiler** (backtracking automaton / DAG matrices, e.g.
+  Pettersson-style). A larger rewrite of `Lower.Match`; the parameterized join point is the
+  localized, well-understood fix that keeps the Maranget matrix compiler and only shares its
+  leaf actions.
+- **Deduplicate the bodies after lowering** (CSE over `AnfExpr`). The exponential `AnfExpr` is
+  already built (and may not fit memory) before CSE could run — the duplication must be avoided
+  at emission, not repaired after.
diff --git a/docs/design-decisions/README.md b/docs/design-decisions/README.md
index 1af438b4..41f1603d 100644
--- a/docs/design-decisions/README.md
+++ b/docs/design-decisions/README.md
@@ -83,6 +83,7 @@ language and are kept out of version control.)
 | 0033 | [Shipping `ulib` as precompiled MIR (`.pmo`) artifacts](0033-precompiled-ulib-pmo-artifacts.md) | Proposed |
 | 0034 | [Split the module cache into `.pmi` interface and `.pmo` object](0034-pmi-interface-pmo-object-split.md) | Accepted |
 | 0035 | [Sharing/memoizing the NbE reducer, then reduction-aware inlining](0035-sharing-nbe-reduction-aware-inlining.md) | Proposed |
+| 0036 | [Parameterized join points for decision-tree leaves](0036-join-points-for-decision-tree-leaves.md) | Proposed (de-prioritized — measured duplication ~1.16×, not the `--no-opt` floor) |
 
 ## Scope
 
@@ -101,7 +102,10 @@ Phase 2 — reachability pruning and dependency-ordered single-pass optimization
 **`.pmi`/`.pmo` incremental build cache** — default-on, decode-free for unchanged modules —
 shipped too, ADR 0032 phase 4 / ADR 0034); a sharing/memoizing NbE reducer and the reduction-aware
 inline-or-share selection (ADR 0020's NbE core is implemented; ADR 0035 sequences the sharing fix
-that makes the reducer non-exponential — the self-compilation scalability gate — ahead of the
-reduction-driven decision, neither of which has landed); `wasi` packaging
+that makes the reducer non-exponential — the self-compilation scalability *time* gate — ahead of the
+reduction-driven decision, neither of which has landed); the `--no-opt` self-compilation *space*
+gate — the front-half whole-program memory floor (decode + translate + lambda-lift holding all MIR
+at once, ADR 0009), addressed by copy-reduction / streaming, not yet landed (decision-tree leaf
+sharing, ADR 0036, was measured to be ~1.16× and is *not* this floor); `wasi` packaging
 and the browser runtime/app split (ADR 0025 — `node` / `browser` / `standalone` packaging and `-E`
 have shipped); precompiled-`ulib` distribution (ADR 0033); and monomorphization.

From a124f4052d328257eeaad27c064d81c77623e4b3 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 17:13:22 +0900
Subject: [PATCH 11/16] [Bugfix] Codegen: recover stack safety of genBody,
 genSwitch/genLitSwitch, addInternStr

---
 compiler/spago.yaml                           |  1 +
 .../src/PureScript/Backend/Wasm/Codegen.purs  | 94 ++++++++++++-------
 spago.lock                                    |  1 +
 3 files changed, 61 insertions(+), 35 deletions(-)

diff --git a/compiler/spago.yaml b/compiler/spago.yaml
index 057232a4..b558a020 100644
--- a/compiler/spago.yaml
+++ b/compiler/spago.yaml
@@ -28,6 +28,7 @@ package:
     - node-buffer
     - prelude
     - strings
+    - tailrec
     - transformers
     - tuples
   test:
diff --git a/compiler/src/PureScript/Backend/Wasm/Codegen.purs b/compiler/src/PureScript/Backend/Wasm/Codegen.purs
index e40c38b1..f763e581 100644
--- a/compiler/src/PureScript/Backend/Wasm/Codegen.purs
+++ b/compiler/src/PureScript/Backend/Wasm/Codegen.purs
@@ -28,6 +28,7 @@ module PureScript.Backend.Wasm.Codegen
 import Prelude
 
 import Binaryen as B
+import Control.Monad.Rec.Class (Step(..), tailRecM)
 import Data.Array as Array
 import Data.Foldable (foldl, foldr, traverse_)
 import Data.List (List(..), (:))
@@ -350,20 +351,23 @@ addInternStr ctx exportIt labels = do
     dyn <- B.call ctx.mod internDynamicHelperName [ key ] B.i32
     base <- B.i32Const ctx.mod (Array.length labels)
     B.i32Add ctx.mod base dyn
-  body <- foldr step (pure miss) labels
+  -- `ifChain` (a tail loop) rather than `foldr step (pure miss)`: the whole-program label
+  -- set is large, and the fold's nested Effect binds overflow the host JS stack on a
+  -- self-sized program.
+  prepared <- traverse prepare labels
+  body <- ifChain ctx prepared miss
   _ <- B.addFunction ctx.mod internStrName (B.createType [ B.eqref ]) B.i32 [] body
   -- exported when a record/object foreign needs name→id resolution from the JS
   -- marshalling glue (ADR 0014); otherwise internal (and Binaryen-pruned if unused)
   when exportIt (void (B.addFunctionExport ctx.mod internStrName "internStr"))
   pure unit
   where
-  step (Tuple label labelId) accM = do
-    acc <- accM
+  prepare (Tuple label labelId) = do
     key <- B.localGet ctx.mod 0 B.eqref
     labelConst <- genAtom ctx (ALitString label)
     cond <- B.call ctx.mod strEqHelperName [ key, labelConst ] B.i32
     idExpr <- B.i32Const ctx.mod labelId
-    B.if_ ctx.mod cond idExpr acc
+    pure (Tuple cond idExpr)
 
 funcNameStr :: FuncName -> String
 funcNameStr (FuncName n) = n
@@ -485,13 +489,18 @@ genBody :: Ctx -> AnfExpr -> Effect B.Expression
 -- Statements accumulate in a `List`, prepended most-recent-first (O(1) per `Let`) and
 -- reversed once at `seal` — an `Array` accumulator (`snoc`) copies the whole prefix per
 -- binding, i.e. O(n²) on the long `Let` chains a large function's ANF body becomes.
-genBody ctx = go Nil
+--
+-- The `Let`/`LetRec`/`LetJoin` spine is walked with `tailRecM` rather than self-recursion:
+-- a large function's ANF body is a deeply nested spine, and the Effect recursion compiles to
+-- a non-tail-call chain (`__do`) that overflows the host JS stack on a self-sized program.
+-- `tailRecM` (MonadRec Effect) runs the spine on the heap, in constant stack.
+genBody ctx = tailRecM go <<< { statements: Nil, expr: _ }
   where
-  go statements = case _ of
+  go { statements, expr } = case expr of
     -- A returned atom is coerced to the function's result representation.
-    Return atom -> seal statements =<< genAtomAs ctx ctx.funcResult atom
-    Switch scrutAtom branches dflt -> seal statements =<< genSwitch ctx scrutAtom branches dflt
-    LitSwitch scrutAtom branches dflt -> seal statements =<< genLitSwitch ctx scrutAtom branches dflt
+    Return atom -> Done <$> (seal statements =<< genAtomAs ctx ctx.funcResult atom)
+    Switch scrutAtom branches dflt -> Done <$> (seal statements =<< genSwitch ctx scrutAtom branches dflt)
+    LitSwitch scrutAtom branches dflt -> Done <$> (seal statements =<< genLitSwitch ctx scrutAtom branches dflt)
     -- A direct call whose result is immediately returned is a *tail* call: emit
     -- `return_call` so a tail-recursive chain runs in constant stack. Only valid when
     -- the callee's result rep matches this function's (the frame is replaced, so no
@@ -504,25 +513,25 @@ genBody ctx = go Nil
       , Just sig <- Map.lookup name ctx.sigs
       , sig.result == ctx.funcResult -> do
           operands <- traverse (\(Tuple rep a) -> genAtomAs ctx rep a) (Array.zip sig.params args)
-          seal statements =<< B.returnCall ctx.mod (funcNameStr name) operands (repType ctx sig.result)
+          Done <$> (seal statements =<< B.returnCall ctx.mod (funcNameStr name) operands (repType ctx sig.result))
     -- Store the rhs into its slot, boxing/unboxing if the slot's chosen rep differs
     -- from the rhs's natural rep.
     Let (Slot index) _ rhs k -> do
       e <- genRhs ctx rhs >>= coerce ctx (rhsRep ctx rhs) (slotRep ctx index)
       stmt <- B.localSet ctx.mod index e
-      go (stmt : statements) k
+      pure (Loop { statements: stmt : statements, expr: k })
     LetRec recBinds k -> do
       let groupSlots = map (\(RecBind (Slot s) _ _) -> s) recBinds
       allocs <- traverse (allocRecClosure ctx groupSlots) recBinds
       patches <- traverse (patchRecClosure ctx groupSlots) recBinds
-      go (foldl (flip (:)) statements (allocs <> Array.concat patches)) k
+      pure (Loop { statements: foldl (flip (:)) statements (allocs <> Array.concat patches), expr: k })
     -- A join point (ADR 0022): generate the `producer` as a value-producing block
     -- (its tails yield `rep`, and `return_call` is disabled so it cannot escape the
     -- function), store it into the join slot, then continue the (single) continuation.
     LetJoin (Slot slot) rep producer k -> do
       producerExpr <- genBody (ctx { funcResult = rep, tailPos = false }) producer
       stmt <- B.localSet ctx.mod slot producerExpr
-      go (stmt : statements) k
+      pure (Loop { statements: stmt : statements, expr: k })
   -- the body / branch block produces the function's result (a tail position); `statements`
   -- is most-recent-first, so `value : statements` reversed is emission order with the value last.
   seal statements value =
@@ -569,40 +578,55 @@ patchRecClosure ctx groupSlots (RecBind (Slot slot) _ env) =
 
 -- | A `Switch` becomes a chain of `if (tag == k) <branch> else …`, ending in the
 -- | default block or `unreachable`. The tag is read afresh per comparison.
+-- | Assemble an `if … else …` chain stack-safely from already-generated `(cond, then)`
+-- | pairs and an innermost `else` (`base`): fold from the last branch inward, so the
+-- | accumulating `else` is built by a tail loop rather than the non-tail recursion (each
+-- | level binding the recursive result before `B.if_`) that overflows the host JS stack on
+-- | a switch with many branches in a self-sized program.
+ifChain :: Ctx -> Array (Tuple B.Expression B.Expression) -> B.Expression -> Effect B.Expression
+ifChain ctx branches base = tailRecM step { acc: base, rest: Array.reverse branches }
+  where
+  step { acc, rest } = case Array.uncons rest of
+    Nothing -> pure (Done acc)
+    Just { head: Tuple cond thenE, tail } -> do
+      acc' <- B.if_ ctx.mod cond thenE acc
+      pure (Loop { acc: acc', rest: tail })
+
+dfltExpr :: Ctx -> Maybe AnfExpr -> Effect B.Expression
+dfltExpr ctx = case _ of
+  Just d -> genBody ctx d
+  Nothing -> B.unreachable ctx.mod
+
 genSwitch :: Ctx -> Atom -> Array Branch -> Maybe AnfExpr -> Effect B.Expression
-genSwitch ctx scrutAtom branches dflt = chain branches
+genSwitch ctx scrutAtom branches dflt = do
+  prepared <- traverse prepare branches
+  base <- dfltExpr ctx dflt
+  ifChain ctx prepared base
   where
   readTag = do
     s <- genAtomAs ctx Boxed scrutAtom
     c <- B.refCast ctx.mod s ctx.dataBase.ref
     B.structGet ctx.mod 0 c B.i32 false
-  chain bs = case Array.uncons bs of
-    Nothing -> case dflt of
-      Just d -> genBody ctx d
-      Nothing -> B.unreachable ctx.mod
-    Just { head: Branch tag body, tail } -> do
-      tagExpr <- readTag
-      k <- B.i32Const ctx.mod tag
-      cond <- B.i32Eq ctx.mod tagExpr k
-      thenE <- genBody ctx body
-      elseE <- chain tail
-      B.if_ ctx.mod cond thenE elseE
+  prepare (Branch tag body) = do
+    tagExpr <- readTag
+    k <- B.i32Const ctx.mod tag
+    cond <- B.i32Eq ctx.mod tagExpr k
+    thenE <- genBody ctx body
+    pure (Tuple cond thenE)
 
 -- | A `LitSwitch` becomes a chain of `if (scrutinee == literal) <branch> else …`.
 -- | The equality test unboxes the scrutinee per literal kind: `Int`/`Char` and
 -- | `Boolean` compare as `i32`, `Number` as `f64`.
 genLitSwitch :: Ctx -> Atom -> Array LitBranch -> Maybe AnfExpr -> Effect B.Expression
-genLitSwitch ctx scrutAtom branches dflt = chain branches
+genLitSwitch ctx scrutAtom branches dflt = do
+  prepared <- traverse prepare branches
+  base <- dfltExpr ctx dflt
+  ifChain ctx prepared base
   where
-  chain bs = case Array.uncons bs of
-    Nothing -> case dflt of
-      Just d -> genBody ctx d
-      Nothing -> B.unreachable ctx.mod
-    Just { head: LitBranch pat body, tail } -> do
-      cond <- litTest pat
-      thenE <- genBody ctx body
-      elseE <- chain tail
-      B.if_ ctx.mod cond thenE elseE
+  prepare (LitBranch pat body) = do
+    cond <- litTest pat
+    thenE <- genBody ctx body
+    pure (Tuple cond thenE)
   litTest = case _ of
     PInt n -> do
       s <- genAtomAs ctx I32 scrutAtom
diff --git a/spago.lock b/spago.lock
index be40c214..13d70682 100644
--- a/spago.lock
+++ b/spago.lock
@@ -71,6 +71,7 @@
             "node-buffer",
             "prelude",
             "strings",
+            "tailrec",
             "transformers",
             "tuples"
           ]

From a8f026fad9f6c20238c1a4b18d619b64fc723d68 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 18:37:01 +0900
Subject: [PATCH 12/16] [Refactor] Externs.Decoder: Avoid importing PS values
 (ADTs) inside the foreign module

---
 .../PureScript/ExternsFile/Decoder/Class.purs | 12 +++---
 .../ExternsFile/Decoder/Generic.purs          |  6 +--
 .../ExternsFile/Decoder/Newtype.purs          |  4 +-
 .../PureScript/ExternsFile/Decoder/Utils.js   | 28 ++++++-------
 .../PureScript/ExternsFile/Decoder/Utils.purs | 42 +++++++++++++++----
 .../src/PureScript/ExternsFile/Types.purs     |  7 ++--
 6 files changed, 63 insertions(+), 36 deletions(-)

diff --git a/compiler/src/PureScript/ExternsFile/Decoder/Class.purs b/compiler/src/PureScript/ExternsFile/Decoder/Class.purs
index 1a7c67f2..bb11a881 100644
--- a/compiler/src/PureScript/ExternsFile/Decoder/Class.purs
+++ b/compiler/src/PureScript/ExternsFile/Decoder/Class.purs
@@ -41,7 +41,7 @@ instance decodeBoolean :: Decode Boolean where
 
 instance decodeMaybe :: Decode a => Decode (Maybe a) where
   decoder = Decoder \fgn ->
-    case runFn2 readAt 0 fgn of
+    case readAt 0 fgn of
       Left MissingValue -> Right Nothing
       Left err -> Left err
       Right fgn' -> case runDecoder (decoder @a) fgn' of
@@ -56,15 +56,15 @@ instance decodeArray :: Decode a => Decode (Array a) where
 
 instance decodeEither :: (Decode a, Decode b) => Decode (Either a b) where
   decoder = Decoder \fgn ->
-    case runFn2 readAt 0 fgn >>= asInt "Either" of
+    case readAt 0 fgn >>= asInt "Either" of
       Left err -> Left (AtIndex 0 err)
       Right tag -> case tag of
-        0 -> runFn2 readAt 1 fgn >>= runDecoder (decoder @a) <#> Left
-        1 -> runFn2 readAt 1 fgn >>= runDecoder (decoder @b) <#> Right
+        0 -> readAt 1 fgn >>= runDecoder (decoder @a) <#> Left
+        1 -> readAt 1 fgn >>= runDecoder (decoder @b) <#> Right
         _ -> Left $ UnknownConstructorTag tag
 
 instance decodeTuple :: (Decode a, Decode b) => Decode (Tuple a b) where
   decoder = Decoder \fgn -> ado
-    a <- runFn2 readAt 0 fgn >>= runDecoder decoder
-    b <- runFn2 readAt 1 fgn >>= runDecoder decoder
+    a <- readAt 0 fgn >>= runDecoder decoder
+    b <- readAt 1 fgn >>= runDecoder decoder
     in Tuple a b
diff --git a/compiler/src/PureScript/ExternsFile/Decoder/Generic.purs b/compiler/src/PureScript/ExternsFile/Decoder/Generic.purs
index 4e3135b8..84993c90 100644
--- a/compiler/src/PureScript/ExternsFile/Decoder/Generic.purs
+++ b/compiler/src/PureScript/ExternsFile/Decoder/Generic.purs
@@ -30,7 +30,7 @@ instance genericDecoderRepConstructor ::
     let
       n = reflectType nproxy
     in
-      case runFn2 readAt 0 fgn >>= asInt "genericDecoderRepConstructor" of
+      case readAt 0 fgn >>= asInt "genericDecoderRepConstructor" of
         Left err -> Left $ AtIndex 0 err
         Right n'
           | n' == n -> Constructor @constr <$>
@@ -45,7 +45,7 @@ else instance genericDecoderRepSum ::
   ) =>
   GenericDecoderRep n (Sum inl inr) where
   genericDecoderRep nproxy _ = Decoder \fgn ->
-    case runFn2 readAt 0 fgn >>= asInt "GenericDecoderRepSum" of
+    case readAt 0 fgn >>= asInt "GenericDecoderRepSum" of
       Left err -> Left $ AtIndex 0 err
       Right n
         | n == reflectType nproxy -> Inl <$> runDecoder (genericDecoderRep nproxy (Proxy @inl)) fgn
@@ -66,7 +66,7 @@ else instance genericDecoderArgumentsArgument ::
     let
       n = reflectType nproxy
     in
-      case runFn2 readAt n fgn of
+      case readAt n fgn of
         Left err -> Left $ AtIndex n err
         Right x -> case runDecoder (decoder @t) x of
           Left err' -> Left $ AtIndex n err'
diff --git a/compiler/src/PureScript/ExternsFile/Decoder/Newtype.purs b/compiler/src/PureScript/ExternsFile/Decoder/Newtype.purs
index efc79292..88d4694d 100644
--- a/compiler/src/PureScript/ExternsFile/Decoder/Newtype.purs
+++ b/compiler/src/PureScript/ExternsFile/Decoder/Newtype.purs
@@ -11,8 +11,8 @@ import PureScript.ExternsFile.Decoder.Utils (asInt, readAt)
 
 newtypeDecoder :: forall a b. Newtype a b => Decode b => Decoder a
 newtypeDecoder = Decoder \fgn ->
-  case runFn2 readAt 0 fgn >>= asInt "newtypeDecoder" of
+  case readAt 0 fgn >>= asInt "newtypeDecoder" of
     Left err -> Left err
     Right n
-      | n == 0 -> runFn2 readAt 1 fgn >>= runDecoder (decoder @b) <#> wrap
+      | n == 0 -> readAt 1 fgn >>= runDecoder (decoder @b) <#> wrap
       | otherwise -> Left $ Unexpected "Not a constructor tag of newtype"
diff --git a/compiler/src/PureScript/ExternsFile/Decoder/Utils.js b/compiler/src/PureScript/ExternsFile/Decoder/Utils.js
index 81fd3f2c..2502192c 100644
--- a/compiler/src/PureScript/ExternsFile/Decoder/Utils.js
+++ b/compiler/src/PureScript/ExternsFile/Decoder/Utils.js
@@ -1,31 +1,31 @@
-import { Left, Right } from "../Data.Either/index.js";
-import { Unexpected, MissingValue } from "../PureScript.ExternsFile.Decoder.Monad/index.js";
+// import { Left, Right } from "../Data.Either/index.js";
+// import { Unexpected, MissingValue } from "../PureScript.ExternsFile.Decoder.Monad/index.js";
 
-export const readAt = function (idx, fgn) {
+export const readAt_ = function (utils, idx, fgn) {
   if (!Array.isArray(fgn)) {
-    return Left.create(Unexpected.create("Expecting array, got " + typeof fgn));
+    return utils.Left(utils.Unexpected("Expecting array, got " + typeof fgn));
   }
   if (fgn[idx] === void 0) {
-    return Left.create(MissingValue.value);
+    return utils.Left(utils.MissingValue);
   }
   if (fgn.length < idx) {
-    return Left.create(Unexpected.create("Got an array of length " + fgn.length + ", which is too small to get element at " + idx));
+    return utils.Left(utils.Unexpected("Got an array of length " + fgn.length + ", which is too small to get element at " + idx));
   }
-  return Right.create(fgn[idx]);
+  return utils.Right(fgn[idx]);
 };
 
-export const asInt = n => function (fgn) {
+export const asInt_ = function (utils, n, fgn) {
   if (typeof fgn === "number") {
     return ((fgn | 0) === fgn)
-      ? Right.create(fgn)
-      : Left.create(Unexpected.create("Expecting integer, got a floating point number"));
+      ? utils.Right(fgn)
+      : utils.Left(utils.Unexpected("Expecting integer, got a floating point number"));
   }
-  return Left.create(Unexpected.create("Expecting integer, got " + typeof fgn));
+  return utils.Left(utils.Unexpected("Expecting integer, got " + typeof fgn));
 };
 
-export const asArray = function (fgn) {
+export const asArray_ = function (utils, fgn) {
   if (!Array.isArray(fgn)) {
-    return Left.create(Unexpected.create("Expecting array, got " + typeof fgn));
+    return utils.Left(utils.Unexpected("Expecting array, got " + typeof fgn));
   }
-  return Right.create(fgn);
+  return utils.Right(fgn);
 };
diff --git a/compiler/src/PureScript/ExternsFile/Decoder/Utils.purs b/compiler/src/PureScript/ExternsFile/Decoder/Utils.purs
index 5eeb595e..d9c27e1a 100644
--- a/compiler/src/PureScript/ExternsFile/Decoder/Utils.purs
+++ b/compiler/src/PureScript/ExternsFile/Decoder/Utils.purs
@@ -1,12 +1,40 @@
-module PureScript.ExternsFile.Decoder.Utils where
+module PureScript.ExternsFile.Decoder.Utils
+  ( asArray
+  , asInt
+  , readAt
+  ) where
 
-import Data.Either (Either)
-import Data.Function.Uncurried (Fn2)
+import Data.Either (Either(..))
+import Data.Function.Uncurried (Fn2, Fn3, runFn2, runFn3)
 import Foreign (Foreign)
-import PureScript.ExternsFile.Decoder.Monad (DecodeError)
+import PureScript.ExternsFile.Decoder.Monad (DecodeError(..))
 
-foreign import asInt :: forall a. a -> Foreign -> Either DecodeError Int
+type DecodeFFIUtil =
+  { "Left" :: forall a b. a -> Either a b
+  , "Right" :: forall a b. b -> Either a b
+  , "Unexpected" :: String -> DecodeError
+  , "MissingValue" :: DecodeError
+  }
 
-foreign import asArray :: Foreign -> Either DecodeError (Array Foreign)
+decodeUtil :: DecodeFFIUtil
+decodeUtil =
+  { "Left": Left
+  , "Right": Right
+  , "MissingValue": MissingValue
+  , "Unexpected": Unexpected
+  }
 
-foreign import readAt :: Fn2 Int Foreign (Either DecodeError Foreign)
+foreign import asInt_ :: forall a. Fn3 DecodeFFIUtil a Foreign (Either DecodeError Int)
+
+foreign import asArray_ :: Fn2 DecodeFFIUtil Foreign (Either DecodeError (Array Foreign))
+
+foreign import readAt_ :: Fn3 DecodeFFIUtil Int Foreign (Either DecodeError Foreign)
+
+asInt :: forall a. a -> Foreign -> Either DecodeError Int
+asInt = runFn3 asInt_ decodeUtil
+
+asArray :: Foreign -> Either DecodeError (Array Foreign)
+asArray = runFn2 asArray_ decodeUtil
+
+readAt :: Int -> Foreign -> Either DecodeError Foreign
+readAt = runFn3 readAt_ decodeUtil
\ No newline at end of file
diff --git a/compiler/src/PureScript/ExternsFile/Types.purs b/compiler/src/PureScript/ExternsFile/Types.purs
index 09e01eef..99cff3af 100644
--- a/compiler/src/PureScript/ExternsFile/Types.purs
+++ b/compiler/src/PureScript/ExternsFile/Types.purs
@@ -4,7 +4,6 @@ import Prelude
 import Prim hiding (Type, Constraint)
 
 import Data.Foldable (class Foldable)
-import Data.Function.Uncurried (runFn2)
 import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe)
 import Data.Newtype (class Newtype)
@@ -167,9 +166,9 @@ instance showDataTypeArg :: Show DataTypeArg where
 
 instance decodeDataTypeArg :: Decode DataTypeArg where
   decoder = Decoder \fgn -> ado
-    name <- runFn2 readAt 0 fgn >>= runDecoder decoder
-    kind <- runFn2 readAt 1 fgn >>= runDecoder decoder
-    role <- runFn2 readAt 2 fgn >>= runDecoder decoder
+    name <- readAt 0 fgn >>= runDecoder decoder
+    kind <- readAt 1 fgn >>= runDecoder decoder
+    role <- readAt 2 fgn >>= runDecoder decoder
     in DataTypeArg { name, kind, role }
 
 data TypeKind

From a745e7606cf84c8275d82e99a033c97f247dd782 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 19:00:48 +0900
Subject: [PATCH 13/16] [Bugfix] Codegen: recover stack safety of whole-program
 emission

---
 .../src/PureScript/Backend/Wasm/Codegen.purs  | 22 ++++++++++++++-----
 1 file changed, 16 insertions(+), 6 deletions(-)

diff --git a/compiler/src/PureScript/Backend/Wasm/Codegen.purs b/compiler/src/PureScript/Backend/Wasm/Codegen.purs
index f763e581..c9b57c1b 100644
--- a/compiler/src/PureScript/Backend/Wasm/Codegen.purs
+++ b/compiler/src/PureScript/Backend/Wasm/Codegen.purs
@@ -65,7 +65,7 @@ import PureScript.Backend.Wasm.Lower.Reps (primRep)
 buildModule :: Program -> Effect CompiledModule
 buildModule prog = do
   st <- initCodegen prog
-  traverse_ (addFunc st.ctx) prog.funcs
+  forEachArr_ prog.funcs (addFunc st.ctx)
   cafInit <- finalizeCodegen st prog
   pure { mod: st.ctx.mod, foreignModules: foreignModuleNames prog, cafInit }
 
@@ -101,7 +101,7 @@ initCodegen prog = do
 finalizeCodegen :: CodegenState -> Program -> Effect (Maybe B.Function)
 finalizeCodegen st prog = do
   cafInit <- addCafInit st.ctx st.cplan
-  traverse_ (addExportWrapper st.ctx prog.exportSigs) prog.funcs
+  forEachArr_ prog.funcs (addExportWrapper st.ctx prog.exportSigs)
   pure cafInit
 
 -- | The result of building a Binaryen module from the IR, with what packaging needs after:
@@ -223,13 +223,12 @@ buildDataTypes _ sigs0 = do
   B.typeBuilderSetStructType tb 0 [ { ty: B.i32, mutable: false } ]
   B.typeBuilderSetOpen tb 0
   baseTmp <- B.typeBuilderGetTempHeapType tb 0
-  traverse_
+  forEachArr_ (Array.mapWithIndex Tuple nonEmpty)
     ( \(Tuple i sig) -> do
         B.typeBuilderSetStructType tb (i + 1)
           (Array.cons { ty: B.i32, mutable: false } (map (\rep -> { ty: fieldWasmType rep, mutable: false }) sig))
         B.typeBuilderSetSubType tb (i + 1) baseTmp
     )
-    (Array.mapWithIndex Tuple nonEmpty)
   hts <- B.typeBuilderBuildAndDispose tb (1 + n)
   case Array.uncons hts of
     Just { head: baseHt, tail: structHts } -> do
@@ -271,7 +270,7 @@ addCounterGlobal ctx = do
   B.addGlobal ctx.mod counterGlobalName B.i32 true initE
 
 addNullaryGlobals :: Ctx -> Set Int -> Effect Unit
-addNullaryGlobals ctx tags = traverse_ addOne (Set.toUnfoldable tags :: Array Int)
+addNullaryGlobals ctx tags = forEachArr_ (Set.toUnfoldable tags :: Array Int) addOne
   where
   addOne tag = do
     tagE <- B.i32Const ctx.mod tag
@@ -291,7 +290,7 @@ cafInitName = "$caf_init"
 -- | a throwaway constant the init function overwrites at instantiation; an `eqref`
 -- | global uses a dummy boxed `0` (a GC const expression, like a nullary constructor).
 addCafGlobals :: Ctx -> Map FuncName Rep -> Effect Unit
-addCafGlobals ctx globals = traverse_ addOne (Map.toUnfoldable globals :: Array (Tuple FuncName Rep))
+addCafGlobals ctx globals = forEachArr_ (Map.toUnfoldable globals :: Array (Tuple FuncName Rep)) addOne
   where
   addOne (Tuple name rep) = do
     initE <- defaultConst ctx rep
@@ -372,6 +371,17 @@ addInternStr ctx exportIt labels = do
 funcNameStr :: FuncName -> String
 funcNameStr (FuncName n) = n
 
+-- | Stack-safe `traverse_` over an array: the `Data.Foldable` one builds a deeply nested
+-- | `f x0 *> (f x1 *> …)` whose Effect run recurses to the array's length, overflowing the
+-- | host JS stack on whole-program-sized arrays (every function / global). `tailRecM` drives
+-- | it by index on the heap instead.
+forEachArr_ :: forall a. Array a -> (a -> Effect Unit) -> Effect Unit
+forEachArr_ arr f = tailRecM go 0
+  where
+  go i = case Array.index arr i of
+    Nothing -> pure (Done unit)
+    Just x -> f x *> pure (Loop (i + 1))
+
 -- | Add an internal function. Parameters take their declared representation (a
 -- | lifted code function's first parameter is `(ref $Clo)`); `Let`-bound locals
 -- | are all `eqref`. A code function added with `(ref $Clo, eqref) -> eqref`

From a843b5b4bb247f240ec2ce146aa8d403dbbcea4a Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 19:01:07 +0900
Subject: [PATCH 14/16] [Bugfix] Serialize: recover stack safety of putArray

---
 .../Backend/Wasm/MiddleEnd/Serialize.purs           | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Serialize.purs b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Serialize.purs
index 23ddcac4..762f6070 100644
--- a/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Serialize.purs
+++ b/compiler/src/PureScript/Backend/Wasm/MiddleEnd/Serialize.purs
@@ -21,12 +21,12 @@ module PureScript.Backend.Wasm.MiddleEnd.Serialize
 
 import Prelude
 
+import Control.Monad.Rec.Class (Step(..), tailRecM)
 import Data.Array as Array
 import Data.ArrayBuffer.Types (Uint8Array)
 import Data.Bifunctor (lmap)
 import Data.Char (fromCharCode, toCharCode)
 import Data.Either (Either(..))
-import Data.Foldable (traverse_)
 import Data.Maybe (Maybe(..))
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..))
@@ -61,8 +61,17 @@ fail = throwException <<< error
 
 -- Generic helpers ------------------------------------------------------------
 
+-- | `traverse_ (put w)` would build a deep `*>` chain that overflows the host JS stack in
+-- | (raw, non-trampolined) `Effect` when serializing a large array — a big module's binding
+-- | list or a wide `App`/`Case`. `tailRecM` drives the elements by index, on the heap.
 putArray :: forall a. Writer -> (Writer -> a -> Effect Unit) -> Array a -> Effect Unit
-putArray w put xs = putInt w (Array.length xs) *> traverse_ (put w) xs
+putArray w put xs = do
+  putInt w (Array.length xs)
+  tailRecM go 0
+  where
+  go i = case Array.index xs i of
+    Nothing -> pure (Done unit)
+    Just x -> put w x *> pure (Loop (i + 1))
 
 getArray :: forall a. Reader -> (Reader -> Effect a) -> Effect (Array a)
 getArray r get = do

From 0ecbc8c093e429e641137fc1181536bdf87b40f2 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 22:14:46 +0900
Subject: [PATCH 15/16] [Docs] supported-features: update out-dated part

---
 docs/design-decisions/README.md             |  4 +++-
 docs/developers-guide/supported-features.md | 17 +++++++++++------
 2 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/docs/design-decisions/README.md b/docs/design-decisions/README.md
index 41f1603d..d8e8e8ff 100644
--- a/docs/design-decisions/README.md
+++ b/docs/design-decisions/README.md
@@ -105,7 +105,9 @@ inline-or-share selection (ADR 0020's NbE core is implemented; ADR 0035 sequence
 that makes the reducer non-exponential — the self-compilation scalability *time* gate — ahead of the
 reduction-driven decision, neither of which has landed); the `--no-opt` self-compilation *space*
 gate — the front-half whole-program memory floor (decode + translate + lambda-lift holding all MIR
-at once, ADR 0009), addressed by copy-reduction / streaming, not yet landed (decision-tree leaf
+at once, ADR 0009) — addressed by **copy-reduction (landed: translate + lambda-lift are fused
+per module and each module's CoreFn is dropped before the next, so the program is never resident
+as CoreFn *and* MIR at once), with streaming as the future general solution** (decision-tree leaf
 sharing, ADR 0036, was measured to be ~1.16× and is *not* this floor); `wasi` packaging
 and the browser runtime/app split (ADR 0025 — `node` / `browser` / `standalone` packaging and `-E`
 have shipped); precompiled-`ulib` distribution (ADR 0033); and monomorphization.
diff --git a/docs/developers-guide/supported-features.md b/docs/developers-guide/supported-features.md
index ae1e012d..8c12c3d2 100644
--- a/docs/developers-guide/supported-features.md
+++ b/docs/developers-guide/supported-features.md
@@ -85,12 +85,17 @@ recursion needs nothing special — each call is a direct call.
 
 A **point-free** recursive function — defined without an explicit lambda, e.g.
 `purescript-run`'s `loop = resume f pure` — is **eta-expanded** to `\x -> loop' x` so it lowers
-as a function (sound for a binding of positive residual arity). This is what lets `Free` / `Run`
-code compile, though such interpreters are currently slow on wasm and the eta-expansion gives up
-some closure sharing — see [optimizations § Known gaps](./optimizations.md#known-gaps). A genuinely
-recursive **value** binding (a non-function that references itself, e.g. a self-referential
-`Tuple`) is supported only at the **top level**, as a cyclic value CAF that globalization keeps as
-a recomputed getter (ADR 0006); the same shape inside a local `let` is not yet supported.
+as a function. A binding whose head is a **known function** is eta-expanded whether it is applied
+below its arity *or* exactly saturated — its result is itself a function (`resume`'s is), so
+`loop = resume f pure` lowers even though `resume` is fully applied; a saturated **constructor**
+application instead builds data and is left as a recursive value (below), never eta-expanded. This
+is what lets `Free` / `Run` code compile, though such interpreters are currently slow on wasm and
+the eta-expansion gives up some closure sharing — see
+[optimizations § Known gaps](./optimizations.md#known-gaps). A genuinely recursive **value** binding
+(a non-function that references itself, e.g. a self-referential `Tuple`, or any saturated
+constructor application) is supported only at the **top level**, as a cyclic value CAF that
+globalization keeps as a recomputed getter (ADR 0006); the same shape inside a local `let` is not
+yet supported.
 
 ## Tail-call elimination
 

From fac6f74d57c4361d3fe56732f285859be571eef7 Mon Sep 17 00:00:00 2001
From: katsujukou <katsujukou@gmail.com>
Date: Tue, 16 Jun 2026 22:55:40 +0900
Subject: [PATCH 16/16] [Test] Codegen/Serialize: stack-safety regression
 guards (wide switch, many functions, wide array)

---
 compiler/test/Unit/Compiler.purs              |  2 +
 .../Unit/PureScript/Backend/Wasm/Codegen.purs | 43 +++++++++++++++++++
 .../Backend/Wasm/MiddleEnd/Serialize.purs     | 15 +++++++
 3 files changed, 60 insertions(+)
 create mode 100644 compiler/test/Unit/PureScript/Backend/Wasm/Codegen.purs

diff --git a/compiler/test/Unit/Compiler.purs b/compiler/test/Unit/Compiler.purs
index a321239f..8e2fd58c 100644
--- a/compiler/test/Unit/Compiler.purs
+++ b/compiler/test/Unit/Compiler.purs
@@ -7,6 +7,7 @@ import Prelude
 import Effect (Effect)
 import Test.Spec.Reporter (consoleReporter)
 import Test.Spec.Runner.Node (runSpecAndExitProcess)
+import Test.Unit.PureScript.Backend.Wasm.Codegen as Codegen
 import Test.Unit.PureScript.Backend.Wasm.Codegen.Caf as Caf
 import Test.Unit.PureScript.Backend.Wasm.Externs as Externs
 import Test.Unit.PureScript.Backend.Wasm.Lower as Lower
@@ -35,6 +36,7 @@ main = runSpecAndExitProcess [ consoleReporter ] do
   ExternsFile.spec
   Externs.spec
   Caf.spec
+  Codegen.spec
   Lower.spec
   Match.spec
   Transl.spec
diff --git a/compiler/test/Unit/PureScript/Backend/Wasm/Codegen.purs b/compiler/test/Unit/PureScript/Backend/Wasm/Codegen.purs
new file mode 100644
index 00000000..ffadea64
--- /dev/null
+++ b/compiler/test/Unit/PureScript/Backend/Wasm/Codegen.purs
@@ -0,0 +1,43 @@
+-- | Stack-safety regression guards for whole-program code generation
+-- | (`Codegen.buildModule`). These do not inspect the emitted wasm — only that codegen
+-- | does not overflow the host JS stack on the shapes a self-sized program produces: a long
+-- | `Let` spine (`genBody`), a wide `Switch` (the `genSwitch` / `genLitSwitch` if-chain), and a
+-- | program with many functions (the whole-program emission loop). Each size is well past the
+-- | ~10k default-stack-frame limit the pre-`tailRecM` code died at; before the stack-safety
+-- | fixes these `buildModule` calls raised `RangeError: Maximum call stack size exceeded`.
+module Test.Unit.PureScript.Backend.Wasm.Codegen (spec) where
+
+import Prelude
+
+import Data.Array as Array
+import Data.Maybe (Maybe(..))
+import Effect.Class (liftEffect)
+import Foreign.Object as Object
+import PureScript.Backend.Wasm.Codegen (buildModule)
+import PureScript.Backend.Wasm.Lower.IR (AnfExpr(..), Atom(..), FuncName(..), IRFunc, LitBranch(..), LitPat(..), Program, Rep(..))
+import Test.Spec (Spec, describe, it)
+import Test.Spec.Assertions (shouldEqual)
+
+prog :: Array IRFunc -> Program
+prog funcs = { funcs, labels: [], exportSigs: Object.empty }
+
+-- | A nullary function with the given local-slot count and body.
+caf :: String -> Int -> AnfExpr -> IRFunc
+caf name localCount body = { name: FuncName name, params: [], result: Boxed, body, export: Nothing, localCount }
+
+spec :: Spec Unit
+spec = describe "PureScript.Backend.Wasm.Codegen.buildModule (stack safety)" do
+  it "emits a switch with many branches without overflowing (genLitSwitch if-chain)" do
+    let
+      n = 30000
+      branches = map (\k -> LitBranch (PInt k) (Return (ALitInt k))) (Array.range 0 (n - 1))
+      p = prog [ caf "wide" 1 (LitSwitch (ALitInt 0) branches (Just (Return (ALitInt (-1))))) ]
+    r <- liftEffect (buildModule p)
+    Array.length r.foreignModules `shouldEqual` 0
+
+  it "emits a program with many functions without overflowing (whole-program loop)" do
+    let
+      n = 30000
+      fns = map (\i -> { name: FuncName ("f" <> show i), params: [ Boxed ], result: Boxed, body: Return (ALitInt 0), export: Nothing, localCount: 1 }) (Array.range 0 (n - 1))
+    r <- liftEffect (buildModule (prog fns))
+    Array.length r.foreignModules `shouldEqual` 0
diff --git a/compiler/test/Unit/PureScript/Backend/Wasm/MiddleEnd/Serialize.purs b/compiler/test/Unit/PureScript/Backend/Wasm/MiddleEnd/Serialize.purs
index 32a6b04e..967b1c87 100644
--- a/compiler/test/Unit/PureScript/Backend/Wasm/MiddleEnd/Serialize.purs
+++ b/compiler/test/Unit/PureScript/Backend/Wasm/MiddleEnd/Serialize.purs
@@ -84,6 +84,16 @@ deepNest =
   , decls: [ M.NonRec Nothing "d" (Array.foldl (\acc i -> M.App acc [ M.Lit (LitInt i) ]) (local "base") (Array.range 1 1000)) ]
   }
 
+-- | A single node carrying a very *wide* array (50k application arguments). `deepNest` exercises
+-- | tree depth; this exercises `putArray` width: the old `traverse_`-based encoder built an
+-- | N-deep `*>` chain that overflowed the host stack in (non-trampolined) `Effect` on a large
+-- | array. 50k is well past the ~10k default-stack limit the old code died at.
+wideArgs :: M.Module
+wideArgs =
+  { name: [ "Wide" ]
+  , decls: [ M.NonRec Nothing "w" (M.App (local "f") (Array.replicate 50000 (M.Lit (LitInt 0)))) ]
+  }
+
 spec :: Spec Unit
 spec = describe "PureScript.Backend.Wasm.MiddleEnd.Serialize" do
   describe "encode/decode" do
@@ -102,3 +112,8 @@ spec = describe "PureScript.Backend.Wasm.MiddleEnd.Serialize" do
       -- Compare as a Boolean: a derived `show` of a 1000-deep tree (on a hypothetical
       -- failure) would itself overflow and mask the real result.
       (roundTrips deepNest == Right deepNest) `shouldEqual` true
+
+    it "round-trips a node with a very wide array without overflowing (putArray)" do
+      -- Guards `putArray`'s stack safety: encoding the 50k-element argument list must not
+      -- build an N-deep `*>` chain. Compared as a Boolean (a 50k-element `show` would be huge).
+      (roundTrips wideArgs == Right wideArgs) `shouldEqual` true