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) <> "$") 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