DESTRUCTURING-BIND now supports &REST.
authorDaniel Gackle <danielgackle@gmail.com>
Tue, 15 Sep 2009 17:54:59 +0000 (11:54 -0600)
committerDaniel Gackle <danielgackle@gmail.com>
Fri, 18 Sep 2009 19:46:17 +0000 (13:46 -0600)
src/lib/ps-macro-lib.lisp

index 2ef7d82..78af135 100644 (file)
     `((@ ,fn apply) this ,arglist)))
 
 (defun destructuring-wrap (arr n bindings body &key setf?)
-  (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 :setf? setf?)))
-             (cond ((null var) inner-body)
-                   ((atom var) (if setf?
-                                   `(progn (setf ,var (aref ,arr ,n))
-                                           ,inner-body)
-                                   `(let ((,var (aref ,arr ,n)))
-                                      ,inner-body)))
-                   (t `(,(if setf? 'dset 'destructuring-bind)
-                         ,var (aref ,arr ,n)
-                         ,inner-body)))))))
+  (flet ((bind-rest (sym)
+           `(let ((,sym (when (> (length ,arr) ,n)
+                          ((@ ,arr slice) ,n))))
+              ,body)))
+    (cond ((null bindings)
+           body)
+          ((atom bindings) ;; dotted destructuring list
+           (bind-rest bindings))
+          ((eq (car bindings) '&rest)
+           (if (and (= (length bindings) 2)
+                    (atom (second bindings)))
+               (bind-rest (second bindings))
+               (error "~a is invalid in destructuring list." bindings)))
+          (t (let ((var (car bindings))
+                   (inner-body (destructuring-wrap arr (1+ n) (cdr bindings) body :setf? setf?)))
+               (cond ((null var) inner-body)
+                     ((atom var) (if setf?
+                                     `(progn (setf ,var (aref ,arr ,n))
+                                             ,inner-body)
+                                     `(let ((,var (aref ,arr ,n)))
+                                        ,inner-body)))
+                     (t `(,(if setf? 'dset 'destructuring-bind)
+                           ,var (aref ,arr ,n)
+                           ,inner-body))))))))
 
 (defpsmacro dset (bindings expr &body body)
   (let ((arr (if (complex-js-expr? expr) (ps-gensym) expr)))