From 47b3316bf3e82a5758485d7953b0b304dbd56623 Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Fri, 12 Jun 2026 10:43:30 +0200 Subject: [PATCH 1/5] test: reproduce issue #37 (undefined variable in compiled code) Golden test from PR #38 with the explicit export list from PR #39: with 'module ... (baz) where' the non-exported bindings get inlined and the generated Lua references an undefined variable Bind11. The luacheck golden suite fails with W113 until the bug is fixed. --- test/ps/golden/Golden/Issue37/Test.purs | 20 +++++++++++++++++++ .../ps/output/Golden.Issue37.Test/corefn.json | 1 + 2 files changed, 21 insertions(+) create mode 100644 test/ps/golden/Golden/Issue37/Test.purs create mode 100644 test/ps/output/Golden.Issue37.Test/corefn.json diff --git a/test/ps/golden/Golden/Issue37/Test.purs b/test/ps/golden/Golden/Issue37/Test.purs new file mode 100644 index 0000000..4dd75da --- /dev/null +++ b/test/ps/golden/Golden/Issue37/Test.purs @@ -0,0 +1,20 @@ +module Golden.Issue37.Test (baz) where + +import Prelude +import Effect (Effect) + +baz :: Effect Unit +baz = bar (pure unit) + +bar :: forall f. Monad f => f Unit -> f Unit +bar f = do + f + _ <- pure [ foo f ] + pure unit + +foo :: forall f. Monad f => f Unit -> f Unit +foo fn1 = do + _ <- fn1 + fn1 + fn1 + fn1 diff --git a/test/ps/output/Golden.Issue37.Test/corefn.json b/test/ps/output/Golden.Issue37.Test/corefn.json new file mode 100644 index 0000000..7005a9c --- /dev/null +++ b/test/ps/output/Golden.Issue37.Test/corefn.json @@ -0,0 +1 @@ +{"builtWith":"0.15.16","comments":[],"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":{"metaType":"IsForeign"},"sourceSpan":{"end":[18,6],"start":[18,3]}},"type":"Var","value":{"identifier":"discard","moduleName":["Control","Bind"]}},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[18,6],"start":[18,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"discardUnit","moduleName":["Control","Bind"]}},"type":"App"},"identifier":"discard"},{"annotation":{"meta":null,"sourceSpan":{"end":[15,45],"start":[15,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[15,45],"start":[15,1]}},"argument":"dictMonad","body":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"binds":[{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[17,11],"start":[17,3]}},"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"dictMonad","sourcePos":[0,0]}},"fieldName":"Bind1","type":"Accessor"},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[17,11],"start":[17,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"undefined","moduleName":["Prim"]}},"type":"App"},"identifier":"Bind1"},{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":{"metaType":"IsForeign"},"sourceSpan":{"end":[17,11],"start":[17,3]}},"type":"Var","value":{"identifier":"bind","moduleName":["Control","Bind"]}},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[17,11],"start":[17,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"Bind1","sourcePos":[0,0]}},"type":"App"},"identifier":"bind"},{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"discard","moduleName":["Golden","Issue37","Test"]}},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[18,6],"start":[18,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"Bind1","sourcePos":[0,0]}},"type":"App"},"identifier":"discard1"}],"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[15,45],"start":[15,1]}},"argument":"fn1","body":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"bind","sourcePos":[0,0]}},"annotation":{"meta":null,"sourceSpan":{"end":[17,11],"start":[17,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[17,11],"start":[17,8]}},"type":"Var","value":{"identifier":"fn1","sourcePos":[16,1]}},"type":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[17,11],"start":[17,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[17,11],"start":[17,3]}},"argument":"$__unused","body":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"discard1","sourcePos":[0,0]}},"annotation":{"meta":null,"sourceSpan":{"end":[18,6],"start":[18,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[18,6],"start":[18,3]}},"type":"Var","value":{"identifier":"fn1","sourcePos":[16,1]}},"type":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[18,6],"start":[18,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[18,6],"start":[18,3]}},"argument":"$__unused","body":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"discard1","sourcePos":[0,0]}},"annotation":{"meta":null,"sourceSpan":{"end":[19,6],"start":[19,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[19,6],"start":[19,3]}},"type":"Var","value":{"identifier":"fn1","sourcePos":[16,1]}},"type":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[19,6],"start":[19,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[19,6],"start":[19,3]}},"argument":"$__unused","body":{"annotation":{"meta":null,"sourceSpan":{"end":[20,6],"start":[20,3]}},"type":"Var","value":{"identifier":"fn1","sourcePos":[16,1]}},"type":"Abs"},"type":"App"},"type":"Abs"},"type":"App"},"type":"Abs"},"type":"App"},"type":"Abs"},"type":"Let"},"type":"Abs"},"identifier":"foo"},{"annotation":{"meta":null,"sourceSpan":{"end":[9,45],"start":[9,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[9,45],"start":[9,1]}},"argument":"dictMonad","body":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"binds":[{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[11,4],"start":[11,3]}},"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"dictMonad","sourcePos":[0,0]}},"fieldName":"Bind1","type":"Accessor"},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[11,4],"start":[11,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"undefined","moduleName":["Prim"]}},"type":"App"},"identifier":"Bind1"},{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"discard","moduleName":["Golden","Issue37","Test"]}},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[11,4],"start":[11,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"Bind1","sourcePos":[0,0]}},"type":"App"},"identifier":"discard1"},{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":{"metaType":"IsForeign"},"sourceSpan":{"end":[12,22],"start":[12,3]}},"type":"Var","value":{"identifier":"bind","moduleName":["Control","Bind"]}},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[12,22],"start":[12,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"Bind1","sourcePos":[0,0]}},"type":"App"},"identifier":"bind"},{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":{"metaType":"IsForeign"},"sourceSpan":{"end":[12,12],"start":[12,8]}},"type":"Var","value":{"identifier":"pure","moduleName":["Control","Applicative"]}},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[12,22],"start":[12,8]}},"argument":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[12,22],"start":[12,8]}},"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"dictMonad","sourcePos":[0,0]}},"fieldName":"Applicative0","type":"Accessor"},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[12,22],"start":[12,8]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"undefined","moduleName":["Prim"]}},"type":"App"},"type":"App"},"identifier":"pure"},{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[12,18],"start":[12,15]}},"type":"Var","value":{"identifier":"foo","moduleName":["Golden","Issue37","Test"]}},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[12,20],"start":[12,15]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"dictMonad","sourcePos":[0,0]}},"type":"App"},"identifier":"foo1"}],"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[9,45],"start":[9,1]}},"argument":"f","body":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"discard1","sourcePos":[0,0]}},"annotation":{"meta":null,"sourceSpan":{"end":[11,4],"start":[11,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[11,4],"start":[11,3]}},"type":"Var","value":{"identifier":"f","sourcePos":[10,1]}},"type":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[11,4],"start":[11,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[11,4],"start":[11,3]}},"argument":"$__unused","body":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"bind","sourcePos":[0,0]}},"annotation":{"meta":null,"sourceSpan":{"end":[12,22],"start":[12,3]}},"argument":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"pure","sourcePos":[0,0]}},"annotation":{"meta":null,"sourceSpan":{"end":[12,22],"start":[12,8]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[12,22],"start":[12,13]}},"type":"Literal","value":{"literalType":"ArrayLiteral","value":[{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"foo1","sourcePos":[0,0]}},"annotation":{"meta":null,"sourceSpan":{"end":[12,20],"start":[12,15]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[12,20],"start":[12,19]}},"type":"Var","value":{"identifier":"f","sourcePos":[10,1]}},"type":"App"}]}},"type":"App"},"type":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[12,22],"start":[12,3]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[12,22],"start":[12,3]}},"argument":"$__unused","body":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"pure","sourcePos":[0,0]}},"annotation":{"meta":null,"sourceSpan":{"end":[13,12],"start":[13,3]}},"argument":{"annotation":{"meta":{"metaType":"IsForeign"},"sourceSpan":{"end":[13,12],"start":[13,8]}},"type":"Var","value":{"identifier":"unit","moduleName":["Data","Unit"]}},"type":"App"},"type":"Abs"},"type":"App"},"type":"Abs"},"type":"App"},"type":"Abs"},"type":"Let"},"type":"Abs"},"identifier":"bar"},{"annotation":{"meta":null,"sourceSpan":{"end":[6,19],"start":[6,1]}},"bindType":"NonRec","expression":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[7,10],"start":[7,7]}},"type":"Var","value":{"identifier":"bar","moduleName":["Golden","Issue37","Test"]}},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[7,22],"start":[7,7]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"monadEffect","moduleName":["Effect"]}},"type":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[7,22],"start":[7,7]}},"argument":{"abstraction":{"abstraction":{"annotation":{"meta":{"metaType":"IsForeign"},"sourceSpan":{"end":[7,16],"start":[7,12]}},"type":"Var","value":{"identifier":"pure","moduleName":["Control","Applicative"]}},"annotation":{"meta":{"metaType":"IsSyntheticApp"},"sourceSpan":{"end":[7,21],"start":[7,12]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"type":"Var","value":{"identifier":"applicativeEffect","moduleName":["Effect"]}},"type":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[7,21],"start":[7,12]}},"argument":{"annotation":{"meta":{"metaType":"IsForeign"},"sourceSpan":{"end":[7,21],"start":[7,17]}},"type":"Var","value":{"identifier":"unit","moduleName":["Data","Unit"]}},"type":"App"},"type":"App"},"identifier":"baz"}],"exports":["baz"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[20,6],"start":[1,1]}},"moduleName":["Control","Applicative"]},{"annotation":{"meta":null,"sourceSpan":{"end":[20,6],"start":[1,1]}},"moduleName":["Control","Bind"]},{"annotation":{"meta":null,"sourceSpan":{"end":[20,6],"start":[1,1]}},"moduleName":["Data","Unit"]},{"annotation":{"meta":null,"sourceSpan":{"end":[20,6],"start":[1,1]}},"moduleName":["Effect"]},{"annotation":{"meta":null,"sourceSpan":{"end":[20,6],"start":[1,1]}},"moduleName":["Golden","Issue37","Test"]},{"annotation":{"meta":null,"sourceSpan":{"end":[3,15],"start":[3,1]}},"moduleName":["Prelude"]},{"annotation":{"meta":null,"sourceSpan":{"end":[20,6],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Golden","Issue37","Test"],"modulePath":"golden/Golden/Issue37/Test.purs","reExports":{},"sourceSpan":{"end":[20,6],"start":[1,1]}} \ No newline at end of file From 51d1b794dbcd71010c6829a86c163d83e394d112 Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Fri, 12 Jun 2026 10:51:59 +0200 Subject: [PATCH 2/5] test: pin sequential (let*) scoping convention for shift/substitute/countFreeRefs The IR's authoritative Let scoping convention (implemented by renameShadowedNames, DCE and Lua codegen) is sequential: in a standalone binding's RHS the earlier siblings of the same Let are in scope, while the binding's own name refers to an outer binder. shift, substitute and countFreeRefs in IR.Types implement the opposite convention, which makes inlining produce unbound references (issue #37). These tests are red until the convention is fixed. --- .../PureScript/Backend/IR/Optimizer/Spec.hs | 82 +++++++++++++++++++ .../PureScript/Backend/IR/Types/Spec.hs | 63 +++++++++++++- 2 files changed, 144 insertions(+), 1 deletion(-) diff --git a/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs b/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs index 56d119c..ef0f1af 100644 --- a/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs +++ b/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs @@ -1,5 +1,6 @@ module Language.PureScript.Backend.IR.Optimizer.Spec where +import Control.Lens (universeOf) import Data.Map qualified as Map import Hedgehog (annotateShow, forAll, (===)) import Hedgehog.Gen qualified as Gen @@ -8,6 +9,8 @@ import Language.PureScript.Backend.IR.Linker (LinkMode (..)) import Language.PureScript.Backend.IR.Linker qualified as Linker import Language.PureScript.Backend.IR.Names ( Name (..) + , QName (..) + , Qualified (Local) , moduleNameFromString ) import Language.PureScript.Backend.IR.Optimizer @@ -31,8 +34,10 @@ import Language.PureScript.Backend.IR.Types , noAnn , paramNamed , paramUnused + , refImported , refLocal , refLocal0 + , subexpressions ) import Test.Hspec (Spec, describe) import Test.Hspec.Hedgehog.Extended (test) @@ -117,6 +122,83 @@ spec = describe "IR Optimizer" do annotateShow expected optimizedUberModule original === expected + describe "scoping invariants" do + -- Mimics issue #37: an inlined binding contains a let with a + -- reference bound by an earlier sibling; inlining it under a binder + -- with the same name must not leave the reference unbound. + test "inlining bindings does not unbind let-bound references" do + let mainModule = moduleNameFromString "Main" + dict = moduleNameFromString "Dict" + fooExp = + abstraction (paramNamed (Name "fn1")) $ + lets + ( Standalone + ( noAnn + , Name "Bind1" + , application + (refImported dict (Name "bind") 0) + (refLocal (Name "fn1") 0) + ) + :| [ Standalone + ( noAnn + , Name "discard1" + , application + (refImported dict (Name "discard") 0) + (refLocal (Name "Bind1") 0) + ) + ] + ) + ( application + (refLocal (Name "discard1") 0) + (refLocal (Name "discard1") 0) + ) + barExp = + abstraction (paramNamed (Name "f")) $ + lets + ( Standalone + ( noAnn + , Name "Bind1" + , application + (refImported dict (Name "bind") 0) + (refLocal (Name "f") 0) + ) + :| [] + ) + ( application + ( application + (refImported mainModule (Name "foo") 0) + (refLocal (Name "f") 0) + ) + ( application + (refLocal (Name "Bind1") 0) + (refLocal (Name "Bind1") 0) + ) + ) + original = + Linker.UberModule + { uberModuleForeigns = [] + , uberModuleBindings = + [ Standalone (QName mainModule (Name "foo"), fooExp) + , Standalone (QName mainModule (Name "bar"), barExp) + ] + , uberModuleExports = + [ ( Name "baz" + , application + (refImported mainModule (Name "bar") 0) + (literalInt 7) + ) + ] + } + optimized = optimizedUberModule original + unboundLocalRefs = + [ (name, index) + | (_exportedName, expr) ← Linker.uberModuleExports optimized + , Ref _ann (Local name) index ← universeOf subexpressions expr + , index /= 0 + ] + annotateShow optimized + unboundLocalRefs === [] + describe "renames shadowed names" do test "nested λ-abstractions" do name ← forAll Gen.name diff --git a/test/Language/PureScript/Backend/IR/Types/Spec.hs b/test/Language/PureScript/Backend/IR/Types/Spec.hs index 88d7393..bfa44ad 100644 --- a/test/Language/PureScript/Backend/IR/Types/Spec.hs +++ b/test/Language/PureScript/Backend/IR/Types/Spec.hs @@ -5,13 +5,14 @@ import Hedgehog ((===)) import Language.PureScript.Backend.IR.Names ( ModuleName (..) , Name (..) - , Qualified (Imported) + , Qualified (Imported, Local) ) import Language.PureScript.Backend.IR.Types ( Exp , Grouping (..) , abstraction , application + , countFreeRef , countFreeRefs , lets , literalInt @@ -20,6 +21,8 @@ import Language.PureScript.Backend.IR.Types , paramUnused , refImported , refLocal + , shift + , substitute ) import Test.Hspec (Spec, describe) import Test.Hspec.Hedgehog.Extended (test) @@ -39,6 +42,64 @@ spec = describe "Types" do , (Imported (ModuleName "Partial.Unsafe") (Name "unsafePartial"), 1) ] + -- Convention: Let bindings have sequential (let*) scoping — in a + -- standalone binding's RHS the earlier siblings of the same Let are + -- in scope, while the binding's own name refers to an outer binder. + describe "Let sequential (let*) scoping" do + let x = Name "x" + y = Name "y" + + test "shift: ref bound by an earlier sibling is not shifted" do + let e = + lets + ( Standalone (noAnn, x, literalInt 1) + :| [Standalone (noAnn, y, refLocal x 0)] + ) + (literalInt 0) + shift 1 x 0 e === e + + test "shift: ref to an outer name in own RHS is shifted" do + let original = + lets (Standalone (noAnn, x, refLocal x 0) :| []) (literalInt 0) + shifted = + lets (Standalone (noAnn, x, refLocal x 1) :| []) (literalInt 0) + shift 1 x 0 original === shifted + + test "shift: ref in the body bound by the let is not shifted" do + let e = + lets (Standalone (noAnn, x, literalInt 1) :| []) (refLocal x 0) + shift 1 x 0 e === e + + test "countFreeRefs: ref bound by an earlier sibling is not free" do + let e = + lets + ( Standalone (noAnn, x, literalInt 1) + :| [Standalone (noAnn, y, refLocal x 0)] + ) + (literalInt 0) + countFreeRef (Local x) e === 0 + + test "countFreeRefs: ref to an outer name in own RHS is free" do + let e = + lets (Standalone (noAnn, x, refLocal x 0) :| []) (literalInt 0) + countFreeRef (Local x) e === 1 + + test "substitute: ref bound by an earlier sibling is not substituted" do + let e = + lets + ( Standalone (noAnn, x, literalInt 1) + :| [Standalone (noAnn, y, refLocal x 0)] + ) + (literalInt 0) + substitute (Local x) 0 (literalInt 42) e === e + + test "substitute: ref to an outer name in own RHS is substituted" do + let original = + lets (Standalone (noAnn, x, refLocal x 0) :| []) (literalInt 0) + expected = + lets (Standalone (noAnn, x, literalInt 42) :| []) (literalInt 0) + substitute (Local x) 0 (literalInt 42) original === expected + expr ∷ Exp expr = abstraction From 3c64f5ae4fed3a6d1629d0c6f8f46dd2ab6b5411 Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Fri, 12 Jun 2026 11:01:17 +0200 Subject: [PATCH 3/5] fix: align shift/substitute/countFreeRefs with sequential Let scoping (#37) The IR's Let scoping convention is sequential (let*): in a standalone binding's RHS the earlier siblings of the same Let are in scope, while the binding's own name refers to an outer binder. renameShadowedNames, DCE and the Lua codegen all follow this convention, but shift, substitute and countFreeRefs implemented the opposite one: they bumped the index for the binding's own name and ignored earlier siblings. As a result, inlining a non-exported binding whose body contained a let with a sibling-bound reference under a binder with the same name shifted that reference past its binder. DCE then deleted the "unused" binder and the Lua codegen rendered the dangling Ref (Local Bind1) 1 as an undefined variable Bind11. Also harden the codegen: a local reference with a non-zero index after renameShadowedNames is now a compile-time error (UnexpectedRefBound) instead of being silently rendered as an undefined Lua variable. --- lib/Language/PureScript/Backend/IR/Types.hs | 161 ++++---- lib/Language/PureScript/Backend/Lua.hs | 27 +- .../PureScript/Backend/IR/Optimizer/Spec.hs | 15 +- test/ps/output/Golden.Issue37.Test/golden.ir | 378 ++++++++++++++++++ test/ps/output/Golden.Issue37.Test/golden.lua | 98 +++++ 5 files changed, 585 insertions(+), 94 deletions(-) create mode 100644 test/ps/output/Golden.Issue37.Test/golden.ir create mode 100644 test/ps/output/Golden.Issue37.Test/golden.lua diff --git a/lib/Language/PureScript/Backend/IR/Types.hs b/lib/Language/PureScript/Backend/IR/Types.hs index 7783e7c..e64e829 100644 --- a/lib/Language/PureScript/Backend/IR/Types.hs +++ b/lib/Language/PureScript/Backend/IR/Types.hs @@ -507,28 +507,41 @@ countFreeRefs = fmap getSum . MMap.toMap . countFreeRefs' mempty where minIndexes' = Map.insertWith (+) (Local name) 1 minIndexes ParamUnused _paramAnn → countFreeRefs' minIndexes body + -- Let bindings have sequential (let*) scoping: in a standalone + -- binding's RHS the earlier siblings of the same Let are in scope, + -- while the binding's own name refers to an outer binder. Members + -- of a recursive group additionally see the whole group. Let _ann binds body → fold (countsInBody : countsInBinds) where - countsInBody = countFreeRefs' minIndexes' body - where - minIndexes' = - foldr (\name → Map.insertWith (+) name 1) minIndexes $ - toList binds >>= fmap Local . bindingNames - countsInBinds = - toList binds >>= \case - Standalone (_nameAnn, boundName, expr) → - [countFreeRefs' minIndexes' expr] - where - minIndexes' = Map.insertWith (+) (Local boundName) 1 minIndexes - RecursiveGroup recBinds → - toList recBinds <&> \(_nameAnn, _boundName, expr) → - countFreeRefs' minIndexes' expr - where - minIndexes' = - foldr - (\(_nameAnn, qName, _expr) → Map.insertWith (+) (Local qName) 1) - minIndexes - recBinds + countsInBody = countFreeRefs' minIndexesAfterBinds body + (minIndexesAfterBinds, countsInBinds) = + foldl' withGrouping (minIndexes, []) (toList binds) + withGrouping + ∷ ( Map (Qualified Name) Index + , [MonoidMap (Qualified Name) (Sum Natural)] + ) + → Grouping (ann, Name, RawExp ann) + → ( Map (Qualified Name) Index + , [MonoidMap (Qualified Name) (Sum Natural)] + ) + withGrouping (mins, counts) = \case + Standalone (_nameAnn, boundName, expr) → + ( Map.insertWith (+) (Local boundName) 1 mins + , countFreeRefs' mins expr : counts + ) + RecursiveGroup recBinds → + ( minsAfterGroup + , ( toList recBinds <&> \(_nameAnn, _boundName, expr) → + countFreeRefs' minsAfterGroup expr + ) + <> counts + ) + where + minsAfterGroup = + foldr + (\(_nameAnn, qName, _expr) → Map.insertWith (+) (Local qName) 1) + mins + recBinds App _ann argument function → go argument <> go function LiteralArray _ann as → @@ -604,39 +617,39 @@ substitute name idx replacement = substitute' idx where index' = if name == Local pName then index + 1 else index replacement' = shift 1 pName 0 replacement + -- Sequential (let*) scoping: a standalone binding's RHS sees the + -- earlier siblings of the same Let (its own name refers to an + -- outer binder), recursive group members see the whole group, + -- and the body sees all the bindings. Let ann binds body → Let ann binds' body' where - binds' = - binds <&> \grouping → - case grouping of - Standalone (nameAnn, boundName, expr) → - Standalone - ( nameAnn - , boundName - , substitute name index' replacement' expr - ) - where - index' - | name == Local boundName = index + 1 - | otherwise = index - replacement' = shift 1 boundName 0 replacement - RecursiveGroup recBinds → - RecursiveGroup $ - substitute name index' replacement' <<$>> recBinds - where - index' - | name `elem` fmap Local boundNames = index + 1 - | otherwise = index - replacement' = - foldr (\n r → shift 1 n 0 r) replacement boundNames - boundNames = bindingNames grouping - body' = substitute name index' replacement' body - where - boundNames = toList binds >>= bindingNames - index' = - index - & if name `elem` (Local <$> boundNames) then (+ 1) else id - replacement' = foldr (\n r → shift 1 n 0 r) replacement boundNames + ((bodyIndex, bodyReplacement), binds') = + mapAccumL withGrouping (index, replacement) binds + body' = substitute name bodyIndex bodyReplacement body + withGrouping + ∷ (Index, RawExp ann) + → Grouping (ann, Name, RawExp ann) + → ((Index, RawExp ann), Grouping (ann, Name, RawExp ann)) + withGrouping (i, repl) grouping = + case grouping of + Standalone (nameAnn, boundName, expr) → + ( + ( if name == Local boundName then i + 1 else i + , shift 1 boundName 0 repl + ) + , Standalone (nameAnn, boundName, substitute name i repl expr) + ) + RecursiveGroup recBinds → + ( (i', repl') + , RecursiveGroup $ substitute name i' repl' <<$>> recBinds + ) + where + boundNames = bindingNames grouping + i' = + i + + fromIntegral + (length (filter ((name ==) . Local) boundNames)) + repl' = foldr (\n r → shift 1 n 0 r) repl boundNames App ann argument function → App ann (go argument) (go function) LiteralArray ann as → @@ -696,36 +709,36 @@ shift offset namespace minIndex expression = minIndex' | paramName argument == Just namespace = minIndex + 1 | otherwise = minIndex + -- Sequential (let*) scoping: a standalone binding's RHS sees the + -- earlier siblings of the same Let (its own name refers to an + -- outer binder), recursive group members see the whole group, + -- and the body sees all the bindings. Let ann binds body → Let ann binds' body' where - binds' = - binds <&> \grouping → - case grouping of - Standalone (annotation, boundName, expr) → - Standalone + (bodyMinIndex, binds') = mapAccumL withGrouping minIndex binds + body' = shift offset namespace bodyMinIndex body + withGrouping minIdx grouping = + case grouping of + Standalone (annotation, boundName, expr) → + ( if boundName == namespace then minIdx + 1 else minIdx + , Standalone ( annotation , boundName - , shift offset namespace minIndex' expr + , shift offset namespace minIdx expr ) - where - minIndex' - | namespace == boundName = minIndex + 1 - | otherwise = minIndex - RecursiveGroup recBinds → - RecursiveGroup $ + ) + RecursiveGroup recBinds → + ( minIdx' + , RecursiveGroup $ recBinds <&> \(nameAnn, boundName, expr) → - (nameAnn, boundName, shift offset namespace minIndex' expr) - where - minIndex' - | namespace `elem` bindingNames grouping = minIndex + 1 - | otherwise = minIndex - body' = shift offset namespace minIndex' body - where - boundNames' = toList binds >>= bindingNames - minIndex' - | namespace `elem` boundNames' = minIndex + 1 - | otherwise = minIndex + (nameAnn, boundName, shift offset namespace minIdx' expr) + ) + where + minIdx' = + minIdx + + fromIntegral + (length (filter (== namespace) (bindingNames grouping))) App ann argument function → App ann (go argument) (go function) LiteralArray ann as → diff --git a/lib/Language/PureScript/Backend/Lua.hs b/lib/Language/PureScript/Backend/Lua.hs index fff3710..dcbe233 100644 --- a/lib/Language/PureScript/Backend/Lua.hs +++ b/lib/Language/PureScript/Backend/Lua.hs @@ -127,12 +127,6 @@ asExpression = \case fromName ∷ HasCallStack ⇒ IR.Name → Lua.Name fromName = Name.makeSafe . IR.nameToText -fromNameWithIndex ∷ HasCallStack ⇒ IR.Name → IR.Index → Lua.Name -fromNameWithIndex name (IR.unIndex → index) = - if index == 0 - then fromName name - else Name.makeSafe $ IR.nameToText name <> show index - fromModuleName ∷ ModuleName → Lua.Name fromModuleName = Name.makeSafe . runModuleName @@ -207,17 +201,24 @@ fromIR foreigns topLevelNames modname ir = case ir of pure [] _ → goExp arg <&> \a → [a] IR.Ref _ann qualifiedName index → - pure . Right $ case qualifiedName of + case qualifiedName of IR.Local name | topLevelName ← qualifyName modname (fromName name) , Set.member topLevelName topLevelNames → - Lua.varField (Lua.varName Fixture.moduleName) topLevelName - IR.Local name → - Lua.varName (fromNameWithIndex name index) + pure . Right $ + Lua.varField (Lua.varName Fixture.moduleName) topLevelName + IR.Local name + -- After the optimizer's renameShadowedNames pass every local + -- reference must resolve to its binder by name alone: a + -- non-zero index means the reference is unbound and would be + -- rendered as an undefined Lua variable (issue #37). + | index == 0 → pure . Right $ Lua.varName (fromName name) + | otherwise → Oops.throw $ UnexpectedRefBound modname ir IR.Imported modname' name → - Lua.varField - (Lua.varName Fixture.moduleName) - (qualifyName modname' (fromName name)) + pure . Right $ + Lua.varField + (Lua.varName Fixture.moduleName) + (qualifyName modname' (fromName name)) IR.Let _ann bindings bodyExp → do body ← go bodyExp recs ← diff --git a/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs b/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs index ef0f1af..4c01c4b 100644 --- a/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs +++ b/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs @@ -140,12 +140,12 @@ spec = describe "IR Optimizer" do (refLocal (Name "fn1") 0) ) :| [ Standalone - ( noAnn - , Name "discard1" - , application - (refImported dict (Name "discard") 0) - (refLocal (Name "Bind1") 0) - ) + ( noAnn + , Name "discard1" + , application + (refImported dict (Name "discard") 0) + (refLocal (Name "Bind1") 0) + ) ] ) ( application @@ -182,7 +182,8 @@ spec = describe "IR Optimizer" do , Standalone (QName mainModule (Name "bar"), barExp) ] , uberModuleExports = - [ ( Name "baz" + [ + ( Name "baz" , application (refImported mainModule (Name "bar") 0) (literalInt 7) diff --git a/test/ps/output/Golden.Issue37.Test/golden.ir b/test/ps/output/Golden.Issue37.Test/golden.ir new file mode 100644 index 0000000..1019739 --- /dev/null +++ b/test/ps/output/Golden.Issue37.Test/golden.ir @@ -0,0 +1,378 @@ +UberModule + { uberModuleBindings = + [ Standalone + ( QName + { qnameModuleName = ModuleName "Data.Unit", qnameName = Name "foreign" + }, ForeignImport Nothing + ( ModuleName "Data.Unit" ) ".spago/prelude/v7.2.0/src/Data/Unit.purs" + [ ( Just Always, Name "unit" ) ] + ), Standalone + ( QName + { qnameModuleName = ModuleName "Effect", qnameName = Name "foreign" + }, ForeignImport Nothing + ( ModuleName "Effect" ) ".spago/effect/v4.1.0/src/Effect.purs" + [ ( Nothing, Name "pureE" ), ( Nothing, Name "bindE" ) ] + ), Standalone + ( QName + { qnameModuleName = ModuleName "Control.Applicative", qnameName = Name "pure" + }, Abs Nothing + ( ParamNamed Nothing ( Name "dict" ) ) + ( ObjectProp Nothing ( Ref Nothing ( Local ( Name "dict" ) ) 0 ) ( PropName "pure" ) ) + ), Standalone + ( QName + { qnameModuleName = ModuleName "Control.Bind", qnameName = Name "bind" }, Abs Nothing + ( ParamNamed Nothing ( Name "dict" ) ) + ( ObjectProp Nothing ( Ref Nothing ( Local ( Name "dict" ) ) 0 ) ( PropName "bind" ) ) + ), RecursiveGroup + ( + ( QName + { qnameModuleName = ModuleName "Effect", qnameName = Name "monadEffect" + }, LiteralObject Nothing + [ + ( PropName "Applicative0", Abs Nothing ( ParamUnused Nothing ) + ( Ref Nothing ( Imported ( ModuleName "Effect" ) ( Name "applicativeEffect" ) ) 0 ) + ), + ( PropName "Bind1", Abs Nothing ( ParamUnused Nothing ) + ( Ref Nothing ( Imported ( ModuleName "Effect" ) ( Name "bindEffect" ) ) 0 ) + ) + ] + ) :| + [ + ( QName + { qnameModuleName = ModuleName "Effect", qnameName = Name "bindEffect" + }, LiteralObject Nothing + [ + ( PropName "bind", ObjectProp ( Just Always ) + ( Ref Nothing ( Imported ( ModuleName "Effect" ) ( Name "foreign" ) ) 0 ) + ( PropName "bindE" ) + ), + ( PropName "Apply0", Abs Nothing ( ParamUnused Nothing ) + ( App Nothing + ( Ref Nothing + ( Imported ( ModuleName "Effect" ) ( Name "Lazy_applyEffect" ) ) 0 + ) + ( LiteralInt Nothing 0 ) + ) + ) + ] + ), + ( QName + { qnameModuleName = ModuleName "Effect", qnameName = Name "applicativeEffect" + }, LiteralObject Nothing + [ + ( PropName "pure", ObjectProp ( Just Always ) + ( Ref Nothing ( Imported ( ModuleName "Effect" ) ( Name "foreign" ) ) 0 ) + ( PropName "pureE" ) + ), + ( PropName "Apply0", Abs Nothing ( ParamUnused Nothing ) + ( App Nothing + ( Ref Nothing + ( Imported ( ModuleName "Effect" ) ( Name "Lazy_applyEffect" ) ) 0 + ) + ( LiteralInt Nothing 0 ) + ) + ) + ] + ), + ( QName + { qnameModuleName = ModuleName "Effect", qnameName = Name "Lazy_functorEffect" + }, App Nothing + ( App Nothing + ( Ref Nothing ( Local ( Name "PSLUA_runtime_lazy" ) ) 0 ) + ( LiteralString Nothing "functorEffect" ) + ) + ( Abs Nothing ( ParamUnused Nothing ) + ( LiteralObject Nothing + [ + ( PropName "map", Abs Nothing + ( ParamNamed Nothing ( Name "f" ) ) + ( App Nothing + ( ObjectProp Nothing + ( App Nothing + ( ObjectProp Nothing + ( Ref Nothing + ( Imported ( ModuleName "Effect" ) ( Name "applicativeEffect" ) ) 0 + ) + ( PropName "Apply0" ) + ) + ( Ref Nothing ( Imported ( ModuleName "Prim" ) ( Name "undefined" ) ) 0 ) + ) + ( PropName "apply" ) + ) + ( App Nothing + ( App Nothing + ( Ref Nothing + ( Imported ( ModuleName "Control.Applicative" ) ( Name "pure" ) ) 0 + ) + ( Ref Nothing + ( Imported ( ModuleName "Effect" ) ( Name "applicativeEffect" ) ) 0 + ) + ) + ( Ref Nothing ( Local ( Name "f" ) ) 0 ) + ) + ) + ) + ] + ) + ) + ), + ( QName + { qnameModuleName = ModuleName "Effect", qnameName = Name "Lazy_applyEffect" + }, App Nothing + ( App Nothing + ( Ref Nothing ( Local ( Name "PSLUA_runtime_lazy" ) ) 0 ) + ( LiteralString Nothing "applyEffect" ) + ) + ( Abs Nothing ( ParamUnused Nothing ) + ( LiteralObject Nothing + [ + ( PropName "apply", Let Nothing + ( Standalone + ( Nothing, Name "bind", App Nothing + ( Ref Nothing + ( Imported ( ModuleName "Control.Bind" ) ( Name "bind" ) ) 0 + ) + ( App Nothing + ( ObjectProp Nothing + ( Ref Nothing + ( Imported ( ModuleName "Effect" ) ( Name "monadEffect" ) ) 0 + ) + ( PropName "Bind1" ) + ) + ( Ref Nothing ( Imported ( ModuleName "Prim" ) ( Name "undefined" ) ) 0 ) + ) + ) :| [] + ) + ( Abs Nothing + ( ParamNamed Nothing ( Name "f" ) ) + ( Abs Nothing + ( ParamNamed Nothing ( Name "a" ) ) + ( App Nothing + ( App Nothing + ( Ref Nothing ( Local ( Name "bind" ) ) 0 ) + ( Ref Nothing ( Local ( Name "f" ) ) 0 ) + ) + ( Abs Nothing + ( ParamNamed Nothing ( Name "f'" ) ) + ( App Nothing + ( App Nothing + ( Ref Nothing ( Local ( Name "bind" ) ) 0 ) + ( Ref Nothing ( Local ( Name "a" ) ) 0 ) + ) + ( Abs Nothing + ( ParamNamed Nothing ( Name "a'" ) ) + ( App Nothing + ( App Nothing + ( Ref Nothing + ( Imported + ( ModuleName "Control.Applicative" ) + ( Name "pure" ) + ) 0 + ) + ( App Nothing + ( ObjectProp Nothing + ( Ref Nothing + ( Imported + ( ModuleName "Effect" ) + ( Name "monadEffect" ) + ) 0 + ) + ( PropName "Applicative0" ) + ) + ( Ref Nothing + ( Imported ( ModuleName "Prim" ) ( Name "undefined" ) ) 0 + ) + ) + ) + ( App Nothing + ( Ref Nothing ( Local ( Name "f'" ) ) 0 ) + ( Ref Nothing ( Local ( Name "a'" ) ) 0 ) + ) + ) + ) + ) + ) + ) + ) + ) + ), + ( PropName "Functor0", Abs Nothing ( ParamUnused Nothing ) + ( App Nothing + ( Ref Nothing + ( Imported ( ModuleName "Effect" ) ( Name "Lazy_functorEffect" ) ) 0 + ) + ( LiteralInt Nothing 0 ) + ) + ) + ] + ) + ) + ) + ] + ), Standalone + ( QName + { qnameModuleName = ModuleName "Golden.Issue37.Test", qnameName = Name "discard" + }, ObjectProp Nothing + ( LiteralObject Nothing + [ + ( PropName "discard", Ref Nothing + ( Imported ( ModuleName "Control.Bind" ) ( Name "bind" ) ) 0 + ) + ] + ) + ( PropName "discard" ) + ) + ], uberModuleForeigns = [], uberModuleExports = + [ + ( Name "baz", App Nothing + ( Let Nothing + ( Standalone + ( Nothing, Name "Bind1", App Nothing + ( ObjectProp Nothing + ( Ref Nothing ( Imported ( ModuleName "Effect" ) ( Name "monadEffect" ) ) 0 ) + ( PropName "Bind1" ) + ) + ( Ref Nothing ( Imported ( ModuleName "Prim" ) ( Name "undefined" ) ) 0 ) + ) :| + [ Standalone + ( Nothing, Name "pure", App Nothing + ( Ref Nothing ( Imported ( ModuleName "Control.Applicative" ) ( Name "pure" ) ) 0 ) + ( App Nothing + ( ObjectProp Nothing + ( Ref Nothing ( Imported ( ModuleName "Effect" ) ( Name "monadEffect" ) ) 0 ) + ( PropName "Applicative0" ) + ) + ( Ref Nothing ( Imported ( ModuleName "Prim" ) ( Name "undefined" ) ) 0 ) + ) + ) + ] + ) + ( Abs Nothing + ( ParamNamed Nothing ( Name "f" ) ) + ( App Nothing + ( App Nothing + ( App Nothing + ( Ref Nothing + ( Imported ( ModuleName "Golden.Issue37.Test" ) ( Name "discard" ) ) 0 + ) + ( Ref Nothing ( Local ( Name "Bind1" ) ) 0 ) + ) + ( Ref Nothing ( Local ( Name "f" ) ) 0 ) + ) + ( Abs Nothing ( ParamUnused Nothing ) + ( App Nothing + ( App Nothing + ( App Nothing + ( Ref Nothing ( Imported ( ModuleName "Control.Bind" ) ( Name "bind" ) ) 0 ) + ( Ref Nothing ( Local ( Name "Bind1" ) ) 0 ) + ) + ( App Nothing + ( Ref Nothing ( Local ( Name "pure" ) ) 0 ) + ( LiteralArray Nothing + [ App Nothing + ( Let Nothing + ( Standalone + ( Nothing, Name "Bind11", App Nothing + ( ObjectProp Nothing + ( Ref Nothing + ( Imported ( ModuleName "Effect" ) ( Name "monadEffect" ) ) 0 + ) + ( PropName "Bind1" ) + ) + ( Ref Nothing + ( Imported ( ModuleName "Prim" ) ( Name "undefined" ) ) 0 + ) + ) :| + [ Standalone + ( Nothing, Name "discard1", App Nothing + ( Ref Nothing + ( Imported + ( ModuleName "Golden.Issue37.Test" ) + ( Name "discard" ) + ) 0 + ) + ( Ref Nothing ( Local ( Name "Bind11" ) ) 0 ) + ) + ] + ) + ( Abs Nothing + ( ParamNamed Nothing ( Name "fn1" ) ) + ( App Nothing + ( App Nothing + ( App Nothing + ( Ref Nothing + ( Imported ( ModuleName "Control.Bind" ) ( Name "bind" ) ) 0 + ) + ( App Nothing + ( ObjectProp Nothing + ( Ref Nothing + ( Imported + ( ModuleName "Effect" ) + ( Name "monadEffect" ) + ) 0 + ) + ( PropName "Bind1" ) + ) + ( Ref Nothing + ( Imported ( ModuleName "Prim" ) ( Name "undefined" ) ) 0 + ) + ) + ) + ( Ref Nothing ( Local ( Name "fn1" ) ) 0 ) + ) + ( Abs Nothing ( ParamUnused Nothing ) + ( App Nothing + ( App Nothing + ( Ref Nothing ( Local ( Name "discard1" ) ) 0 ) + ( Ref Nothing ( Local ( Name "fn1" ) ) 0 ) + ) + ( Abs Nothing ( ParamUnused Nothing ) + ( App Nothing + ( App Nothing + ( Ref Nothing ( Local ( Name "discard1" ) ) 0 ) + ( Ref Nothing ( Local ( Name "fn1" ) ) 0 ) + ) + ( Abs Nothing ( ParamUnused Nothing ) + ( Ref Nothing ( Local ( Name "fn1" ) ) 0 ) + ) + ) + ) + ) + ) + ) + ) + ) + ( Ref Nothing ( Local ( Name "f" ) ) 0 ) + ] + ) + ) + ) + ( Abs Nothing ( ParamUnused Nothing ) + ( App Nothing + ( Ref Nothing ( Local ( Name "pure" ) ) 0 ) + ( ObjectProp ( Just Always ) + ( Ref Nothing + ( Imported ( ModuleName "Data.Unit" ) ( Name "foreign" ) ) 0 + ) + ( PropName "unit" ) + ) + ) + ) + ) + ) + ) + ) + ) + ( App Nothing + ( App Nothing + ( Ref Nothing ( Imported ( ModuleName "Control.Applicative" ) ( Name "pure" ) ) 0 ) + ( Ref Nothing ( Imported ( ModuleName "Effect" ) ( Name "applicativeEffect" ) ) 0 ) + ) + ( ObjectProp ( Just Always ) + ( Ref Nothing ( Imported ( ModuleName "Data.Unit" ) ( Name "foreign" ) ) 0 ) + ( PropName "unit" ) + ) + ) + ) + ] + } \ No newline at end of file diff --git a/test/ps/output/Golden.Issue37.Test/golden.lua b/test/ps/output/Golden.Issue37.Test/golden.lua new file mode 100644 index 0000000..fe39af7 --- /dev/null +++ b/test/ps/output/Golden.Issue37.Test/golden.lua @@ -0,0 +1,98 @@ +local function PSLUA_runtime_lazy(name) + return function(init) + return function() + local state = 0 + local val = nil + if state == 2 then + return val + else + if state == 1 then + return error(name .. " was needed before it finished initializing") + else + state = 1 + val = init() + state = 2 + return val + end + end + end + end +end +local M = {} +M.Data_Unit_foreign = { unit = {} } +M.Effect_foreign = { + pureE = function(a) + return function() + return a + end + end, + bindE = function(a) + return function(f) + return function() + return f(a())() + end + end + end +} +M.Control_Applicative_pure = function(dict) return dict.pure end +M.Control_Bind_bind = function(dict) return dict.bind end +M.Effect_monadEffect = { + Applicative0 = function() return M.Effect_applicativeEffect end, + Bind1 = function() return M.Effect_bindEffect end +} +M.Effect_bindEffect = { + bind = M.Effect_foreign.bindE, + Apply0 = function() return M.Effect_Lazy_applyEffect(0) end +} +M.Effect_applicativeEffect = { + pure = M.Effect_foreign.pureE, + Apply0 = function() return M.Effect_Lazy_applyEffect(0) end +} +M.Effect_Lazy_functorEffect = PSLUA_runtime_lazy("functorEffect")(function() + return { + map = function(f) + return (M.Effect_applicativeEffect.Apply0()).apply(M.Control_Applicative_pure(M.Effect_applicativeEffect)(f)) + end + } +end) +M.Effect_Lazy_applyEffect = PSLUA_runtime_lazy("applyEffect")(function() + return { + apply = (function() + return function(f) + local bind = M.Control_Bind_bind(M.Effect_monadEffect.Bind1()) + return function(a) + return bind(f)(function(fPrime) + return bind(a)(function(aPrime) + return M.Control_Applicative_pure(M.Effect_monadEffect.Applicative0())(fPrime(aPrime)) + end) + end) + end + end + end)(), + Functor0 = function() return M.Effect_Lazy_functorEffect(0) end + } +end) +M.Golden_Issue37_Test_discard = M.Control_Bind_bind +return { + baz = (function() + return function(f) + local Bind1 = M.Effect_monadEffect.Bind1() + local pure = M.Control_Applicative_pure(M.Effect_monadEffect.Applicative0()) + return M.Golden_Issue37_Test_discard(Bind1)(f)(function() + return M.Control_Bind_bind(Bind1)(pure({ + [1] = (function() + return function(fn1) + local Bind11 = M.Effect_monadEffect.Bind1() + local discard1 = M.Golden_Issue37_Test_discard(Bind11) + return M.Control_Bind_bind(M.Effect_monadEffect.Bind1())(fn1)(function( ) + return discard1(fn1)(function() + return discard1(fn1)(function() return fn1 end) + end) + end) + end + end)()(f) + }))(function() return pure(M.Data_Unit_foreign.unit) end) + end) + end + end)()(M.Control_Applicative_pure(M.Effect_applicativeEffect)(M.Data_Unit_foreign.unit)) +} From 55a75747b984a3504f80b135ea06527b1061eed5 Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Fri, 12 Jun 2026 11:03:26 +0200 Subject: [PATCH 4/5] chore(test): fix typo in golden spec progress message --- test/Language/PureScript/Backend/Lua/Golden/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Language/PureScript/Backend/Lua/Golden/Spec.hs b/test/Language/PureScript/Backend/Lua/Golden/Spec.hs index e712f35..50ba4a7 100644 --- a/test/Language/PureScript/Backend/Lua/Golden/Spec.hs +++ b/test/Language/PureScript/Backend/Lua/Golden/Spec.hs @@ -75,7 +75,7 @@ spec ∷ Spec spec = do describe "Goldens: *.purs -> *.lua" do let compilePs = do - putText "Comipling PureScript sources" + putText "Compiling PureScript sources" exitCode ← runProcess . setWorkingDir "test/ps" . shell $ String.unwords ["spago", "build", "-u", "'-g corefn'"] From 69bd23c11c074f28fa3ae78e439d3dc6716b1b36 Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Fri, 12 Jun 2026 11:41:33 +0200 Subject: [PATCH 5/5] docs: add Note [Sequential scoping of Let bindings]; fix same defect in Linker Consolidate the let*-scoping convention, previously copy-pasted at three Let cases in IR.Types and paraphrased across Lua codegen, DCE and two test specs, into a single GHC-style Note in IR.Types referenced from every site that implements or depends on it. Add a companion Note [Locals are uniquely named after renameShadowedNames] in IR.Optimizer documenting why renameShadowedNames must run last and why the Lua backend rejects non-zero local indices. While auditing for the convention, qualifyTopRefs in IR.Linker turned out to have the same defect issue #37 had: it qualified Let groupings independently instead of threading the per-name scope left to right, so a reference bound by an earlier sibling could be mis-qualified to a top-level binding. Fixed with mapAccumL threading mirroring the IR.Types functions, plus IR.Linker.Spec unit tests (red before the fix, green after). --- lib/Language/PureScript/Backend/IR/DCE.hs | 1 + lib/Language/PureScript/Backend/IR/Linker.hs | 34 +++++---- .../PureScript/Backend/IR/Optimizer.hs | 30 +++++++- lib/Language/PureScript/Backend/IR/Types.hs | 73 ++++++++++++++++--- lib/Language/PureScript/Backend/Lua.hs | 7 +- pslua.cabal | 1 + .../PureScript/Backend/IR/Linker/Spec.hs | 60 +++++++++++++++ .../PureScript/Backend/IR/Optimizer/Spec.hs | 1 + .../PureScript/Backend/IR/Types/Spec.hs | 4 +- test/Main.hs | 2 + 10 files changed, 178 insertions(+), 35 deletions(-) create mode 100644 test/Language/PureScript/Backend/IR/Linker/Spec.hs diff --git a/lib/Language/PureScript/Backend/IR/DCE.hs b/lib/Language/PureScript/Backend/IR/DCE.hs index 6bca7a8..7f95c96 100644 --- a/lib/Language/PureScript/Backend/IR/DCE.hs +++ b/lib/Language/PureScript/Backend/IR/DCE.hs @@ -309,6 +309,7 @@ eliminateDeadCode uber@UberModule {..} = addToScope ((nameId, _ann), name, _expr) = addLocalToScope nameId name 0 where + -- See Note [Sequential scoping of Let bindings] adjacencyListForGrouping ∷ (Scope, DList Node) → Grouping ((Id, Ann), Name, AExp) diff --git a/lib/Language/PureScript/Backend/IR/Linker.hs b/lib/Language/PureScript/Backend/IR/Linker.hs index c4d5210..ee8b825 100644 --- a/lib/Language/PureScript/Backend/IR/Linker.hs +++ b/lib/Language/PureScript/Backend/IR/Linker.hs @@ -106,23 +106,27 @@ qualifyTopRefs moduleName = go case parameter of ParamNamed _ann argName → Map.adjust (+ 1) argName topNames ParamUnused _ann → topNames + -- See Note [Sequential scoping of Let bindings] Let ann groupings body → - Let ann (qualifyGroupings groupings) (qualifyBody body) + Let ann groupings' (go topNamesAfterBinds body) where - qualifyGroupings ∷ NonEmpty Binding → NonEmpty Binding - qualifyGroupings = fmap \case - Standalone (a, name, expr) → - Standalone (a, name, go (Map.adjust (+ 1) name topNames) expr) - RecursiveGroup recBinds → - RecursiveGroup do - (a, name, expr) ← recBinds - pure (a, name, go indexedNames expr) - where - boundNames = toList recBinds <&> \(_, n, _) → n - indexedNames = foldr (Map.adjust (+ 1)) topNames boundNames - qualifyBody = - let boundNames = toList groupings >>= bindingNames - in go (foldr (Map.adjust (+ 1)) topNames boundNames) + (topNamesAfterBinds, groupings') = + mapAccumL qualifyGrouping topNames groupings + qualifyGrouping ∷ Map Name Index → Binding → (Map Name Index, Binding) + qualifyGrouping names grouping = + case grouping of + Standalone (a, name, expr) → + ( Map.adjust (+ 1) name names + , Standalone (a, name, go names expr) + ) + RecursiveGroup recBinds → + ( names' + , RecursiveGroup $ + recBinds <&> \(a, name, expr) → (a, name, go names' expr) + ) + where + names' = + foldr (Map.adjust (+ 1)) names (bindingNames grouping) App ann argument function → App ann (go' argument) (go' function) LiteralArray ann as → diff --git a/lib/Language/PureScript/Backend/IR/Optimizer.hs b/lib/Language/PureScript/Backend/IR/Optimizer.hs index bf56d22..905ad74 100644 --- a/lib/Language/PureScript/Backend/IR/Optimizer.hs +++ b/lib/Language/PureScript/Backend/IR/Optimizer.hs @@ -41,6 +41,8 @@ optimizedUberModule = -- unblock even more optimizations, e.g. inline foreign bindings. >>> mergeForeignsIntoBindings >>> idempotently (eliminateDeadCode . optimizeModule) + -- Must run last: + -- see Note [Locals are uniquely named after renameShadowedNames] >>> renameShadowedNames mergeForeignsIntoBindings ∷ UberModule → UberModule @@ -51,6 +53,30 @@ mergeForeignsIntoBindings uberModule@UberModule {..} = map Standalone uberModuleForeigns <> uberModuleBindings } +{- Note [Locals are uniquely named after renameShadowedNames] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +'renameShadowedNames' gives every shadowing local binder a fresh name +and rewrites all references to it with index 0, so afterwards a local +reference resolves to its binder by name alone. The Lua code generator +relies on this: Lua has no notion of "the second enclosing local named +x", so the Ref case of 'fromIR' emits a plain variable name and throws +'UnexpectedRefBound' if it ever meets a local reference with a non-zero +index. Such a reference is unbound: rendering it by name would silently +capture a different binder, and inventing a name produces an undefined +Lua variable (issue #37). + +Two consequences: + + * this pass must run LAST in 'optimizedUberModule' — passes like + inlining and DCE may introduce or remove shadowing and rely on + indices being meaningful, so running anything after the renaming + would invalidate it; + + * (name, index) references must be resolved according to + Note [Sequential scoping of Let bindings], which this pass and the + rest of the pipeline implement. +-} + renameShadowedNames ∷ UberModule → UberModule renameShadowedNames uberModule = uberModule @@ -60,6 +86,7 @@ renameShadowedNames uberModule = type RenamesInScope = Map Name [Name] +-- | See Note [Sequential scoping of Let bindings] renameShadowedNamesInExpr ∷ RenamesInScope → Exp → Exp renameShadowedNamesInExpr scope = go where @@ -284,7 +311,8 @@ etaReduce = _ → NoChange betaReduceUnusedParams ∷ RewriteRule Ann -betaReduceUnusedParams = pure . \case +betaReduceUnusedParams = + pure . \case App _ (Abs _ (ParamUnused _) body) _arg → Rewritten Recurse body _ → NoChange diff --git a/lib/Language/PureScript/Backend/IR/Types.hs b/lib/Language/PureScript/Backend/IR/Types.hs index e64e829..c1c2b8c 100644 --- a/lib/Language/PureScript/Backend/IR/Types.hs +++ b/lib/Language/PureScript/Backend/IR/Types.hs @@ -98,6 +98,64 @@ data RawExp ann | Exception ann Text | ForeignImport ann ModuleName FilePath [(ann, Name)] +{- Note [Sequential scoping of Let bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A local variable is referenced by name plus a De Bruijn-style index +('Ref _ (Local name) index'): the index selects among the binders of +that same name that are in scope, counting from the innermost binder +outwards, starting at 0. The index is per-name, so introducing a binder +for one name does not disturb references to other names. + +Which binders of a 'Let' are in scope where? The convention is +sequential, like Scheme's let*: + + * the RHS of a Standalone binding sees the *earlier* siblings of the + same Let; the binding's own name is NOT in scope there, so a + reference to it from its own RHS points at an outer binder + (Standalone bindings are non-recursive); + + * the RHS of a RecursiveGroup member sees the earlier groupings of + the same Let and every member of its own group, itself included; + + * the body sees all the bindings. + +For example (indices in brackets): + + let a = ... -- sees only the enclosing scope + b = f a[0] -- a[0] is the sibling directly above + a = g a[0] b[0] -- a[0] is the FIRST binding, not itself + in h a[0] a[1] b[0] -- a[0] is the second binding, a[1] the first + +Every traversal that walks under Let binders must implement this +convention, and they must all agree: + + * 'countFreeRefs', 'substitute' and 'shift' thread the scope through + the groupings left to right; + + * 'qualifyTopRefs' decides whether a local reference escapes to a + top-level binding by threading per-name depths the same way; + + * 'renameShadowedNamesInExpr' resolves (name, index) pairs to fresh + unique names the same way (see also + Note [Locals are uniquely named after renameShadowedNames]); + + * dead code elimination resolves references against the same + sequential scope ('adjacencyListForGrouping'); + + * the Lua code generator emits Standalone bindings of a Let as a + sequence of 'local' statements, which is exactly let* scoping on + the Lua side (the Let case of 'fromIR'). + +Getting one of the walkers wrong miscompiles. Issue #37 was caused by +shift/substitute/countFreeRefs implementing the opposite convention +(own name bound in its own RHS, siblings ignored): inlining shifted a +sibling-bound reference past its binder, DCE deleted the "unused" +binder, and codegen rendered the dangling 'Ref (Local Bind1) 1' as an +undefined Lua variable 'Bind11'. The golden test +test/ps/golden/Golden/Issue37/Test.purs and the "Let sequential (let*) +scoping" tests pin the convention. +-} + deriving stock instance Show ann ⇒ Show (RawExp ann) deriving stock instance Eq ann ⇒ Eq (RawExp ann) deriving stock instance Ord ann ⇒ Ord (RawExp ann) @@ -507,10 +565,7 @@ countFreeRefs = fmap getSum . MMap.toMap . countFreeRefs' mempty where minIndexes' = Map.insertWith (+) (Local name) 1 minIndexes ParamUnused _paramAnn → countFreeRefs' minIndexes body - -- Let bindings have sequential (let*) scoping: in a standalone - -- binding's RHS the earlier siblings of the same Let are in scope, - -- while the binding's own name refers to an outer binder. Members - -- of a recursive group additionally see the whole group. + -- See Note [Sequential scoping of Let bindings] Let _ann binds body → fold (countsInBody : countsInBinds) where countsInBody = countFreeRefs' minIndexesAfterBinds body @@ -617,10 +672,7 @@ substitute name idx replacement = substitute' idx where index' = if name == Local pName then index + 1 else index replacement' = shift 1 pName 0 replacement - -- Sequential (let*) scoping: a standalone binding's RHS sees the - -- earlier siblings of the same Let (its own name refers to an - -- outer binder), recursive group members see the whole group, - -- and the body sees all the bindings. + -- See Note [Sequential scoping of Let bindings] Let ann binds body → Let ann binds' body' where ((bodyIndex, bodyReplacement), binds') = @@ -709,10 +761,7 @@ shift offset namespace minIndex expression = minIndex' | paramName argument == Just namespace = minIndex + 1 | otherwise = minIndex - -- Sequential (let*) scoping: a standalone binding's RHS sees the - -- earlier siblings of the same Let (its own name refers to an - -- outer binder), recursive group members see the whole group, - -- and the body sees all the bindings. + -- See Note [Sequential scoping of Let bindings] Let ann binds body → Let ann binds' body' where diff --git a/lib/Language/PureScript/Backend/Lua.hs b/lib/Language/PureScript/Backend/Lua.hs index dcbe233..eaf7d24 100644 --- a/lib/Language/PureScript/Backend/Lua.hs +++ b/lib/Language/PureScript/Backend/Lua.hs @@ -208,10 +208,7 @@ fromIR foreigns topLevelNames modname ir = case ir of pure . Right $ Lua.varField (Lua.varName Fixture.moduleName) topLevelName IR.Local name - -- After the optimizer's renameShadowedNames pass every local - -- reference must resolve to its binder by name alone: a - -- non-zero index means the reference is unbound and would be - -- rendered as an undefined Lua variable (issue #37). + -- See Note [Locals are uniquely named after renameShadowedNames] | index == 0 → pure . Right $ Lua.varName (fromName name) | otherwise → Oops.throw $ UnexpectedRefBound modname ir IR.Imported modname' name → @@ -219,6 +216,8 @@ fromIR foreigns topLevelNames modname ir = case ir of Lua.varField (Lua.varName Fixture.moduleName) (qualifyName modname' (fromName name)) + -- Standalone bindings become a sequence of 'local' statements, which + -- matches Note [Sequential scoping of Let bindings] IR.Let _ann bindings bodyExp → do body ← go bodyExp recs ← diff --git a/pslua.cabal b/pslua.cabal index 70f957e..d8dad70 100644 --- a/pslua.cabal +++ b/pslua.cabal @@ -162,6 +162,7 @@ test-suite spec Language.PureScript.Backend.IR.DCE.Spec Language.PureScript.Backend.IR.Gen Language.PureScript.Backend.IR.Inliner.Spec + Language.PureScript.Backend.IR.Linker.Spec Language.PureScript.Backend.IR.Optimizer.Spec Language.PureScript.Backend.IR.Spec Language.PureScript.Backend.IR.Types.Spec diff --git a/test/Language/PureScript/Backend/IR/Linker/Spec.hs b/test/Language/PureScript/Backend/IR/Linker/Spec.hs new file mode 100644 index 0000000..fffd513 --- /dev/null +++ b/test/Language/PureScript/Backend/IR/Linker/Spec.hs @@ -0,0 +1,60 @@ +module Language.PureScript.Backend.IR.Linker.Spec where + +import Data.Map qualified as Map +import Hedgehog ((===)) +import Language.PureScript.Backend.IR.Linker (qualifyTopRefs) +import Language.PureScript.Backend.IR.Names + ( ModuleName (..) + , Name (..) + ) +import Language.PureScript.Backend.IR.Types + ( Grouping (..) + , lets + , literalInt + , noAnn + , refImported + , refLocal + ) +import Test.Hspec (Spec, describe) +import Test.Hspec.Hedgehog.Extended (test) + +spec ∷ Spec +spec = describe "IR Linker" do + -- See Note [Sequential scoping of Let bindings] + describe "qualifyTopRefs" do + let modname = ModuleName "Main" + x = Name "x" + y = Name "y" + topX = Map.fromList [(x, 0)] + qualify = qualifyTopRefs modname topX + + test "ref bound by an earlier sibling is not qualified" do + let e = + lets + ( Standalone (noAnn, x, literalInt 1) + :| [Standalone (noAnn, y, refLocal x 0)] + ) + (literalInt 0) + qualify e === e + + test "ref to a top-level name in own RHS is qualified" do + let original = + lets (Standalone (noAnn, x, refLocal x 0) :| []) (literalInt 0) + expected = + lets + (Standalone (noAnn, x, refImported modname x 0) :| []) + (literalInt 0) + qualify original === expected + + test "ref in the body pointing past the binder is qualified" do + let original = + lets (Standalone (noAnn, x, literalInt 1) :| []) (refLocal x 1) + expected = + lets + (Standalone (noAnn, x, literalInt 1) :| []) + (refImported modname x 1) + qualify original === expected + + test "ref in the body bound by the let is not qualified" do + let e = lets (Standalone (noAnn, x, literalInt 1) :| []) (refLocal x 0) + qualify e === e diff --git a/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs b/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs index 4c01c4b..3f6a47a 100644 --- a/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs +++ b/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs @@ -126,6 +126,7 @@ spec = describe "IR Optimizer" do -- Mimics issue #37: an inlined binding contains a let with a -- reference bound by an earlier sibling; inlining it under a binder -- with the same name must not leave the reference unbound. + -- See Note [Sequential scoping of Let bindings] test "inlining bindings does not unbind let-bound references" do let mainModule = moduleNameFromString "Main" dict = moduleNameFromString "Dict" diff --git a/test/Language/PureScript/Backend/IR/Types/Spec.hs b/test/Language/PureScript/Backend/IR/Types/Spec.hs index bfa44ad..01d0f70 100644 --- a/test/Language/PureScript/Backend/IR/Types/Spec.hs +++ b/test/Language/PureScript/Backend/IR/Types/Spec.hs @@ -42,9 +42,7 @@ spec = describe "Types" do , (Imported (ModuleName "Partial.Unsafe") (Name "unsafePartial"), 1) ] - -- Convention: Let bindings have sequential (let*) scoping — in a - -- standalone binding's RHS the earlier siblings of the same Let are - -- in scope, while the binding's own name refers to an outer binder. + -- See Note [Sequential scoping of Let bindings] describe "Let sequential (let*) scoping" do let x = Name "x" y = Name "y" diff --git a/test/Main.hs b/test/Main.hs index 75c4202..6d27b1d 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -2,6 +2,7 @@ module Main where import Language.PureScript.Backend.IR.DCE.Spec qualified as IrDce import Language.PureScript.Backend.IR.Inliner.Spec qualified as Inliner +import Language.PureScript.Backend.IR.Linker.Spec qualified as IRLinker import Language.PureScript.Backend.IR.Optimizer.Spec qualified as IROptimizer import Language.PureScript.Backend.IR.Spec qualified as IR import Language.PureScript.Backend.IR.Types.Spec qualified as Types @@ -20,6 +21,7 @@ main = hspec do IrDce.spec LuaDce.spec Types.spec + IRLinker.spec IROptimizer.spec LuaOptimizer.spec Printer.spec