Skip to content
Snippets Groups Projects
Commit d3918c49 authored by ram's avatar ram
Browse files

Tweaked the global set macros inhibition for local functions to work correctly

now that INLINE/NOTINLINE declarations are represented in the LEXENV-FUNCTIONS.
Also, this is inhibited if there is any enclosing local function *OR MACRO*,
not merely if the currently apparent definition is a local function.
parent 65ed4bb6
No related branches found
No related tags found
No related merge requests found
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.35.1.1 1993/02/04 22:35:38 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.35.1.2 1993/02/06 15:14:09 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -542,8 +542,11 @@
;;
;; Local functions inhibit global setf methods...
((and environment
(c::leaf-p (cdr (assoc (car form)
(c::lexenv-functions environment)))))
(let ((name (car form)))
(dolist (x (c::lexenv-functions environment) nil)
(when (and (eq (car x) name)
(not (c::defined-function-p (cdr x))))
(return t)))))
(get-setf-method-inverse form `(funcall #'(setf ,(car form))) t))
((setq temp (info setf inverse (car form)))
(get-setf-method-inverse form `(,temp) nil))
......@@ -1041,35 +1044,25 @@
,v))
;;; Evil hack invented by the gnomes of Vassar Street. The function arg must
;;; be constant. Get a setf method for this function, pretending that the
;;; final (list) arg to apply is just a normal arg. If the setting and access
;;; forms produced in this way reference this arg at the end, then just splice
;;; the APPLY back onto the front and the right thing happens.
;;; Evil hack invented by the gnomes of Vassar Street (though not as evil as
;;; it used to be.) The function arg must be constant, and is converted to an
;;; APPLY of ther SETF function, which ought to exist.
;;;
;;; We special-case uses functions in the Lisp package so that APPLY AREF works
;;; even though %ASET takes the new-value last. (there is (SETF AREF) as well
;;; as a setf method, etc.)
;;;
(define-setf-method apply (function &rest args &environment env)
(define-setf-method apply (function &rest args)
(unless (and (listp function)
(= (list-length function) 2)
(eq (first function) 'function)
(symbolp (second function)))
(error "Setf of Apply is only defined for function args like #'symbol."))
(let ((function (second function)))
(multiple-value-bind
(dummies vals newval setter getter)
(if (eq (symbol-package function) (symbol-package 'aref))
(get-setf-method-inverse (cons function args) `((setf ,function)) t)
(get-setf-method (cons function args) env))
(unless (and (eq (car (last args)) (car (last vals)))
(eq (car (last getter)) (car (last dummies)))
(eq (car (last setter)) (car (last dummies))))
(error "Apply of ~S not understood as a location for Setf." function))
(values dummies vals newval
`(apply (function ,(car setter)) ,@(cdr setter))
`(apply (function ,(car getter)) ,@(cdr getter))))))
(let ((function (second function))
(new-var (gensym))
(vars nil))
(dolist (x args)
(declare (ignore x))
(push (gensym) vars))
(values vars args (list new-var)
`(apply #'(setf ,function) ,new-var ,@vars)
`(apply #',function ,@vars))))
;;; Special-case a BYTE bytespec so that the compiler can recognize it.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment