472 |
(setq access-forms (cons access-form access-forms))))) |
(setq access-forms (cons access-form access-forms))))) |
473 |
|
|
474 |
|
|
475 |
|
(defun make-update-form (function access-form others lets) |
476 |
|
(if others |
477 |
|
(make-update-form function access-form (cdr others) |
478 |
|
(cons (list 'list (list 'quote (gensym)) (car others)) lets)) |
479 |
|
`(list 'let* (list ,@lets) |
480 |
|
(list ',function access-form ,@(mapcar (lambda (x) (list 'quote (cadadr x))) lets))))) |
481 |
|
|
482 |
;;; DEFINE-MODIFY-MACRO macro. |
;;; DEFINE-MODIFY-MACRO macro. |
483 |
|
;;FIXME -- this is really upgly and error prone. CM 20041214 |
484 |
(defmacro define-modify-macro (name lambda-list function &optional doc-string) |
(defmacro define-modify-macro (name lambda-list function &optional doc-string) |
485 |
(let ((update-form |
(let ((update-form |
486 |
(do ((l lambda-list (cdr l)) |
(do ((l lambda-list (cdr l)) |
487 |
(vs nil)) |
(vs nil)) |
488 |
((null l) `(list ',function access-form ,@(nreverse vs))) |
((null l) (make-update-form function 'access-form (nreverse vs) nil)) |
489 |
(unless (eq (car l) '&optional) |
(unless (eq (car l) '&optional) |
490 |
(if (eq (car l) '&rest) |
(if (eq (car l) '&rest) |
491 |
(return `(list* ',function |
(return `(list* ',function |