From c103e75ed3eaf47bda3407d663fd64f09215dc11 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 11 Sep 2006 10:40:07 +0000 Subject: [PATCH] 0.9.16.24: (SETF INFO) compiler macro enabled * Since we now support SETF compiler-macros. Unfortunately the definition comes too late to affect large parts of SBCL -- but the same applies to the venerable compiler-macro for INFO. * Use KEYWORDP instead of CONSTANTP in these macros, as that (or self-evaluating-p) is what is actually ment -- no EVAL or CONSTANT-FORM-VALUE in sight. --- src/compiler/globaldb.lisp | 44 ++++++++++++++++++-------------------------- version.lisp-expr | 2 +- 2 files changed, 19 insertions(+), 27 deletions(-) diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index b9768ca..45e10d8 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -758,7 +758,7 @@ (&whole whole class type name &optional (env-list nil env-list-p)) ;; Constant CLASS and TYPE is an overwhelmingly common special case, ;; and we can implement it much more efficiently than the general case. - (if (and (constantp class) (constantp type)) + (if (and (keywordp class) (keywordp type)) (let ((info (type-info-or-lose class type))) (with-unique-names (value foundp) `(multiple-value-bind (,value ,foundp) @@ -768,6 +768,7 @@ (declare (type ,(type-info-type info) ,value)) (values ,value ,foundp)))) whole)) + (defun (setf info) (new-value class type @@ -786,37 +787,28 @@ tin new-value))) new-value) -;;; FIXME: We'd like to do this, but Python doesn't support -;;; compiler macros and it's hard to change it so that it does. -;;; It might make more sense to just convert INFO :FOO :BAR into -;;; an ordinary function, so that instead of calling INFO :FOO :BAR -;;; you call e.g. INFO%FOO%BAR. Then dynamic linking could be handled -;;; by the ordinary Lisp mechanisms and we wouldn't have to maintain -;;; all this cruft.. -#| #!-sb-fluid -(progn - (define-compiler-macro (setf info) (&whole whole +(define-compiler-macro (setf info) (&whole whole new-value class type name &optional (env-list nil env-list-p)) - ;; Constant CLASS and TYPE is an overwhelmingly common special case, and we - ;; can resolve it much more efficiently than the general case. - (if (and (constantp class) (constantp type)) - (let* ((info (type-info-or-lose class type)) - (tin (type-info-number info))) - (if env-list-p - `(set-info-value ,name - ,tin - ,new-value - (get-write-info-env ,env-list)) - `(set-info-value ,name - ,tin - ,new-value))) - whole))) -|# + ;; Constant CLASS and TYPE is an overwhelmingly common special case, + ;; and we can resolve it much more efficiently than the general + ;; case. + (if (and (keywordp class) (keywordp type)) + (let* ((info (type-info-or-lose class type)) + (tin (type-info-number info))) + (if env-list-p + `(set-info-value ,name + ,tin + ,new-value + (get-write-info-env ,env-list)) + `(set-info-value ,name + ,tin + ,new-value)))) + whole) ;;; the maximum density of the hashtable in a volatile env (in ;;; names/bucket) diff --git a/version.lisp-expr b/version.lisp-expr index e84cd1c..93cd629 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".) -"0.9.16.23" +"0.9.16.24" -- 1.7.10.4