purescript-lua · Unisay · Jul 10, 2026 · Jul 9, 2026 · Jul 10, 2026
diff --git a/changelog.d/20260710_100000_unisay_collapse_monadic_chains.md b/changelog.d/20260710_100000_unisay_collapse_monadic_chains.md
@@ -0,0 +1,24 @@
+### Changed
+
+- Non-`Effect`/`ST` monadic chains now collapse to straight-line code (#180).
+  After magic-do, a budgeted `specialize`+`dce` fixpoint inlines dictionary
+  methods at their call sites so the case-of-known-constructor folds
+  (#177/#213/#214) can fire, turning `Maybe`/`Either` `bind` cascades into
+  straight-line code. Code growth is bounded by a size budget. Four cooperating
+  parts:
+    - `propagateKnownCtorThroughLet` resolves an imported constructor reference
+      through the inline environment. A source-level `Right x` stays a reference
+      to the `Data.Either.Right` worker (a bare `Ctor`, not a lambda, so the
+      call-site inliner leaves it in place); without the resolution an inlined
+      `bind`'s tag test never folds and the chain stayed a deeply-nested
+      `if`/`let` tree that overflowed the Lua parser's nesting cap.
+    - Magic-do effect runs carry a dedicated `EffectRunArg` marker, distinct
+      from the `Prim.undefined` argument that forces an ordinary nullary thunk,
+      so `isEffectRun` recognises exactly the effect runs magic-do introduces.
+      Beta reduction then collapses the coincidentally nullary thunks (a
+      superclass-dictionary accessor, a `runIdentity` newtype coercion) that a
+      non-`Effect` monad such as `State` inlines, which were being left
+      un-reduced and bloating the output.
+    - A constructor-tag read distributes through a conditional of constructors,
+      so an inlined comparison's `Ordering` if-tree folds to tag strings instead
+      of allocating an `Ordering` table at runtime only to read the tag back.
diff --git a/lib/Language/PureScript/Backend/IR/DCE.hs b/lib/Language/PureScript/Backend/IR/DCE.hs
@@ -26,6 +26,7 @@ import Language.PureScript.Backend.IR.Types
   , RawExp (..)
   , WasRewritten (..)
   , getAnn
+  , isEffectRun
   , listGrouping
   , rewriteExpBottomUp
   , rewrittenIf
@@ -183,8 +184,10 @@ eliminateDeadCode uber@UberModule {..} =
       ∷ [Grouping ((Id, Ann), Name, AExp)]
       → [Grouping ((Id, Ann), Name, AExp)]
     preservedGroupings = mapMaybe \case
-      g@(Standalone ((nameId, _ann), _name, _expr)) →
-        g <$ guard (nameId `member` reachableIds)
+      -- An effect statement is kept even though its binder is unreferenced:
+      -- dropping it would silently discard the side effect (see 'isEffectRun').
+      g@(Standalone ((nameId, _ann), _name, expr)) →
+        g <$ guard (nameId `member` reachableIds || isEffectRun expr)
       RecursiveGroup recBinds →
         RecursiveGroup
           <$> NE.nonEmpty
@@ -376,9 +379,18 @@ eliminateDeadCode uber@UberModule {..} =
 expressionDependsOnIds ∷ Scope → AExp → [Id]
 expressionDependsOnIds exprScope = \case
   Ref _ann qname → maybeToList $ Map.lookup qname exprScope
-  -- A Let node depends only on its body: the groupings are pulled in
-  -- via the per-binder nodes built by 'adjacencyListForGrouping'.
-  Let _ann _groupings body → [nodeId body]
+  -- A Let node depends on its body, and on any effect-run binding it holds:
+  -- the groupings referenced by name are pulled in via the per-binder nodes
+  -- built by 'adjacencyListForGrouping', but a magic-do effect statement
+  -- (@let _ = m EffectRunArg@) is bound to an unreferenced name, so nothing
+  -- would otherwise keep its observable side effect reachable (see
+  -- 'isEffectRun' and Note [Sequential scoping of Let bindings]).
+  Let _ann groupings body →
+    nodeId body
+      : [ nodeId rhs
+        | Standalone (_binder, _name, rhs) ← toList groupings
+        , isEffectRun rhs
+        ]
   other → nodeId <$> toListOf subexpressions other
 
 {- | Under GUC (@UniqueBinders@) no two live binders at one site share a

diff --git a/lib/Language/PureScript/Backend/IR/MagicDo.hs b/lib/Language/PureScript/Backend/IR/MagicDo.hs
@@ -73,6 +73,7 @@ import Language.PureScript.Backend.IR.Types
   , unwindApp
   , pattern Abs
   , pattern App
+  , pattern EffectRunArg
   )
 
 -- | Flatten Effect/ST @do@ blocks in every binding and export of the module.
@@ -252,12 +253,13 @@ isBindDict resolve dict =
 -- Helpers ---------------------------------------------------------------------
 
 {- | Run an Effect/ST computation: apply the thunk to no arguments. The
-synthetic @Prim.undefined@ argument is erased to an empty argument list by
-the Lua code generator, so this emits @m()@.
+synthetic 'EffectRunArg' argument is erased to an empty argument list by the Lua
+code generator, so this emits @m()@. Unlike @Prim.undefined@ (the argument that
+forces an ordinary nullary thunk), 'EffectRunArg' marks this application as an
+effect run so 'isEffectRun' recognises it precisely (issue #180).
 -}
 runEffect ∷ Exp → Exp
-runEffect m =
-  App noAnn m (Ref noAnn (Imported (ModuleName "Prim") (Name "undefined")))
+runEffect m = App noAnn m (EffectRunArg noAnn)
 
 {- | Bound on alias/instance resolution to stay terminating on recursive
 bindings.