From bc2977763a323f3e180dfb227081688cd8d021af Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 19 Dec 2008 15:20:43 +0000 Subject: [PATCH] 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. --- BUGS | 8 -------- NEWS | 4 ++++ src/pcl/boot.lisp | 37 ++++++++++++++++++++++--------------- src/pcl/vector.lisp | 2 +- tests/clos.impure.lisp | 27 +++++++++++++++++++++++++++ version.lisp-expr | 2 +- 6 files changed, 55 insertions(+), 25 deletions(-) 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" -- 1.7.10.4