Destructuring of a vector

Viewed 256

I am using a function from an external library returning a vector of four numbers and I want to access these values directly like it would be possible with destructuring-bind. See this pointless example:

(defun a-vector ()
  (vector 1 2 3 4))

(defun a-list ()
  (list 1 2 3 4))

(destructuring-bind (a b c d)
    (a-list)
  (format t "~D ~D ~D ~D~%" a b c d))

(destructuring-bind (a b c d)
    (coerce (a-vector) 'list)
  (format t "~D ~D ~D ~D~%" a b c d))

If I coerce the vector into a list it is possible and as performance isn't a problem here, it is maybe fine. But I was wondering if there is a more simple way?

3 Answers

You can bind variables to each cell as follows:

(defmacro with-aref ((&rest indices) array &body body)
  (let ((a (gensym)))
    `(let ((,a ,array))
       (symbol-macrolet
           ,(loop
               for n from 0
               for i in indices 
               collect (list i `(aref ,a ,n)))
         ,@body))))

You would use it as follows:

(with-aref (w x y z) vec
  (setf w (+ x y z)))

With a bit more work, you can also support indices and different categories of accessors. Let's say each binding is a triple (i n k) where i is an identifier, n a number (or nil) that represents the numerical index and k is either :place, :value or nil; :place binds the symbol with symbol-macrolet, :value just binds it with let.

First, let's help the user by providing shortcut notations:

  • x stands for (x nil nil)
  • (x o) either stands for (x o nil) or (x nil o), depending on whether option o is a number or a symbol (at macroexpansion time).

Besides, we may want to automatically ignore the nil identifier, the empty symbol || or symbols starting with an underscore (e.g. _, _var).

Here is the normalization function:

(defun normalize-index (index)
  (flet ((ret (i n k)
           (let ((ignored (or (null i)
                              (string= i "")
                              (char= #\_ (char (string i) 0)))))
             (list (if ignored (gensym) i) n k ignored))))
    (let ((index (alexandria:ensure-list index)))
      (typecase index
        (null (ret nil nil nil))
        (cons (destructuring-bind (i &optional n (k nil kp)) index
                (if kp
                    (ret i n k)
                    (etypecase n
                      (symbol (ret i nil n))
                      ((integer 0) (ret i n nil))))))))))

We can apply this normalization to a list of indices, and keep track of ignored symbols:

(defun normalize (indices)
  (loop
     for i in indices
     for norm = (normalize-index i)
     for (index number kind ignore) = norm
     collect norm into normalized
     when ignore
     collect index into ignored
       finally (return (values normalized ignored))))

Then, we take care of nil numbers in normalized entries. We want the indices to increase from the last used index, or be given explicitly by the user:

(defun renumber (indices)
  (loop
     for (v n k) in indices
     for next = nil then (1+ index)
     for index = (or n next 0)
       collect (list v index k)))

For example:

(renumber (normalize '(a b c)))
((A 0 NIL) (B 1 NIL) (C 2 NIL))

(renumber (normalize '((a 10) b c)))
((A 10 NIL) (B 11 NIL) (C 12 NIL))

(renumber (normalize '((a 10) (b 3) c)))
((A 10 NIL) (B 3 NIL) (C 4 NIL))

We do the same for the kind of variable we bind:

(defun rekind (indices)
  (loop
     for (v n k) in indices
     for next = nil then kind
     for kind = (or k next :place)
     collect (list v n kind)))

For example:

(rekind (normalize '(a b c)))
((A NIL :PLACE) (B NIL :PLACE) (C NIL :PLACE))

(rekind (normalize '(a (b :value) c)))
((A NIL :PLACE) (B NIL :VALUE) (C NIL :VALUE))

Finally, all those steps are combined in parse-indices:

(defun parse-indices (indices)
  (multiple-value-bind (normalized ignored) (normalize indices)
    (values (rekind (renumber normalized))
            ignored)))

Finally, the macro is as follows:

(defmacro with-aref ((&rest indices) array &body body)
  (multiple-value-bind (normalized ignored) (parse-indices indices)
    (labels ((ignored (b) (remove-if-not #'ignoredp (mapcar #'car b)))
             (ignoredp (s) (member s ignored)))
      (loop
         with a = (gensym)
         for (i n k) in normalized
         for binding = `(,i (aref ,a ,n))
         when (eq k :value) collect binding into values
         when (eq k :place) collect binding into places
         finally (return
                   `(let ((,a ,array))
                     (let ,values
                       (declare (ignore ,@(ignored values)))
                       (symbol-macrolet ,places
                         (declare (ignore ,@(ignored places)))
                         ,@body))))))))

For example:

(let ((vec (vector 0 1 2 3 4 5 6 7 8 9 10)))
  (prog1 vec
    (with-aref ((a 2) (b :value) c _ _ d (e 0) (f 1)) vec
      (setf a (list a b c d e f)))))

The above is macroexpanded as:

(LET ((VEC (VECTOR 0 1 2 3 4 5 6 7 8 9 10)))
  (LET ((#:G1898 VEC))
    (LET ((#:G1901 VEC))
      (LET ((B (AREF #:G1901 3))
            (C (AREF #:G1901 4))
            (#:G1899 (AREF #:G1901 5))
            (#:G1900 (AREF #:G1901 6))
            (D (AREF #:G1901 7))
            (E (AREF #:G1901 0))
            (F (AREF #:G1901 1)))
        (DECLARE (IGNORE #:G1899 #:G1900))
        (SYMBOL-MACROLET ((A (AREF #:G1901 2)))
          (DECLARE (IGNORE))
          (LET* ((#:G19011902 #:G1901)
                 (#:NEW1 (LIST (AREF #:G1901 2) B C D E F)))
            (FUNCALL #'(SETF AREF) #:NEW1 #:G19011902 2)))))
    #:G1898))

It produces the following result

#(0 1 (2 3 4 7 0 1) 3 4 5 6 7 8 9 10)

coredump's answer is lovely. This is a variant of it which binds variables rather than accessors, and also lets you optionally specify indices. So

(with-vector-elements ((a 3) b) x
  ...)

will bind a to the result of (aref x 3) and b to the result of (aref x 4), for instance.

This is really only useful over coredump's answer if you're intending to (a) not write back to the vector and (b) use the bindings a lot, so you want to avoid a lot of possible arefs (which I don't think compilers can generally optimize away without some fairly strong assumptions).

(defmacro with-vector-elements ((&rest indices) vector &body forms)
  (let ((canonical-indices
         (loop with i = 0
               for index in indices
               collect (etypecase index
                         (symbol
                          (prog1 
                              `(,index ,i)
                            (incf i)))
                         (cons
                          (destructuring-bind (var idx) index
                            (assert (and (symbolp var) 
                                         (typep idx '(and fixnum (integer 0))))
                                (var idx) "Invalid index spec")
                            (prog1
                                index
                              (setf i (1+ idx))))))))
        (vname (gensym "V")))
    `(let ((,vname ,vector))
       (let ,(loop for (var index) in canonical-indices
                   collect `(,var (aref ,vname ,index)))
         ,@forms))))

There is also a package called metabang-bind - with nickname bind - in which the function bind can handle much more destructuring situations:

(ql:quickload :metabang-bind)
(in-package :metabang-bind)

(bind ((#(a b c) #(1 2 3)))
  (list a b c))
;; => (1 2 3)

If not using in-package, you can call the function as bind:bind. The function bind you can think of roughly as a destructuring-let* (similar idea to clojure's let, however not so clean in syntax but understandable because it has also to handle structs and classes and also values). All the other use cases it can handle are described here.

Related