Problem with destructuring-bind in a macro

[eeeickythump]

I am trying to write a macro, DSETF, which provides 'destructuring setf' along the lines of destructuring-bind. For example

Code: Select all

(dsetf (a . b) '(1 . 2))

would set the existing variables a to 1 and b to 2.

The macro I have written expands to the destructuring-bind form shown below, ie this...

Code: Select all

(let ((a 1) (b 2))
  (dsetf (a b) '(4 5)))

... expands to:

Code: Select all

(let ((a 1) (b 2))
  (destructuring-bind
        (#:a1 #:b2)
      '(4 5)
    (setf b #:b2 a #:a1)))

It works, but generates warnings on compilation (in latest SBCL). I would like to get rid of these warnings but I cannot actually understand why they are occurring. They are:

The variable #:B2 is defined but never used.
The variable #:A1 is defined but never used.
undefined variable: #:A1
undefined variable: #:B2

Can anyone assist?

[FAU]

You want it to look like this:

Code: Select all

(let ((a 1) (b 2))
  (destructuring-bind
	(#1=#:a1 #2=#:b2)
      '(4 5)
    (setf b #2# a #1#))
  (values a b))

Remember each time the reader reads #:foo it will create a new uninterned symbol e.g. (not (eq '#:foo '#:foo)) but what you want is (eq '#1=#:foo '#1#).

[nuntius]

You may like browsing through metabang-bind. See also "(setf (values a b) (values 1 2))".

[eeeickythump]

Thanks, I didn't realise you could use #1=... in expressions - I assumed it was just a comprehension aid for circular output.

However the simplest thing is probably to change the gensym to gentemp in my macro.

[Kompottkin]

Code: Select all

(let ((a 1) (b 2))
  (destructuring-bind
        (#:a1 #:b2)
      '(4 5)
    (setf b #:b2 a #:a1)))

Note that this piece of textual representation of code alone doesn't say much: The printed representation of uninterned symbols is ambiguous. In the above code, for instance, the two occurrences of #:a1 may or may not be the same symbol.

It's true that when read in (that is, when copied into a REPL, for example), the above form will not work as intended, since uninterned symbols read by the reader will always be distinct from each other. However, this does not mean that the code your macro produces has the same problem, since code generated by macros is not printed and immediately read back in by the Lisp runtime, but compiled directly, so the identities of objects (including uninterned symbols) in the code are preserved.

[eeeickythump]

I found the bug - the macro was using nsubst to operate on the pattern, changing this to subst made the warnings disappear.

Code for anyone who is interested:

Code: Select all

(defmacro dsetf (&rest args)
  "* Arguments:
- ARGS: a series of arguments of the form:
;;; PATTERN FORM [PATTERN FORM]*
Where:
-- PATTERN: A destructuring lambda list.
-- FORM: A form whose structure, when evaluated, conforms to PATTERN.

* Description:
Like DESTRUCTURING-BIND, but the variables in PATTERN are EXISTING
variables which are assigned values from SOURCE. No new bindings are
created."
  (cond
    ((= 2 (length args))
     (apply #'dsetf-aux args))
    (t
     (let ((pairs nil))
       (dotimes (i (1- (length args)))
         (when (evenp i)
           (push (cons (nth i args) (nth (1+ i) args)) pairs)))
       `(progn
          ,@(reverse (mapcar #'(lambda (pair) (dsetf-aux (car pair) (cdr pair)))
                    pairs)))))))


(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun dsetf-aux (pattern source)
    (let* ((vars (collect-if-in-tree
                  (lambda (item)
                    (and item (symbolp item) (not (keywordp item))
                         (not (ampersand-symbol? item))))
                  pattern))
           (var-alist (mapcar (lambda (var)
                                (cons var (gensym (string var))))
                              vars)))
      (dolist (var vars)
        (setf pattern
              (subst (cdr (assoc var var-alist)) var pattern)))
      `(destructuring-bind ,pattern ,source
         (setf
          ,@(apply #'append
                   (mapcar (lambda (var)
                             `(,var ,(cdr (assoc var var-alist))))
                           vars)))))))


(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun ampersand-symbol? (sym)
    "Does the symbol SYM begin with an ampersand, such as &ANY, &REST and
so on?"
    (and (symbolp sym)
	 (char= #\& (char (string sym) 0)))))


(eval-when (:compile-toplevel :load-toplevel :execute)
    (defun collect-if-in-tree (predicate tree)
    "* Arguments:
- PREDICATE: Function taking one argument and returning T or nil.
- TREE: A tree (nested cons).

* Returns: List of the elements in TREE for which PREDICATE returns non-nil.

* Description:
Predicate is called for lists within tree, but those lists will not be searched
if predicate returns true for the list itself."
    (collect-if-in-tree-aux nil predicate tree)))


(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun collect-if-in-tree-aux (collection predicate tree)
    "Auxiliary function used by COLLECT-IF-IN-TREE."
    (cond
      ((null tree)
       collection)
      ((funcall predicate tree)
       (cons tree collection))
      ((atom tree)
       collection)
      (t
       (setf collection
             (collect-if-in-tree-aux collection predicate (car tree)))
       (collect-if-in-tree-aux collection predicate (cdr tree))))))

[marcoxa]

Shameless plug. Check http://common-lisp.net/project/cl-unification. The MATCH* forms do the destructuring and the binding you need.

Marco