]> gitweb.factorcode.org Git - factor.git/commitdiff
update functors for [let change
authorJoe Groff <arcata@gmail.com>
Wed, 28 Oct 2009 04:50:48 +0000 (23:50 -0500)
committerJoe Groff <arcata@gmail.com>
Wed, 28 Oct 2009 05:30:09 +0000 (00:30 -0500)
basis/functors/functors.factor

index dacd87507bd66b760c25b254d5105746e31f1fcb..676e0af7861097a8f03e23b1126b914a2d2bd62d 100644 (file)
@@ -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)) <let*> 1quotation
+    "WHERE" parse-bindings
+    [ [ swap <def> suffix ] { } assoc>map concat ]
+    [ [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) ] bi*
+    [ ] append-as
     pop-functor-words ;
 
 : (FUNCTOR:) ( -- word def effect )