Skip to content

fix: unshift dropped Let binders and resolve body scope per let* in IR DCE #148

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
Unisay merged 1 commit into from
Jul 2, 2026
+148 −20
Merged

fix: unshift dropped Let binders and resolve body scope per let* in IR DCE #148

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 11 additions & 0 deletions changelog.d/20260702_130000_unisay_dce_let_scope.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
### Fixed

- IR dead code elimination handles `Let` bindings correctly. Dropping a dead
binding did not lower the De Bruijn indices of references that skipped over
it (the `Let` analogue of the #56 `Abs` fix), so the compiler either crashed
with `UnexpectedRefBound` in the Lua code generator or silently resolved the
reference to the wrong binder. The scope the `Let` body was resolved against
was also built in reverse, so among same-name sibling bindings the body's
index 0 picked the first binding instead of the last, contradicting
Note [Sequential scoping of Let bindings] and marking the wrong binding
live (#134).
77 changes: 57 additions & 20 deletions lib/Language/PureScript/Backend/IR/DCE.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -139,25 +139,62 @@ eliminateDeadCode uber@UberModule {..} =
ParamUnused pann → (ParamUnused pann, b)
ParamNamed pann name → (ParamUnused pann, unshift name 0 b)
Let ann binds body →
Rewritten Recurse case NE.nonEmpty preservedBinds of
Nothing → body
Just bs → Let ann bs body
Rewritten Recurse case preserveLetBinds (toList binds) body of
([], body') → body'
(b : bs, body') → Let ann (b :| bs) body'
where
preservedBinds ∷ [Grouping ((Id, Ann), Name, AExp)]
preservedBinds =
toList binds >>= \case
b@(Standalone ((expId, _ann), _name, _expr)) →
[b | expId `member` reachableIds]
RecursiveGroup recBinds →
case NE.nonEmpty preservedRecBinds of
Nothing → []
Just pb → [RecursiveGroup pb]
-- Dropping a dead binder removes a slot from that name's De Bruijn
-- namespace, so references in the rest of the Let (later grouping
-- RHSs and the body) that skipped over it must be lowered, just as
-- in the Abs case above (issue #56). 'unshiftTail' reuses the
-- 'unshift' traversal by wrapping the rest back into a Let, so the
-- scope threading follows Note [Sequential scoping of Let bindings]
-- instead of being re-implemented here.
preserveLetBinds
∷ [Grouping ((Id, Ann), Name, AExp)]
→ AExp
→ ([Grouping ((Id, Ann), Name, AExp)], AExp)
preserveLetBinds groupings body' = case groupings of
[] → ([], body')
g : gs → case g of
Standalone ((expId, _ann), name, _expr)
| not (expId `member` reachableIds) →
uncurry preserveLetBinds (unshiftTail name gs body')
RecursiveGroup recBinds
| not (null droppedNames) →
uncurry preserveLetBinds $
foldl'
(\(tailGs, tailBody) n → unshiftTail n tailGs tailBody)
(remainingGs, body')
droppedNames
where
preservedRecBinds =
droppedNames =
[ name
| ((nameId, _ann), name, _) ← toList recBinds
, not (nameId `member` reachableIds)
]
keptBinds =
[ b
| b@((nameId, _ann), _, _) ← toList recBinds
| b@((nameId, _), _, _) ← toList recBinds
, nameId `member` reachableIds
]
remainingGs =
case NE.nonEmpty keptBinds of
Nothing → gs
Just kept → RecursiveGroup kept : gs
_keep → first (g :) (preserveLetBinds gs body')

unshiftTail
∷ Name
→ [Grouping ((Id, Ann), Name, AExp)]
→ AExp
→ ([Grouping ((Id, Ann), Name, AExp)], AExp)
unshiftTail name gs body' = case NE.nonEmpty gs of
Nothing → ([], unshift name 0 body')
Just neGs → case unshift name 0 (Let (getAnn body') neGs body') of
Let _ann gs' body'' → (toList gs', body'')
-- 'unshift' ('overFreeIndex') preserves expression structure.
other → (toList neGs, other)
_ → NoChange

reachableIds ∷ Set Id =
Expand Down Expand Up @@ -307,13 +344,13 @@ eliminateDeadCode uber@UberModule {..} =
(mkNode paramId [])
(adjacencyListForExpr (addLocalToScope paramId name 0 scope) b)
Let _ann groupings body →
adjacencyListForExpr scope' body
<> snd (foldl' adjacencyListForGrouping (scope, mempty) groupings)
adjacencyListForExpr bodyScope body <> groupingsAdjacency
where
scope' = foldr addToScope scope (listGrouping =<< toList groupings)
addToScope ∷ ((Id, ann), Name, expr) → Scope → Scope
addToScope ((nameId, _ann), name, _expr) =
addLocalToScope nameId name 0
-- The body resolves references against the scope threaded through
-- the groupings left to right, so its index 0 picks the *last*
-- binding of a name (see Note [Sequential scoping of Let bindings]).
(bodyScope, groupingsAdjacency) =
foldl' adjacencyListForGrouping (scope, mempty) groupings
where
-- See Note [Sequential scoping of Let bindings]
adjacencyListForGrouping
Expand Down
80 changes: 80 additions & 0 deletions test/Language/PureScript/Backend/IR/DCE/Spec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,10 +23,12 @@ import Language.PureScript.Backend.IR.Types
, countFreeRefs
, exception
, lets
, literalInt
, noAnn
, paramNamed
, paramUnused
, refImported
, refLocal
, refLocal0
)
import Test.Hspec (Spec, describe, it)
Expand Down Expand Up @@ -126,6 +128,84 @@ spec = describe "IR Dead Code Elimination" do
annotate . toString $ pShow expr
expected === dceExpression expr

-- See Note [Sequential scoping of Let bindings]: the body's index 0
-- picks the *last* binding of a name, like let*.
it "resolves the body scope innermost-first (let*)" $ hedgehog do
let x = Name "x"
expr =
lets
( Standalone (noAnn, x, literalInt 1)
:| [Standalone (noAnn, x, literalInt 2)]
)
(refLocal x 0)
expected =
lets (Standalone (noAnn, x, literalInt 2) :| []) (refLocal x 0)
dceExpression expr === expected

-- Dropping a dead binder removes a slot from that name's De Bruijn
-- namespace, so references that skipped over it must be lowered,
-- mirroring the Abs case (issue #56).
it "unshifts the body after dropping a dead shadowing binder" $ hedgehog do
let x = Name "x"
expr =
lets
(Standalone (noAnn, x, literalInt 1) :| [])
( lets
(Standalone (noAnn, x, exception "dead") :| [])
(refLocal x 1)
)
expected =
lets (Standalone (noAnn, x, literalInt 1) :| []) (refLocal x 0)
dceExpression expr === expected

it "unshifts later sibling RHSs after dropping a dead binder" $ hedgehog do
let x = Name "x"
y = Name "y"
expr =
lets
(Standalone (noAnn, x, literalInt 1) :| [])
( lets
( Standalone (noAnn, x, exception "dead")
:| [Standalone (noAnn, y, refLocal x 1)]
)
(refLocal y 0)
)
expected =
lets
(Standalone (noAnn, x, literalInt 1) :| [])
( lets
(Standalone (noAnn, y, refLocal x 0) :| [])
(refLocal y 0)
)
dceExpression expr === expected

it "unshifts after dropping a dead recursive-group member" $ hedgehog do
let x = Name "x"
y = Name "y"
expr =
lets
(Standalone (noAnn, x, literalInt 1) :| [])
( lets
( RecursiveGroup
( (noAnn, x, exception "dead")
:| [(noAnn, y, abstraction paramUnused (refLocal y 0))]
)
:| []
)
(application (refLocal y 0) (refLocal x 1))
)
expected =
lets
(Standalone (noAnn, x, literalInt 1) :| [])
( lets
( RecursiveGroup
((noAnn, y, abstraction paramUnused (refLocal y 0)) :| [])
:| []
)
(application (refLocal y 0) (refLocal x 0))
)
dceExpression expr === expected

--------------------------------------------------------------------------------
-- Helpers ---------------------------------------------------------------------

Expand Down
Loading