steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix bug in locals found by littledan: [let inside [let didn't work in top-level forms

db4
Slava Pestov 2009-01-25 23:04:11 -06:00
parent d4122b5715
commit 4d080b8785
2 changed files with 21 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/locals/locals-tests.factor
View File

@ -490,4 +490,8 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
[ 10 ] [ [ 10 ] [
[| | 0 '[ [let | A [ 10 ] | A _ + ] ] call ] call [| | 0 '[ [let | A [ 10 ] | A _ + ] ] call ] call
] unit-test ] 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

32
basis/locals/parser/parser.factor
View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators effects.parser 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 locals.rewrite.closures locals.types make namespaces parser
quotations sequences splitting words vocabs.parser ; quotations sequences splitting words vocabs.parser ;
IN: locals.parser IN: locals.parser
@ -56,19 +56,21 @@ SYMBOL: in-lambda?
(parse-bindings) (parse-bindings)
] [ 2drop ] if ; ] [ 2drop ] if ;
: with-bindings ( quot -- words assoc )
'[
in-lambda? on
_ H{ } make-assoc
] { } make swap ; inline
: parse-bindings ( end -- bindings vars ) : parse-bindings ( end -- bindings vars )
[ [ (parse-bindings) ] with-bindings ;
[ (parse-bindings) ] H{ } make-assoc
] { } make swap ;
: parse-bindings* ( end -- words assoc ) : parse-bindings* ( end -- words assoc )
[ [
[ namespace push-locals
namespace push-locals (parse-bindings)
(parse-bindings) namespace pop-locals
namespace pop-locals ] with-bindings ;
] { } make-assoc
] { } make swap ;
: (parse-wbindings) ( end -- ) : (parse-wbindings) ( end -- )
dup parse-binding dup [ dup parse-binding dup [
@ -77,9 +79,7 @@ SYMBOL: in-lambda?
] [ 2drop ] if ; ] [ 2drop ] if ;
: parse-wbindings ( end -- bindings vars ) : parse-wbindings ( end -- bindings vars )
[ [ (parse-wbindings) ] with-bindings ;
[ (parse-wbindings) ] H{ } make-assoc
] { } make swap ;
: parse-locals ( -- vars assoc ) : parse-locals ( -- vars assoc )
"(" expect ")" parse-effect "(" expect ")" parse-effect
@ -88,8 +88,8 @@ SYMBOL: in-lambda?
: parse-locals-definition ( word -- word quot ) : parse-locals-definition ( word -- word quot )
parse-locals \ ; (parse-lambda) <lambda> parse-locals \ ; (parse-lambda) <lambda>
2dup "lambda" set-word-prop [ "lambda" set-word-prop ]
rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ; [ rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ] 2bi ;
: (::) ( -- word def ) CREATE-WORD parse-locals-definition ; : (::) ( -- word def ) CREATE-WORD parse-locals-definition ;