X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fcompiler-support.lisp;h=846f82a46ac9a12f19225a1d170b32c02730c6f5;hb=19d37e39d4e0bfc943749d111c1ba2cbed805939;hp=5dcd8c61244e2f15e7a777cb9e1da0f77d07c718;hpb=95d19447c10434753c2168ac943152fd5e3ded3d;p=sbcl.git diff --git a/src/pcl/compiler-support.lisp b/src/pcl/compiler-support.lisp index 5dcd8c6..846f82a 100644 --- a/src/pcl/compiler-support.lisp +++ b/src/pcl/compiler-support.lisp @@ -64,9 +64,9 @@ (defvar sb-pcl::*internal-pcl-generalized-fun-name-symbols* nil) -(defmacro define-internal-pcl-function-name-syntax (name &body body) +(defmacro define-internal-pcl-function-name-syntax (name (var) &body body) `(progn - (define-function-name-syntax ,name ,@body) + (define-function-name-syntax ,name (,var) ,@body) (pushnew ',name sb-pcl::*internal-pcl-generalized-fun-name-symbols*))) (define-internal-pcl-function-name-syntax sb-pcl::slot-accessor (list) @@ -92,43 +92,3 @@ (sb-pcl::fsc-instance-p class-or-name)) (values t nil))))) -;;;; SLOT-VALUE optimizations - -(defknown slot-value (t symbol) t (any)) -(defknown sb-pcl::set-slot-value (t symbol t) t (any)) - -(defun pcl-boot-state-complete-p () - (eq 'sb-pcl::complete sb-pcl::*boot-state*)) - -;;; These essentially duplicate what the compiler-macros in slots.lisp -;;; do, but catch more cases. We retain the compiler-macros since they -;;; can be used during the build, and because they catch common cases -;;; slightly more cheaply then the transforms. (Transforms add new -;;; lambdas, which requires more work by the compiler.) - -(deftransform slot-value ((object slot-name)) - "optimize" - (let (c-slot-name) - (if (and (pcl-boot-state-complete-p) - (constant-lvar-p slot-name) - (setf c-slot-name (lvar-value slot-name)) - (sb-pcl::interned-symbol-p c-slot-name)) - `(sb-pcl::accessor-slot-value object ',c-slot-name) - (give-up-ir1-transform "Slot name is not constant.")))) - -(deftransform sb-pcl::set-slot-value ((object slot-name new-value) - (t symbol t) t - ;; Safe code wants to check the - ;; type, and the global accessor - ;; won't do that. Also see the - ;; comment in the - ;; compiler-macro. - :policy (< safety 3)) - "optimize" - (let (c-slot-name) - (if (and (pcl-boot-state-complete-p) - (constant-lvar-p slot-name) - (setf c-slot-name (lvar-value slot-name)) - (sb-pcl::interned-symbol-p c-slot-name)) - `(sb-pcl::accessor-set-slot-value object ',c-slot-name new-value) - (give-up-ir1-transform "Slot name is not constant."))))