Locals-in-literals rewriting was broken if a lambda was nested inside of an array

db4
Slava Pestov 2008-11-25 23:03:55 -06:00
parent 826be7530e
commit 418353b99e
2 changed files with 20 additions and 2 deletions

View File

@ -418,6 +418,17 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
[ "USE: locals [let | a" eval ] [ error>> unexpected-eof? ] must-fail-with
[ "USE: locals [|" eval ] [ error>> unexpected-eof? ] must-fail-with
[ 25 ] [ 5 [| a | { [ a sq ] } cond ] call ] unit-test
[ 25 ] [ 5 [| | { [| a | a sq ] } ] call first call ] unit-test
:: FAILdog-1 ( -- b ) { [| c | c ] } ;
\ FAILdog-1 must-infer
:: FAILdog-2 ( a -- b ) a { [| c | c ] } cond ;
\ FAILdog-2 must-infer
! :: wlet-&&-test ( a -- ? )
! [wlet | is-integer? [ a integer? ]
! is-even? [ a even? ]

View File

@ -235,6 +235,8 @@ M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
M: tuple rewrite-element
[ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
M: lambda rewrite-element local-rewrite* ;
M: local rewrite-element , ;
M: local-reader rewrite-element , ;
@ -252,7 +254,7 @@ M: tuple local-rewrite* rewrite-element ;
M: hashtable local-rewrite* rewrite-element ;
M: word local-rewrite*
dup { >r r> } memq?
dup { >r r> load-locals get-local drop-locals } memq?
[ >r/r>-in-lambda-error ] [ call-next-method ] if ;
M: object lambda-rewrite* , ;
@ -350,10 +352,15 @@ M: wlet local-rewrite*
word [ over "declared-effect" set-word-prop ] when*
in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
ERROR: bad-lambda-rewrite output ;
M: bad-lambda-rewrite summary
drop "You have found a bug in locals. Please report." ;
: parse-locals-definition ( word -- word quot )
"(" expect parse-locals \ ; (parse-lambda) <lambda>
2dup "lambda" set-word-prop
lambda-rewrite first ;
lambda-rewrite dup length 1 = [ first ] [ bad-lambda-rewrite ] if ;
: (::) ( -- word def ) CREATE-WORD parse-locals-definition ;