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

update functors for [let change

Joe Groff 2009-10-27 23:50:48 -05:00
parent 42303f4f4b
commit 020de67c26
1 changed files with 24 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
basis/functors/functors.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays classes.mixin classes.parser USING: accessors arrays assocs classes.mixin classes.parser
classes.singleton classes.tuple classes.tuple.parser classes.singleton classes.tuple classes.tuple.parser
combinators effects.parser fry functors.backend generic combinators effects.parser fry functors.backend generic
generic.parser interpolate io.streams.string kernel lexer generic.parser interpolate io.streams.string kernel lexer
@ -144,10 +144,31 @@ DEFER: ;FUNCTOR delimiter
: pop-functor-words ( -- ) : pop-functor-words ( -- )
functor-words unuse-words ; functor-words unuse-words ;
: (parse-bindings) ( end -- )
dup parse-binding dup [
first2 [ make-local ] dip 2array ,
(parse-bindings)
] [ 2drop ] if ;
: with-bindings ( quot -- words assoc )
'[
in-lambda? on
_ H{ } make-assoc
] { } make swap ; inline
: parse-bindings ( end -- words assoc )
[
namespace use-words
(parse-bindings)
namespace unuse-words
] with-bindings ;
: parse-functor-body ( -- form ) : parse-functor-body ( -- form )
push-functor-words push-functor-words
"WHERE" parse-bindings* "WHERE" parse-bindings
[ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) <let*> 1quotation [ [ swap <def> suffix ] { } assoc>map concat ]
[ [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) ] bi*
[ ] append-as
pop-functor-words ; pop-functor-words ;
: (FUNCTOR:) ( -- word def effect ) : (FUNCTOR:) ( -- word def effect )