functors: make sure to unuse functor-words, some cleanup.

db4
John Benediktsson 2015-06-22 15:58:59 -07:00
parent d32b9f9c90
commit fc467b72a5
2 changed files with 14 additions and 17 deletions

View File

@ -1,6 +1,6 @@
USING: accessors arrays assocs generic.standard kernel USING: accessors arrays assocs classes.tuple generic.standard
lexer locals.types namespaces parser quotations vocabs.parser kernel lexer locals.types namespaces parser quotations
words classes.tuple ; vocabs.parser words ;
IN: functors.backend IN: functors.backend
DEFER: functor-words DEFER: functor-words

View File

@ -1,11 +1,11 @@
! 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 assocs 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
combinators effects.parser fry functors.backend generic effects.parser fry functors.backend generic generic.parser
generic.parser interpolate io.streams.string kernel lexer interpolate io.streams.string kernel lexer locals.parser
locals.parser locals.types macros make namespaces parser locals.types macros make namespaces parser quotations sequences
quotations sequences vocabs.parser words words.symbol ; vocabs.parser words words.symbol ;
IN: functors IN: functors
! This is a hack ! This is a hack
@ -146,21 +146,18 @@ DEFER: ;FUNCTOR delimiter
[ first2 [ make-local ] dip 2array ] [ first2 [ make-local ] dip 2array ]
produce 2nip ; produce 2nip ;
: with-bindings ( quot -- words assoc )
in-lambda? on H{ } make ; inline
: parse-bindings ( end -- words assoc ) : parse-bindings ( end -- words assoc )
[ [
building get use-words building get use-words
(parse-bindings) (parse-bindings)
] with-bindings ; ] H{ } make ;
: parse-functor-body ( -- form ) : parse-functor-body ( -- form )
functor-words use-words functor-words [
"WHERE" parse-bindings "WHERE" parse-bindings drop
[ [ swap <def> suffix ] { } assoc>map concat ] [ swap <def> suffix ] { } assoc>map concat
[ [ \ ;FUNCTOR parse-until >quotation ] with-lambda-scope ] bi* \ ;FUNCTOR parse-until [ ] append-as
[ ] append-as ; ] with-lambda-scope ;
: (FUNCTOR:) ( -- word def effect ) : (FUNCTOR:) ( -- word def effect )
scan-new-word [ parse-functor-body ] parse-locals-definition ; scan-new-word [ parse-functor-body ] parse-locals-definition ;