From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 19 Dec 2008 15:20:43 +0000 (+0000)
Subject: 1.0.23.56: special variables cause special cases in CLOS cleverness
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=bc2977763a323f3e180dfb227081688cd8d021af;p=sbcl.git
1.0.23.56: special variables cause special cases in CLOS cleverness
* As we cannot reliably ensure nothing calls SET or (SETF
SYMBOL-VALUE) on the special variable, we need to disable
optimizations perutation vector optimizations for them.
* For the same reason we cannot implicitly declare types for even
local specials in DEFMETHODs.
* Delete bug 276: the issue it refers to was fixed back when we
stopped inserting declarations for special variables.
---
diff --git a/BUGS b/BUGS
index d7ecde8..15269e7 100644
--- a/BUGS
+++ b/BUGS
@@ -841,14 +841,6 @@ WORKAROUND:
(fixed in 0.8.2.51, but a test case would be good)
-276:
- b. The same as in a., but using MULTIPLE-VALUE-SETQ instead of SETQ.
- c. (defvar *faa*)
- (defmethod faa ((*faa* double-float))
- (set '*faa* (when (< *faa* 0) (- *faa*)))
- (1+ *faa*))
- (faa 1d0) => type error
-
279: type propagation error -- correctly inferred type goes astray?
In sbcl-0.8.3 and sbcl-0.8.1.47, the warning
The binding of ABS-FOO is a (VALUES (INTEGER 0 0)
diff --git a/NEWS b/NEWS
index 0030620..131a63c 100644
--- a/NEWS
+++ b/NEWS
@@ -38,6 +38,10 @@
* bug fix: return values of READ-SEQUENCE did not take :START into
account on file streams, regressions since 1.0.12.22. (reported by
Daniel Herring, patch by Paul Huong)
+ * bug fix: using SET or (SETF SYMBOL-VALUE) to change the value of a
+ method specializer used to confuse permuation vector optimization.
+ * bug fix: system inserted bogus implicit type declarations for local
+ special variables in DEFMETHOD bodies.
changes in sbcl-1.0.23 relative to 1.0.22:
* enhancement: when disassembling method functions, disassembly
diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index bedfc51..12467fa 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -590,6 +590,12 @@ bootstrapping.
(setf (gdefinition 'make-method-lambda)
(symbol-function 'real-make-method-lambda)))
+(defun declared-specials (declarations)
+ (loop for (declare . specifiers) in declarations
+ append (loop for specifier in specifiers
+ when (eq 'special (car specifier))
+ append (cdr specifier))))
+
(defun make-method-lambda-internal (proto-gf proto-method method-lambda env)
(declare (ignore proto-gf proto-method))
(unless (and (consp method-lambda) (eq (car method-lambda) 'lambda))
@@ -641,9 +647,12 @@ bootstrapping.
;; 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)))
+ ,@(let ((specials (declared-specials declarations)))
+ (mapcar (lambda (par spec)
+ (parameter-specializer-declaration-in-defmethod
+ par spec specials env))
+ parameters
+ specializers))))
(method-lambda
;; Remove the documentation string and insert the
;; appropriate class declarations. The documentation
@@ -799,8 +808,12 @@ bootstrapping.
(symbol-function 'real-unparse-specializer-using-class)))
;;; a helper function for creating Python-friendly type declarations
-;;; in DEFMETHOD forms
-(defun parameter-specializer-declaration-in-defmethod (parameter specializer)
+;;; in DEFMETHOD forms.
+;;;
+;;; We're too lazy to cons up a new environment for this, so we just pass in
+;;; the list of locally declared specials in addition to the old environment.
+(defun parameter-specializer-declaration-in-defmethod
+ (parameter specializer specials env)
(cond ((and (consp specializer)
(eq (car specializer) 'eql))
;; KLUDGE: ANSI, in its wisdom, says that
@@ -853,16 +866,10 @@ bootstrapping.
'(ignorable))
((typep specializer 'eql-specializer)
`(type (eql ,(eql-specializer-object specializer)) ,parameter))
- ((var-globally-special-p parameter)
- ;; KLUDGE: Don't declare types for global special variables
- ;; -- our rebinding magic for SETQ cases don't work right
- ;; there.
- ;;
- ;; FIXME: It would be better to detect the SETQ earlier and
- ;; skip declarations for specials only when needed, not
- ;; always.
- ;;
- ;; --NS 2004-10-14
+ ((or (var-special-p parameter env) (member parameter specials))
+ ;; Don't declare types for special variables -- our rebinding magic
+ ;; for SETQ cases don't work right there as SET, (SETF SYMBOL-VALUE),
+ ;; etc. make things undecidable.
'(ignorable))
(t
;; Otherwise, we can usually make Python very happy.
diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index 02700ec..606acba 100644
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -146,7 +146,7 @@
(slot-boundp 'boundp)))
(var (extract-the var-form))
(slot-name (constant-form-value slot-name-form env)))
- (when (symbolp var)
+ (when (and (symbolp var) (not (var-special-p var env)))
(let* ((rebound? (caddr (var-declaration '%variable-rebinding var env)))
(parameter-or-nil (car (memq (or rebound? var)
required-parameters))))
diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 34d38bd..877073c 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1647,5 +1647,32 @@
(defgeneric foo-slot (x y z))
(defclass foo ()
((slot :accessor foo-slot-value))))
+
+;;; SET and (SETF SYMBOL-VALUE) used to confuse permuation vector
+;;; optimizations
+(defclass fih ()
+ ((x :initform :fih)))
+(defclass fah ()
+ ((x :initform :fah)))
+(declaim (special *fih*))
+(defmethod fihfah ((*fih* fih))
+ (set '*fih* (make-instance 'fah))
+ (list (slot-value *fih* 'x)
+ (eval '(slot-value *fih* 'x))))
+(defmethod fihfah ((fah fah))
+ (declare (special fah))
+ (set 'fah (make-instance 'fih))
+ (list (slot-value fah 'x)
+ (eval '(slot-value fah 'x))))
+(with-test (:name :set-of-a-method-specializer)
+ (assert (equal '(:fah :fah) (fihfah (make-instance 'fih))))
+ (assert (equal '(:fih :fih) (fihfah (make-instance 'fah)))))
+
+(defmethod no-implicit-declarations-for-local-specials ((faax double-float))
+ (declare (special faax))
+ (set 'faax (when (< faax 0) (- faax)))
+ faax)
+(with-test (:name :no-implicit-declarations-for-local-specials)
+ (assert (not (no-implicit-declarations-for-local-specials 1.0d0))))
;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index c806284..e456d3f 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.23.55"
+"1.0.23.56"