/[cmucl]/src/code/macros.lisp
ViewVC logotype

Diff of /src/code/macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by ram, Fri May 24 16:58:02 1991 UTC revision 1.25 by ram, Thu Jul 11 16:27:53 1991 UTC
# Line 476  Line 476 
476  ;;; of value forms, a list of the single store-value form, a storing function,  ;;; of value forms, a list of the single store-value form, a storing function,
477  ;;; and an accessing function.  ;;; and an accessing function.
478    
 ;;; Left over in case someone is still trying to call this.  
 (defun foo-get-setf-method (form &optional environment)  
   (get-setf-method form environment))  
   
479  (eval-when (compile load eval)  (eval-when (compile load eval)
480  ;;;  ;;;
481  (defun get-setf-method (form &optional environment)  (defun get-setf-method (form &optional environment)
# Line 490  Line 486 
486      (cond ((symbolp form)      (cond ((symbolp form)
487             (let ((new-var (gensym)))             (let ((new-var (gensym)))
488               (values nil nil (list new-var) `(setq ,form ,new-var) form)))               (values nil nil (list new-var) `(setq ,form ,new-var) form)))
           ((and environment  
                 (assoc (car form) (c::lexenv-functions environment)))  
            (get-setf-method-inverse form `(funcall #'(setf ,(car form))) t))  
489            ;;            ;;
490            ;; ### Bootstrap hack...            ;; Local functions inhibit global setf methods...
491            ;; Ignore any DEFSETF info for structure accessors.            ((and environment
492            ((info function accessor-for (car form))                  (c::leaf-p (cdr (assoc (car form)
493                                           (c::lexenv-functions environment)))))
494             (get-setf-method-inverse form `(funcall #'(setf ,(car form))) t))             (get-setf-method-inverse form `(funcall #'(setf ,(car form))) t))
495            ((setq temp (info setf inverse (car form)))            ((setq temp (info setf inverse (car form)))
496             (get-setf-method-inverse form `(,temp) nil))             (get-setf-method-inverse form `(,temp) nil))
497            ((setq temp (info setf expander (car form)))            ((setq temp (info setf expander (car form)))
498             (funcall temp form environment))             (funcall temp form environment))
499              ;;
500              ;; If a macro, expand one level and try again.  If not, go for the
501              ;; SETF function.
502            (t            (t
503             (multiple-value-bind (res win)             (multiple-value-bind (res win)
504                                  (macroexpand-1 form environment)                                  (macroexpand-1 form environment)

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25

  ViewVC Help
Powered by ViewVC 1.1.5