:> ( a b c ) syntax to bind multiple variables left-to-right off the stack
parent
b0362f8011
commit
d284d963fa
|
@ -488,3 +488,6 @@ M: integer ed's-bug neg ;
|
||||||
{ [ a ed's-bug ] } && ;
|
{ [ a ed's-bug ] } && ;
|
||||||
|
|
||||||
[ t ] [ \ ed's-test-case optimized? ] unit-test
|
[ t ] [ \ ed's-test-case optimized? ] unit-test
|
||||||
|
|
||||||
|
! multiple bind
|
||||||
|
[ 3 1 2 ] [ [let 1 2 3 :> ( a b c ) c a b ] ] unit-test
|
||||||
|
|
|
@ -7,7 +7,7 @@ IN: locals
|
||||||
|
|
||||||
SYNTAX: :>
|
SYNTAX: :>
|
||||||
scan locals get [ :>-outside-lambda-error ] unless*
|
scan locals get [ :>-outside-lambda-error ] unless*
|
||||||
[ make-local ] bind <def> parsed ;
|
parse-def parsed ;
|
||||||
|
|
||||||
SYNTAX: [| parse-lambda over push-all ;
|
SYNTAX: [| parse-lambda over push-all ;
|
||||||
|
|
||||||
|
|
|
@ -46,6 +46,12 @@ SYMBOL: locals
|
||||||
(parse-lambda) <lambda>
|
(parse-lambda) <lambda>
|
||||||
?rewrite-closures ;
|
?rewrite-closures ;
|
||||||
|
|
||||||
|
: parse-multi-def ( locals -- multi-def )
|
||||||
|
")" parse-tokens swap [ [ make-local ] map ] bind <multi-def> ;
|
||||||
|
|
||||||
|
: parse-def ( name/paren locals -- def )
|
||||||
|
over "(" = [ nip parse-multi-def ] [ [ make-local ] bind <def> ] if ;
|
||||||
|
|
||||||
M: lambda-parser parse-quotation ( -- quotation )
|
M: lambda-parser parse-quotation ( -- quotation )
|
||||||
H{ } clone (parse-lambda) ;
|
H{ } clone (parse-lambda) ;
|
||||||
|
|
||||||
|
|
|
@ -36,3 +36,8 @@ M: def pprint*
|
||||||
dup local>> word?
|
dup local>> word?
|
||||||
[ <block \ :> pprint-word local>> pprint-var block> ]
|
[ <block \ :> pprint-word local>> pprint-var block> ]
|
||||||
[ pprint-tuple ] if ;
|
[ pprint-tuple ] if ;
|
||||||
|
|
||||||
|
M: multi-def pprint*
|
||||||
|
dup locals>> [ word? ] all?
|
||||||
|
[ <block \ :> pprint-word "(" text locals>> [ pprint-var ] each ")" text block> ]
|
||||||
|
[ pprint-tuple ] if ;
|
||||||
|
|
|
@ -104,6 +104,8 @@ M: tuple rewrite-sugar* rewrite-element ;
|
||||||
|
|
||||||
M: def rewrite-sugar* , ;
|
M: def rewrite-sugar* , ;
|
||||||
|
|
||||||
|
M: multi-def rewrite-sugar* locals>> <reversed> [ <def> , ] each ;
|
||||||
|
|
||||||
M: hashtable rewrite-sugar* rewrite-element ;
|
M: hashtable rewrite-sugar* rewrite-element ;
|
||||||
|
|
||||||
M: wrapper rewrite-sugar*
|
M: wrapper rewrite-sugar*
|
||||||
|
|
|
@ -22,6 +22,10 @@ TUPLE: def local ;
|
||||||
|
|
||||||
C: <def> def
|
C: <def> def
|
||||||
|
|
||||||
|
TUPLE: multi-def locals ;
|
||||||
|
|
||||||
|
C: <multi-def> multi-def
|
||||||
|
|
||||||
PREDICATE: local < word "local?" word-prop ;
|
PREDICATE: local < word "local?" word-prop ;
|
||||||
|
|
||||||
: <local> ( name -- word )
|
: <local> ( name -- word )
|
||||||
|
|
Loading…
Reference in New Issue