From 4d080b87851d9e1737833d12d5be9f4518a19b04 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 25 Jan 2009 23:04:11 -0600
Subject: [PATCH] Fix bug in locals found by littledan: [let inside [let didn't
 work in top-level forms

---
 basis/locals/locals-tests.factor  |  6 +++++-
 basis/locals/parser/parser.factor | 32 +++++++++++++++----------------
 2 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index e7f0b74194..982674694a 100644
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -490,4 +490,8 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 [ 10 ] [
     [| | 0 '[ [let | A [ 10 ] | A _ + ] ] call ] call
-] unit-test
\ No newline at end of file
+] unit-test
+
+! Discovered by littledan
+[ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test
+[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
\ No newline at end of file
diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor
index c5b34556bc..f6baaf9ba7 100644
--- a/basis/locals/parser/parser.factor
+++ b/basis/locals/parser/parser.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators effects.parser
-generic.parser kernel lexer locals.errors
+generic.parser kernel lexer locals.errors fry
 locals.rewrite.closures locals.types make namespaces parser
 quotations sequences splitting words vocabs.parser ;
 IN: locals.parser
@@ -56,19 +56,21 @@ SYMBOL: in-lambda?
         (parse-bindings)
     ] [ 2drop ] if ;
 
+: with-bindings ( quot -- words assoc )
+    '[
+        in-lambda? on
+        _ H{ } make-assoc
+    ] { } make swap ; inline
+
 : parse-bindings ( end -- bindings vars )
-    [
-        [ (parse-bindings) ] H{ } make-assoc
-    ] { } make swap ;
+    [ (parse-bindings) ] with-bindings ;
 
 : parse-bindings* ( end -- words assoc )
     [
-        [
-            namespace push-locals
-            (parse-bindings)
-            namespace pop-locals
-        ] { } make-assoc
-    ] { } make swap ;
+        namespace push-locals
+        (parse-bindings)
+        namespace pop-locals
+    ] with-bindings ;
 
 : (parse-wbindings) ( end -- )
     dup parse-binding dup [
@@ -77,9 +79,7 @@ SYMBOL: in-lambda?
     ] [ 2drop ] if ;
 
 : parse-wbindings ( end -- bindings vars )
-    [
-        [ (parse-wbindings) ] H{ } make-assoc
-    ] { } make swap ;
+    [ (parse-wbindings) ] with-bindings ;
 
 : parse-locals ( -- vars assoc )
     "(" expect ")" parse-effect
@@ -88,8 +88,8 @@ SYMBOL: in-lambda?
 
 : parse-locals-definition ( word -- word quot )
     parse-locals \ ; (parse-lambda) <lambda>
-    2dup "lambda" set-word-prop
-    rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ;
+    [ "lambda" set-word-prop ]
+    [ rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ] 2bi ;
 
 : (::) ( -- word def ) CREATE-WORD parse-locals-definition ;