From fd4276b9c4d58b83f98377cee72e328a97a4e92c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 28 Oct 2009 15:40:07 -0500
Subject: [PATCH] :> ( a b c ) syntax to bind multiple variables left-to-right
 off the stack

---
 basis/locals/locals-tests.factor            | 3 +++
 basis/locals/locals.factor                  | 2 +-
 basis/locals/parser/parser.factor           | 6 ++++++
 basis/locals/prettyprint/prettyprint.factor | 5 +++++
 basis/locals/rewrite/sugar/sugar.factor     | 2 ++
 basis/locals/types/types.factor             | 4 ++++
 6 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index c96fe4a870..581ed5de33 100644
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -488,3 +488,6 @@ M: integer ed's-bug neg ;
    { [ a ed's-bug ] } && ;
 
 [ t ] [ \ ed's-test-case optimized? ] unit-test
+
+! multiple bind
+[ 3 1 2 ] [ [let 1 2 3 :> ( a b c ) c a b ] ] unit-test
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index e746776a49..a35e1942f2 100644
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@@ -7,7 +7,7 @@ IN: locals
 
 SYNTAX: :>
     scan locals get [ :>-outside-lambda-error ] unless*
-    [ make-local ] bind <def> parsed ;
+    parse-def parsed ;
 
 SYNTAX: [| parse-lambda over push-all ;
 
diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor
index 774f48b9f4..c0184ee0ef 100644
--- a/basis/locals/parser/parser.factor
+++ b/basis/locals/parser/parser.factor
@@ -46,6 +46,12 @@ SYMBOL: locals
     (parse-lambda) <lambda>
     ?rewrite-closures ;
 
+: parse-multi-def ( locals -- multi-def )
+    ")" parse-tokens swap [ [ make-local ] map ] bind <multi-def> ;
+
+: parse-def ( name/paren locals -- def )
+    over "(" = [ nip parse-multi-def ] [ [ make-local ] bind <def> ] if ;
+
 M: lambda-parser parse-quotation ( -- quotation )
     H{ } clone (parse-lambda) ;
 
diff --git a/basis/locals/prettyprint/prettyprint.factor b/basis/locals/prettyprint/prettyprint.factor
index b785179d09..b0fbebbf31 100644
--- a/basis/locals/prettyprint/prettyprint.factor
+++ b/basis/locals/prettyprint/prettyprint.factor
@@ -36,3 +36,8 @@ M: def pprint*
     dup local>> word?
     [ <block \ :> pprint-word local>> pprint-var block> ]
     [ pprint-tuple ] if ;
+
+M: multi-def pprint*
+    dup locals>> [ word? ] all?
+    [ <block \ :> pprint-word "(" text locals>> [ pprint-var ] each ")" text block> ]
+    [ pprint-tuple ] if ;
diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor
index 2c5f2202af..e22e247336 100755
--- a/basis/locals/rewrite/sugar/sugar.factor
+++ b/basis/locals/rewrite/sugar/sugar.factor
@@ -104,6 +104,8 @@ M: tuple rewrite-sugar* rewrite-element ;
 
 M: def rewrite-sugar* , ;
 
+M: multi-def rewrite-sugar* locals>> <reversed> [ <def> , ] each ;
+
 M: hashtable rewrite-sugar* rewrite-element ;
 
 M: wrapper rewrite-sugar*
diff --git a/basis/locals/types/types.factor b/basis/locals/types/types.factor
index e7aa0f5ca1..424ef68243 100644
--- a/basis/locals/types/types.factor
+++ b/basis/locals/types/types.factor
@@ -22,6 +22,10 @@ TUPLE: def local ;
 
 C: <def> def
 
+TUPLE: multi-def locals ;
+
+C: <multi-def> multi-def
+
 PREDICATE: local < word "local?" word-prop ;
 
 : <local> ( name -- word )