Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8895/src/pcl
Modified Files:
boot.lisp
Log Message:
0.8.11.15:
Fix bug 276. Woo yay. Now we can be evil in DEFMETHODs again.
... also log a couple more HaibleMOPBugs
Index: boot.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/boot.lisp,v
retrieving revision 1.78
retrieving revision 1.79
diff -u -d -r1.78 -r1.79
--- boot.lisp 19 Oct 2003 19:09:12 -0000 1.78
+++ boot.lisp 16 Jun 2004 21:00:24 -0000 1.79
@@ -502,7 +502,6 @@
(declare (ignore env))
(multiple-value-bind (parameters unspecialized-lambda-list specializers)
(parse-specialized-lambda-list lambda-list)
- (declare (ignore parameters))
(multiple-value-bind (real-body declarations documentation)
(parse-body body)
(values `(lambda ,unspecialized-lambda-list
@@ -670,8 +669,9 @@
;; it can avoid run-time type dispatch overhead,
;; which can be a huge win for Python.)
;;
- ;; FIXME: Perhaps these belong in
- ;; ADD-METHOD-DECLARATIONS instead of here?
+ ;; KLUDGE: when I tried moving these to
+ ;; ADD-METHOD-DECLARATIONS, things broke. No idea
+ ;; why. -- CSR, 2004-06-16
,@(mapcar #'parameter-specializer-declaration-in-defmethod
parameters
specializers)))
@@ -717,7 +717,8 @@
((eq p '&aux)
(return nil))))))
(multiple-value-bind
- (walked-lambda call-next-method-p closurep next-method-p-p)
+ (walked-lambda call-next-method-p closurep
+ next-method-p-p setq-p)
(walk-method-lambda method-lambda
required-parameters
env
@@ -758,6 +759,7 @@
:call-next-method-p
,call-next-method-p
:next-method-p-p ,next-method-p-p
+ :setq-p ,setq-p
;; we need to pass this along
;; so that NO-NEXT-METHOD can
;; be given a suitable METHOD
@@ -820,8 +822,9 @@
(or ,cnm-args ,',method-args))))
(next-method-p-body ()
`(not (null .next-method.)))
- (with-rebound-original-args ((call-next-method-p) &body body)
- (declare (ignore call-next-method-p))
+ (with-rebound-original-args ((call-next-method-p setq-p)
+ &body body)
+ (declare (ignore call-next-method-p setq-p))
`(let () ,@body)))
,@body))
@@ -1114,8 +1117,8 @@
`(,rest-arg)))))))
(next-method-p-body ()
`(not (null ,',next-method-call)))
- (with-rebound-original-args ((cnm-p) &body body)
- (if cnm-p
+ (with-rebound-original-args ((cnm-p setq-p) &body body)
+ (if (or cnm-p setq-p)
`(let ,',rebindings
(declare (ignorable ,@',all-params))
,@body)
@@ -1123,11 +1126,11 @@
,@body)))
(defmacro bind-lexical-method-functions
- ((&key call-next-method-p next-method-p-p
+ ((&key call-next-method-p next-method-p-p setq-p
closurep applyp method-name-declaration)
&body body)
(cond ((and (null call-next-method-p) (null next-method-p-p)
- (null closurep) (null applyp))
+ (null closurep) (null applyp) (null setq-p))
`(let () ,@body))
(t
`(call-next-method-bind
@@ -1139,7 +1142,7 @@
,@(and next-method-p-p
'((next-method-p ()
(next-method-p-body)))))
- (with-rebound-original-args (,call-next-method-p)
+ (with-rebound-original-args (,call-next-method-p ,setq-p)
,@body))))))
(defmacro bind-args ((lambda-list args) &body body)
@@ -1231,8 +1234,9 @@
; should be in the method definition
(closurep nil) ; flag indicating that #'CALL-NEXT-METHOD
; was seen in the body of a method
- (next-method-p-p nil)) ; flag indicating that NEXT-METHOD-P
+ (next-method-p-p nil) ; flag indicating that NEXT-METHOD-P
; should be in the method definition
+ (setq-p nil))
(flet ((walk-function (form context env)
(cond ((not (eq context :eval)) form)
;; FIXME: Jumping to a conclusion from the way it's used
@@ -1247,6 +1251,9 @@
((eq (car form) 'next-method-p)
(setq next-method-p-p t)
form)
+ ((eq (car form) 'setq)
+ (setq setq-p t)
+ form)
((and (eq (car form) 'function)
(cond ((eq (cadr form) 'call-next-method)
(setq call-next-method-p t)
@@ -1283,7 +1290,8 @@
(values walked-lambda
call-next-method-p
closurep
- next-method-p-p)))))
+ next-method-p-p
+ setq-p)))))
(defun generic-function-name-p (name)
(and (legal-fun-name-p name)
-------------------------------------------------------
This SF.Net email is sponsored by The 2004 JavaOne(SM) Conference
Learn from the experts at JavaOne(SM), Sun's Worldwide Java Developer
Conference, June 28 - July 1 at the Moscone Center in San Francisco, CA
REGISTER AND SAVE! http://java.sun.com/javaone/sf Priority Code NWMGYKND
|
