krulwich@ils.nwu.edu (Bruce Krulwich) (09/27/90)
moore%cdr (Tim Moore) writes: >bevan@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 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))