29 |
(export '(setf psetf shiftf rotatef |
(export '(setf psetf shiftf rotatef |
30 |
define-modify-macro defsetf |
define-modify-macro defsetf |
31 |
getf remf incf decf push pushnew pop |
getf remf incf decf push pushnew pop |
32 |
define-setf-method get-setf-method get-setf-method-multiple-value)) |
define-setf-method |
33 |
|
define-setf-expander |
34 |
|
get-setf-method |
35 |
|
get-setf-expansion |
36 |
|
get-setf-method-multiple-value)) |
37 |
|
|
38 |
|
|
39 |
(in-package 'system) |
(in-package 'system) |
82 |
(t (setq args (cons (gensym) args)) |
(t (setq args (cons (gensym) args)) |
83 |
(push `(declare (ignore ,(car args))) body))) |
(push `(declare (ignore ,(car args))) body))) |
84 |
`(eval-when (compile eval load) |
`(eval-when (compile eval load) |
85 |
(si:putprop ',access-fn #'(lambda ,args ,@ body) 'setf-method) |
(si:putprop ',access-fn |
86 |
|
#'(lambda ,args (block ,access-fn ,@ body)) |
87 |
|
'setf-method) |
88 |
(remprop ',access-fn 'setf-lambda) |
(remprop ',access-fn 'setf-lambda) |
89 |
(remprop ',access-fn 'setf-update-fn) |
(remprop ',access-fn 'setf-update-fn) |
90 |
(si:putprop ',access-fn |
(si:putprop ',access-fn |
92 |
'setf-documentation) |
'setf-documentation) |
93 |
',access-fn)) |
',access-fn)) |
94 |
|
|
95 |
|
(defmacro define-setf-expander (access-fn &rest rest) |
96 |
|
`(define-setf-method ,access-fn ,@rest)) |
97 |
|
|
98 |
;;; GET-SETF-METHOD. |
;;; GET-SETF-METHOD. |
99 |
;;; It just calls GET-SETF-METHOD-MULTIPLE-VALUE |
;;; It just calls GET-SETF-METHOD-MULTIPLE-VALUE |
105 |
(error "Multiple store-variables are not allowed.")) |
(error "Multiple store-variables are not allowed.")) |
106 |
(values vars vals stores store-form access-form))) |
(values vars vals stores store-form access-form))) |
107 |
|
|
108 |
|
(defun get-setf-expansion (form &optional env) |
109 |
|
(get-setf-method form env)) |
110 |
|
|
111 |
;;;; GET-SETF-METHOD-MULTIPLE-VALUE. |
;;;; GET-SETF-METHOD-MULTIPLE-VALUE. |
112 |
|
|