From 020de67c26c88f07bbc06e174d521a218199a705 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 27 Oct 2009 23:50:48 -0500 Subject: [PATCH] update functors for [let change --- basis/functors/functors.factor | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index dacd87507b..676e0af786 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! 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 combinators effects.parser fry functors.backend generic generic.parser interpolate io.streams.string kernel lexer @@ -144,10 +144,31 @@ DEFER: ;FUNCTOR delimiter : pop-functor-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 ) push-functor-words - "WHERE" parse-bindings* - [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) 1quotation + "WHERE" parse-bindings + [ [ swap suffix ] { } assoc>map concat ] + [ [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) ] bi* + [ ] append-as pop-functor-words ; : (FUNCTOR:) ( -- word def effect )