purescript-lua · Unisay · Jul 29, 2026 · Jul 29, 2026 · Jul 29, 2026
diff --git a/changelog.d/20260729_120000_unisay_freshen_binders_scope_order.md 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
@@ -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\<n\>@ 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
@@ -1255,12 +1255,11 @@ alphaEq = go 0 Map.empty Map.empty
 supply-minted name (@\<original\>$\<n\>@ — 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) <> "$")
 

diff --git 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