Changeset 4155

Timestamp:

10/01/03 01:27:56 (19 years ago)

Author:

piso

Message:

*setf-expander* => 'setf-inverse

Location:

trunk/j/src/org/armedbear/lisp

Files:

• defstruct.lisp (modified) (2 diffs)
• setf.lisp (modified) (8 diffs)

trunk/j/src/org/armedbear/lisp/defstruct.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: defstruct.lisp,v 1.22 2003-09-30 09:57:33 piso Exp $
+;;; $Id: defstruct.lisp,v 1.23 2003-10-01 01:27:56 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -68 +68 @@
         (setf-expander (gensym)))
     `((setf (symbol-function ',accessor) (get-slot-accessor ,index))
-      (%put ',accessor *setf-expander* (get-slot-mutator ,index)))))
+      (%put ',accessor 'setf-inverse (get-slot-mutator ,index)))))
 
 (defun define-access-functions (slots)

trunk/j/src/org/armedbear/lisp/setf.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: setf.lisp,v 1.26 2003-09-26 00:44:30 piso Exp $
+;;; $Id: setf.lisp,v 1.27 2003-10-01 01:27:20 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -19 +19 @@
 
 (in-package "SYSTEM")
-
-(defconstant *setf-expander* (make-symbol "SETF-EXPANDER"))
 
 (defun get-setf-expansion (form &optional environment)
@@ -27 +25 @@
            (values nil nil (list new-var)
                    `(setq ,form ,new-var) form)))
-  ((get (car form) *setf-expander*)
+  ((get (car form) 'setf-inverse)
    (let ((vars (mapcar #'(lambda (x) (gensym)) (cdr form)))
          (store (gensym)))
@@ -33 +31 @@
                    (cdr form)
                    (list store)
-                   `(,(get (car form) *setf-expander*)
+                   `(,(get (car form) 'setf-inverse)
                       ,@vars ,store)
        (cons (car form) vars))))
@@ -76 +74 @@
           (when (macro-function (car place))
             (setq place (macroexpand place)))
-          (let ((expander (get (car place) *setf-expander*)))
-            (cond ((null expander)
+          (let ((inverse (get (car place) 'setf-inverse)))
+            (cond ((null inverse)
                    (error "no SETF expansion for ~A" place))
-                  ((symbolp expander)
-                   `(,expander ,@(cdr place) ,value))
-                  ((functionp expander)
-                   `(funcall ,expander ,@(cdr place) ,value))
+                  ((symbolp inverse)
+                   `(,inverse ,@(cdr place) ,value))
+                  ((functionp inverse)
+                   `(funcall ,inverse ,@(cdr place) ,value))
                   (t
                    (error "SETF: unhandled case")))))
@@ -103 +101 @@
          (symbol-function name))
         ((and (consp name) (eq (car name) 'setf))
-         (or (get *setf-expander* (cadr name)) (error 'undefined-function)))
+         (or (get 'setf-inverse (cadr name)) (error 'undefined-function)))
         (t (error 'type-error))))
 
@@ -110 +108 @@
          (fset name function))
         ((and (consp name) (eq (car name) 'setf))
-         (%put (cadr name) *setf-expander* function))
+         (%put (cadr name) 'setf-inverse function))
         (t (error 'type-error))))
 
@@ -129 +127 @@
 
 (defmacro defsetf (access-function update-function)
-  `(%put ',access-function *setf-expander* ',update-function))
+  `(%put ',access-function 'setf-inverse ',update-function))
 
 (defun %set-caar (x v) (%rplaca (car x) v))