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

update functors for [let change

db4
Joe Groff 2009-10-27 23:50:48 -05:00
parent f1d9201cb2
commit 22afae8734
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 )