From 625a8cb00fd5b40856f589479eebf8e8ee1d9f70 Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Wed, 29 Jul 2026 10:57:55 +0200 Subject: [PATCH 1/2] test(ir): pin freshenBinders against a free Let-shadowed reference (#345) Two example-based guards for the sequential scoping rule (Note [Sequential scoping of Let bindings]) in the Let case of freshenBinders. The first is the minimal shape: freshening `let x = x in y` must rename the binder and leave the free x in its own right-hand side alone, because a Standalone binding is non-recursive. The second pins the left-to-right order across groupings, which an implementation that hoists every binder but the current one would still get wrong. Both are red on the current traversal, which collects every binder of a Let into one rename map before walking any right-hand side. --- .../PureScript/Backend/IR/Types/Spec.hs | 31 +++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/test/Language/PureScript/Backend/IR/Types/Spec.hs b/test/Language/PureScript/Backend/IR/Types/Spec.hs index ae290707..783bd0a6 100644 --- a/test/Language/PureScript/Backend/IR/Types/Spec.hs +++ b/test/Language/PureScript/Backend/IR/Types/Spec.hs @@ -354,6 +354,37 @@ spec = describe "Types" do annotateShow freshened alphaEq guc freshened === True + it "leaves a free reference alone in the RHS of its own binder" do + -- let x = x in y: a Standalone binding is non-recursive, so the + -- RHS x is a free occurrence of an outer x (Note [Sequential + -- scoping of Let bindings]); only the binder is freshened. + runSupply + ( freshenBinders + (lets (Standalone (noAnn, x, refLocal x) :| []) (refLocal y)) + ) + `shouldBe` lets + (Standalone (noAnn, Name "x$0", refLocal x) :| []) + (refLocal y) + + it "brings a Let's binders into scope left to right" do + -- let x = y; y = x in y: the RHS of the first binding predates the + -- y binder, so its y is free, while the RHS of the second sees the + -- freshened x and the body sees the freshened y. + runSupply + ( freshenBinders + ( lets + ( Standalone (noAnn, x, refLocal y) + :| [Standalone (noAnn, y, refLocal x)] + ) + (refLocal y) + ) + ) + `shouldBe` lets + ( Standalone (noAnn, Name "x$0", refLocal y) + :| [Standalone (noAnn, Name "y$1", refLocal (Name "x$0"))] + ) + (refLocal (Name "y$1")) + it "keeps the discard binders of a Let apart" do -- A magic-do-lowered thunk binds several Let statements to the -- GUC-exempt discard binder `_`. One name-keyed rename entry From a0fc3b1fe9569a122949bddb978a185941cf0f1f Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Wed, 29 Jul 2026 10:58:10 +0200 Subject: [PATCH 2/2] fix(ir): rename a Let's binders in scope order in freshenBinders (#345) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit freshenBinders collected every binder name of a Let into one rename map up front and walked all the right-hand sides under that single map. That holds only under global uniqueness, and on shadowed input it repoints a free reference: a Standalone binding is non-recursive, so a reference to its own name from its own right-hand side resolves to an outer binder, yet the binder's rename entry was already in the map when that right-hand side was walked. Freshening `let x = x in y` renamed both the binder and the free x beside it. Thread the map through the groupings instead: a Standalone right-hand side is renamed under the incoming map and its binder enters only afterwards, while a RecursiveGroup's members all enter before any of their right-hand sides is walked. This is what alphaEq and countFreeRefUsage already implement, and what the LetValues case of this same traversal already did. The discard binder's exemption moves into bindFresh unchanged. Emitted code is unaffected — uniquifyNames is the pipeline's entry pass, so no shadowed shape reaches freshenBinders in a real compilation — and the golden corpus is byte-identical. The visible cost was the property "IR Optimizer / inlines expressions referenced once" reddening intermittently; over hspec seeds 1..500 of that group it failed on seeds 328 and 379 before this change and on none after. Two comments in CSE.alphaKey that cited freshenBinders' hoisted shape now state the assumption directly. --- ...0000_unisay_freshen_binders_scope_order.md | 34 +++++++++ lib/Language/PureScript/Backend/IR/CSE.hs | 11 ++- lib/Language/PureScript/Backend/IR/Types.hs | 72 ++++++++++++------- 3 files changed, 86 insertions(+), 31 deletions(-) create mode 100644 changelog.d/20260729_120000_unisay_freshen_binders_scope_order.md diff --git a/changelog.d/20260729_120000_unisay_freshen_binders_scope_order.md b/changelog.d/20260729_120000_unisay_freshen_binders_scope_order.md new file mode 100644 index 00000000..08b71717 --- /dev/null +++ b/changelog.d/20260729_120000_unisay_freshen_binders_scope_order.md @@ -0,0 +1,34 @@ +### Fixed + +- `freshenBinders` — the traversal that alpha-renames an expression's binders + before a copy of it is pasted somewhere else — no longer renames a free + reference that happens to share the name of a `Let` binder it does not sit + under (#345). It collected every binder name of a `Let` into one rename map + up front and walked all the right-hand sides under that map, so freshening + `let x = x in y` renamed both the binder and the free `x` beside it, even + though a `Standalone` binding is non-recursive and its right-hand side + therefore resolves `x` to an outer binder + (Note [Sequential scoping of Let bindings]): + + ``` + Let (Standalone (Name "x$0", Ref (Local (Name "x$0")))) (Ref (Local (Name "y"))) + ``` + + The map is now threaded through the groupings in scope order — a + `Standalone` right-hand side is renamed before its own binder enters, a + `RecursiveGroup`'s members all enter before any of theirs is walked — which + is what `alphaEq` and `countFreeRefs` already implement, and what the + `LetValues` case of this same traversal already did: + + ``` + Let (Standalone (Name "x$0", Ref (Local (Name "x")))) (Ref (Local (Name "y"))) + ``` + + Emitted code is unchanged, and the whole golden corpus stays byte-identical: + `uniquifyNames` is the pipeline's entry pass and every later pass requires + the global-uniqueness condition it establishes, so real compilation never + presents a shadowed shape to `freshenBinders`. What the bug did cost was a + test suite that reddened intermittently, because the property + `IR Optimizer / inlines expressions referenced once` feeds the optimizer + deliberately non-uniquified generated terms and occasionally drew the + degenerate shape. diff --git a/lib/Language/PureScript/Backend/IR/CSE.hs b/lib/Language/PureScript/Backend/IR/CSE.hs index aa7e06ad..1d6d5fa5 100644 --- a/lib/Language/PureScript/Backend/IR/CSE.hs +++ b/lib/Language/PureScript/Backend/IR/CSE.hs @@ -424,10 +424,10 @@ annotations (the 'Language.PureScript.Backend.IR.Types.alphaEq' relation weakened by ignoring the annotations optimization sheds unevenly). Binders are resolved to their references by name, so the key is correct -under the GUC discipline the pass runs under (the blind descent of -'Language.PureScript.Backend.IR.Types.freshenBinders'; the discard -binder @_@ is exempt from uniqueness and referenced by nothing, so it -stays unrenamed). Free references keep their names; a positional +under the GUC discipline the pass runs under: binders are unique, so a +reference belongs to a binder iff the names match (the discard binder +@_@ is exempt from uniqueness and referenced by nothing, so it stays +unrenamed). Free references keep their names; a positional @$key\@ name cannot collide with one, because @$@ never occurs in a source identifier and every supply-minted name uses another prefix. -} @@ -449,8 +449,7 @@ alphaKey = canonicalize . void AbsN ann params' <$> go renames' body Let ann binds body → do -- Under unique binders no Let name can be referenced before it is - -- bound, so all the groupings can enter the rename map up front - -- (as in 'freshenBinders'). + -- bound, so all the groupings can enter the rename map up front. renames' ← foldlM ( \rs name → do diff --git a/lib/Language/PureScript/Backend/IR/Types.hs b/lib/Language/PureScript/Backend/IR/Types.hs index 31f6343e..9de8dae8 100644 --- a/lib/Language/PureScript/Backend/IR/Types.hs +++ b/lib/Language/PureScript/Backend/IR/Types.hs @@ -1255,12 +1255,11 @@ alphaEq = go 0 Map.empty Map.empty supply-minted name (@\$\@ — the @$@ cannot occur in a source identifier, so a mint can never collide with one), rewriting the references each binder binds. Free references — bound outside the -expression — are untouched. +expression — are untouched, one that happens to share a binder's name +included: the rename map is threaded in scope order, so a reference is +renamed only by a binder that encloses it, and the innermost such one +(Note [Sequential scoping of Let bindings]). -Correct only under the GUC discipline (@UniqueBinders@): binders -within the expression are unique, so a reference belongs to a binder -iff the names match, and the sequential scoping subtleties of -Note [Sequential scoping of Let bindings] cannot be observed. 'ParamUnused' binds nothing, and the name list of a 'ForeignImport' holds the export keys of the foreign source file, not binders — neither is renamed. @@ -1284,31 +1283,41 @@ freshenBinders = go Map.empty rhs' ← go renames rhs (renames', params') ← mapAccumM freshenParam renames params LetValues ann params' rhs' <$> go renames' body + -- The groupings bind sequentially, so the map grows left to right. Let ann binds body → do - -- Under unique binders no Let name can be referenced before it is - -- bound, so all the groupings can enter the rename map up front. - -- The discard binder `_` stays out of the map: it is exempt from - -- the uniqueness invariant, so one Let can bind it several times - -- (magic-do's discard statements), and a single name-keyed entry - -- would rename every one of them to the same fresh name — a - -- genuine duplicate the exemption no longer covers. Nothing may - -- reference it, so it needs no rename at all. - renames' ← - foldlM - ( \rs name → do - name' ← freshNameFor name - pure (Map.insert name name' rs) - ) - renames - (filter (/= discardName) (bindingNames =<< toList binds)) - let renameBound (bindAnn, name, expr) = - (bindAnn,Map.findWithDefault name name renames',) - <$> go renames' expr - Let ann <$> traverse (traverse renameBound) binds <*> go renames' body + (renames', binds') ← mapAccumM freshenGrouping renames binds + Let ann binds' <$> go renames' body -- No other constructor binds or references names ('ForeignImport' -- included: its name list holds export keys, not binders): other → traverseOf subexpressions (go renames) other + freshenGrouping + ∷ Map Name Name + → Grouping (ann, Name, RawExp ann) + → SupplyM (Map Name Name, Grouping (ann, Name, RawExp ann)) + freshenGrouping renames = \case + -- A Standalone binding is non-recursive: its RHS does not see its + -- own binder, so the RHS is renamed under the incoming map and the + -- binder enters only afterwards. + Standalone (bindAnn, name, expr) → do + expr' ← go renames expr + (renames', name') ← bindFresh renames name + pure (renames', Standalone (bindAnn, name', expr')) + -- Every member of a recursive group is in scope in every member's + -- RHS, so the whole group enters the map before any RHS is walked. + RecursiveGroup members → do + (renames', rebound) ← + mapAccumM + ( \rs (bindAnn, name, expr) → do + (rs', name') ← bindFresh rs name + pure (rs', (bindAnn, name', expr)) + ) + renames + members + members' ← forM rebound \(bindAnn, name, expr) → + (bindAnn,name,) <$> go renames' expr + pure (renames', RecursiveGroup members') + freshenParam ∷ Map Name Name → Parameter ann @@ -1319,6 +1328,19 @@ freshenBinders = go Map.empty name' ← freshNameFor name pure (Map.insert name name' rs, ParamNamed paramAnn name') + -- The discard binder @_@ stays out of the rename map: it is exempt + -- from the uniqueness invariant, so one Let can bind it several times + -- (magic-do's discard statements), and a single name-keyed entry + -- would rename every one of them to the same fresh name — a genuine + -- duplicate the exemption no longer covers. Nothing may reference it, + -- so it needs no rename at all. + bindFresh ∷ Map Name Name → Name → SupplyM (Map Name Name, Name) + bindFresh rs name + | name == discardName = pure (rs, name) + | otherwise = do + name' ← freshNameFor name + pure (Map.insert name name' rs, name') + freshNameFor ∷ Name → SupplyM Name freshNameFor name = freshName (stripFreshSuffix (nameToText name) <> "$")