From 96f55721757b51f3767573ded5ce46560acd6fa2 Mon Sep 17 00:00:00 2001
From: Daniel Gackle <danielgackle@gmail.com>
Date: Mon, 21 Sep 2009 23:29:31 -0600
Subject: [PATCH] Fixed bug: dotted lists weren't being destructured properly.

---
 src/lib/ps-loop.lisp      |  8 ++++----
 src/lib/ps-macro-lib.lisp | 18 +++++++++---------
 2 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/src/lib/ps-loop.lisp b/src/lib/ps-loop.lisp
index fbd6b39..3e9e39c 100644
--- a/src/lib/ps-loop.lisp
+++ b/src/lib/ps-loop.lisp
@@ -256,11 +256,11 @@
                     (append (body loop)
                             (loop :for (var bindings nil step test) :in (iterations loop)
                               :collect `(setf ,var ,step)
-                              :collect `(dset ,bindings ,var)
+                              :when bindings :collect `(dset ,bindings ,var)
                               :when test :collect `(when ,test (break))))))))
-    ;; preface the whole thing with alternating inits and tests prior
-    ;; to first executing the loop; this way, like CL LOOP, we refrain
-    ;; from initializing subsequent clauses if a test fails
+    ;; Preface the whole thing with alternating inits and tests prior
+    ;; to first executing the loop; this way, as in CL LOOP, we refrain
+    ;; from initializing subsequent clauses if a test fails.
     (loop :for (var bindings init nil test) :in (reverse (iterations loop)) :do
       (when test
         (setf form `(unless ,test ,form)))
diff --git a/src/lib/ps-macro-lib.lisp b/src/lib/ps-macro-lib.lisp
index 56b88dc..06ee713 100644
--- a/src/lib/ps-macro-lib.lisp
+++ b/src/lib/ps-macro-lib.lisp
@@ -147,10 +147,14 @@
     `((@ ,fn apply) this ,arglist)))
 
 (defun destructuring-wrap (arr n bindings body &key setf?)
-  (flet ((bind-rest (sym)
-           `(let ((,sym (when (> (length ,arr) ,n)
-                          ((@ ,arr slice) ,n))))
-              ,body)))
+  (labels ((bind-expr (var expr inner-body)
+             (if setf?
+                 `(progn (setf ,var ,expr) ,inner-body)
+                 `(let ((,var ,expr)) ,inner-body)))
+           (bind-rest (sym)
+             (bind-expr sym `(when (> (length ,arr) ,n)
+                               ((@ ,arr slice) ,n))
+                        body)))
     (cond ((null bindings)
            body)
           ((atom bindings) ;; dotted destructuring list
@@ -165,11 +169,7 @@
           (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)))
+                     ((atom var) (bind-expr var `(aref ,arr ,n) inner-body))
                      (t `(,(if setf? 'dset 'destructuring-bind)
                            ,var (aref ,arr ,n)
                            ,inner-body))))))))
-- 
2.20.1