From: Bruce Krulwich
Subject: Destructuring (was Re: Help with Macros [longish])
Date:
Message-ID: <1920@anaxagoras.ils.nwu.edu>
moore%cdr (Tim Moore) writes:
>·····@cs.man.ac.uk (Stephen J Bevan) writes:
>>I've recently been reading a book on Scheme (The Scheme Programming
>>Language - R. Kent Dybvig) and in it, it uses a function
>>`record-case'. This is similar to `case' except that it does
>>destructuring.
>>
>If you want the more general destructuring provided by macros and your
>Lisp has destructuring-bind, you could use:
...
>If your lisp doesn't have destructuring-bind or you don't want to use
>the macro lambda list syntax, I can send you some code I wrote for
The following was translated from the T sources ((c) 1985 Yale Univ) into
CommonLISP. It provides macros DESTRUCTURE and DESTRUCTURE* which are
destructuring versions of LET and LET*, respectively. The syntax is the
same as LET/LET*, with the variable symbols in the LET clause possibly being
lists which are destructured. Here's an example of its use:
> (destructure ((a '(1 2 3))
((x y z) '(1 (2 3) 4)))
`((a ,a) (x ,x) (y ,y) (z ,z)))
((A (1 2 3)) (X 1) (Y (2 3)) (Z 4))
> (destructure* ((a '(1 2 3))
((a b c) a))
`((a ,a) (b ,b) (c ,c)))
((A 1) (B 2) (C 3))
>
I hope it helps.
Bruce Krulwich
········@ils.nwu.edu
--------------------------
(defmacro destructure (specs &rest body)
(expand-destructure specs body))
(defun expand-destructure (specs body)
(let ((a '()) (b '()))
(mapc #'(lambda (spec)
(let ((foo #'(lambda (vars z val)
(cond ((null vars))
((atom vars) (push `(,VARS (,Z ,VAL))
a))
(else (let ((temp (gensym (string z))))
(push `(,TEMP (,Z ,VAL)) a)
(push `(,VARS ,TEMP) b)))))))
(let ((vars (car spec)) (val (cadr spec)))
(cond ((atom vars) (push spec a))
((consp val)
(let ((temp (gensym "TEMP")))
(push `(,TEMP ,VAL) a)
(push `(,VARS ,TEMP) b)))
(else (funcall foo
(car vars) 'CAR val)
(funcall foo (cdr vars) 'CDR val))))))
specs)
`(let ,(nreverse a)
,(cond ((null b) (cons 'progn body))
(else (expand-destructure (nreverse b) body))))))
(defun expand-star-macro (specs rest mac)
(cond ((null (cdr specs))
`(,MAC ,SPECS ,@rest))
(else `(,MAC
(,(car specs))
,(expand-star-macro (cdr specs) rest mac)))))
(defmacro destructure* (specs &rest body)
(expand-star-macro specs body 'destructure))