(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)))
`((@ ,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
(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))))))))