657 |
(defun do-standard-defsetfs-for-defclass (accessors) |
(defun do-standard-defsetfs-for-defclass (accessors) |
658 |
(dolist (name accessors) (do-standard-defsetf-1 name))) |
(dolist (name accessors) (do-standard-defsetf-1 name))) |
659 |
|
|
660 |
|
;; FIXME remove this when all is well |
661 |
(defun do-standard-defsetf-1 (function-name) |
(defun do-standard-defsetf-1 (function-name) |
662 |
#+setf |
#+setf |
663 |
(declare (ignore function-name)) |
(declare (ignore function-name)) |
698 |
(bindings (mapcar #'(lambda (x) `(,(gensym) ,x)) loc-args)) |
(bindings (mapcar #'(lambda (x) `(,(gensym) ,x)) loc-args)) |
699 |
(vars (mapcar #'car bindings))) |
(vars (mapcar #'car bindings))) |
700 |
`(let ,bindings |
`(let ,bindings |
701 |
(,setf-function-name ,(car (last form)) ,@vars))))) |
(funcall #',setf-function-name ,(car (last form)) ,@vars))))) |
702 |
|
(format t "defsetfinf ~S~%" `(defsetf ,function-name ,helper)) |
703 |
(eval `(defsetf ,function-name ,helper))) |
(eval `(defsetf ,function-name ,helper))) |
704 |
#+Xerox |
#+Xerox |
705 |
(flet ((setf-expander (body env) |
(flet ((setf-expander (body env) |