From: Daniel Gackle <danielgackle@gmail.com>
Date: Fri, 10 Jul 2009 22:31:55 +0000 (-0600)
Subject: DESTRUCTURING-BIND can now handle dotted and nested binding lists.
X-Git-Url: https://git.hcoop.net/clinton/parenscript.git/commitdiff_plain/c407915cee65f99209f9e603314bf8a6e9a085f8

DESTRUCTURING-BIND can now handle dotted and nested binding lists.
---

diff --git a/src/lib/ps-macro-lib.lisp b/src/lib/ps-macro-lib.lisp
index 1013939..d70561c 100644
--- a/src/lib/ps-macro-lib.lisp
+++ b/src/lib/ps-macro-lib.lisp
@@ -144,14 +144,25 @@
                      (first args))))
     `((@ ,fn :apply) this ,arglist)))
 
-(defpsmacro destructuring-bind (vars expr &body body)
-  ;; a simple implementation that for now only supports flat lists,
-  ;; but does allow NIL bindings to indicate ignore (a la LOOP)
+(defun destructuring-wrap (arr n bindings body)
+  (cond ((null bindings)
+         body)
+        ((atom bindings)
+         ;; dotted destructuring list
+         `(let ((,bindings (when (> (length ,arr) ,n)
+                             ((@ ,arr :slice) ,n))))
+            ,body))
+        (t (let ((var (car bindings))
+                 (inner-body (destructuring-wrap arr (1+ n) (cdr bindings) body)))
+             (cond ((null var) inner-body)
+                   ((atom var) `(let ((,var (aref ,arr ,n)))
+                                  ,inner-body))
+                   (t `(destructuring-bind ,var (aref ,arr ,n)
+                         ,inner-body)))))))
+
+(defpsmacro destructuring-bind (bindings expr &body body)
   (let* ((arr (if (complex-js-expr? expr) (ps-gensym) expr))
-         (n -1)
-         (bindings
-          (append (unless (equal arr expr) `((,arr ,expr)))
-                  (mapcan (lambda (var)
-                            (incf n)
-                            (when var `((,var (aref ,arr ,n))))) vars))))
-    `(let* ,bindings ,@body)))
+         (bound (destructuring-wrap arr 0 bindings (cons 'progn body))))
+    (if (eq arr expr)
+        bound
+        `(let ((,arr ,expr)) ,bound))))