purescript-lua · Unisay · Jun 12, 2026 · Jun 12, 2026 · Jun 12, 2026 · Jun 12, 2026
diff --git 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
@@ -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
@@ -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
@@ -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,28 +565,38 @@ countFreeRefs = fmap getSum . MMap.toMap . countFreeRefs' mempty
          where
           minIndexes' = Map.insertWith (+) (Local name) 1 minIndexes
         ParamUnused _paramAnn → countFreeRefs' minIndexes body
+    -- See Note [Sequential scoping of Let bindings]
     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 +672,36 @@ substitute name idx replacement = substitute' idx
            where
             index' = if name == Local pName then index + 1 else index
             replacement' = shift 1 pName 0 replacement
+      -- See Note [Sequential scoping of Let 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 +761,33 @@ shift offset namespace minIndex expression =
       minIndex'
         | paramName argument == Just namespace = minIndex + 1
         | otherwise = minIndex
+    -- See Note [Sequential scoping of Let 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 →