X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdlisp2.lisp;h=538c78156a234d9ef779f5aaa196fd99f8dd759c;hb=9be48f2a73ca5f4cc0848b8c0adad7127de10373;hp=433832b9006f5728c766998bbfb5a3a961e03b7c;hpb=a736ac10b709b2d40305f0a6e3764afd246a8ef5;p=sbcl.git diff --git a/src/pcl/dlisp2.lisp b/src/pcl/dlisp2.lisp index 433832b..538c781 100644 --- a/src/pcl/dlisp2.lisp +++ b/src/pcl/dlisp2.lisp @@ -22,24 +22,28 @@ ;;;; specification. (in-package "SB-PCL") + +;;;; The whole of this file is dead code as long as *optimize-cache-functions-p* +;;;; is true, which it currently _always_ is. + (defun emit-reader/writer-function (reader/writer 1-or-2-class class-slot-p) (values (ecase reader/writer (:reader (ecase 1-or-2-class - (1 (if class-slot-p - (emit-reader/writer-macro :reader 1 t) - (emit-reader/writer-macro :reader 1 nil))) - (2 (if class-slot-p - (emit-reader/writer-macro :reader 2 t) - (emit-reader/writer-macro :reader 2 nil))))) + (1 (if class-slot-p + (emit-reader/writer-macro :reader 1 t) + (emit-reader/writer-macro :reader 1 nil))) + (2 (if class-slot-p + (emit-reader/writer-macro :reader 2 t) + (emit-reader/writer-macro :reader 2 nil))))) (:writer (ecase 1-or-2-class - (1 (if class-slot-p - (emit-reader/writer-macro :writer 1 t) - (emit-reader/writer-macro :writer 1 nil))) - (2 (if class-slot-p - (emit-reader/writer-macro :writer 2 t) - (emit-reader/writer-macro :writer 2 nil))))) + (1 (if class-slot-p + (emit-reader/writer-macro :writer 1 t) + (emit-reader/writer-macro :writer 1 nil))) + (2 (if class-slot-p + (emit-reader/writer-macro :writer 2 t) + (emit-reader/writer-macro :writer 2 nil))))) (:boundp (ecase 1-or-2-class (1 (if class-slot-p (emit-reader/writer-macro :boundp 1 t) @@ -54,32 +58,32 @@ (values (ecase reader/writer (:reader (if cached-index-p - (if class-slot-p - (emit-one-or-n-index-reader/writer-macro :reader t t) - (emit-one-or-n-index-reader/writer-macro :reader t nil)) - (if class-slot-p - (emit-one-or-n-index-reader/writer-macro :reader nil t) - (emit-one-or-n-index-reader/writer-macro :reader nil nil)))) + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :reader t t) + (emit-one-or-n-index-reader/writer-macro :reader t nil)) + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :reader nil t) + (emit-one-or-n-index-reader/writer-macro :reader nil nil)))) (:writer (if cached-index-p - (if class-slot-p - (emit-one-or-n-index-reader/writer-macro :writer t t) - (emit-one-or-n-index-reader/writer-macro :writer t nil)) - (if class-slot-p - (emit-one-or-n-index-reader/writer-macro :writer nil t) - (emit-one-or-n-index-reader/writer-macro :writer nil nil)))) + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :writer t t) + (emit-one-or-n-index-reader/writer-macro :writer t nil)) + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :writer nil t) + (emit-one-or-n-index-reader/writer-macro :writer nil nil)))) (:boundp (if cached-index-p - (if class-slot-p - (emit-one-or-n-index-reader/writer-macro :boundp t t) - (emit-one-or-n-index-reader/writer-macro :boundp t nil)) - (if class-slot-p - (emit-one-or-n-index-reader/writer-macro :boundp nil t) - (emit-one-or-n-index-reader/writer-macro :boundp nil nil))))) + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :boundp t t) + (emit-one-or-n-index-reader/writer-macro :boundp t nil)) + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :boundp nil t) + (emit-one-or-n-index-reader/writer-macro :boundp nil nil))))) nil)) (defun emit-checking-or-caching-function (cached-emf-p return-value-p metatypes applyp) (values (emit-checking-or-caching-function-preliminary - cached-emf-p return-value-p metatypes applyp) - t)) + cached-emf-p return-value-p metatypes applyp) + t)) (defvar *not-in-cache* (make-symbol "not in cache")) @@ -88,41 +92,41 @@ (declare (ignore applyp)) (if cached-emf-p (lambda (cache miss-fn) - (declare (type function miss-fn)) - #'(instance-lambda (&rest args) + (declare (type function miss-fn)) + #'(lambda (&rest args) (declare #.*optimize-speed*) - (with-dfun-wrappers (args metatypes) - (dfun-wrappers invalid-wrapper-p) - (apply miss-fn args) - (if invalid-wrapper-p - (apply miss-fn args) - (let ((emf (probe-cache cache dfun-wrappers *not-in-cache*))) - (if (eq emf *not-in-cache*) - (apply miss-fn args) - (if return-value-p - emf - (invoke-emf emf args)))))))) + (with-dfun-wrappers (args metatypes) + (dfun-wrappers invalid-wrapper-p) + (apply miss-fn args) + (if invalid-wrapper-p + (apply miss-fn args) + (let ((emf (probe-cache cache dfun-wrappers *not-in-cache*))) + (if (eq emf *not-in-cache*) + (apply miss-fn args) + (if return-value-p + emf + (invoke-emf emf args)))))))) (lambda (cache emf miss-fn) - (declare (type function miss-fn)) - #'(instance-lambda (&rest args) - (declare #.*optimize-speed*) - (with-dfun-wrappers (args metatypes) - (dfun-wrappers invalid-wrapper-p) - (apply miss-fn args) - (if invalid-wrapper-p - (apply miss-fn args) - (let ((found-p (not (eq *not-in-cache* - (probe-cache cache dfun-wrappers - *not-in-cache*))))) - (if found-p - (invoke-emf emf args) - (if return-value-p - t - (apply miss-fn args)))))))))) + (declare (type function miss-fn)) + #'(lambda (&rest args) + (declare #.*optimize-speed*) + (with-dfun-wrappers (args metatypes) + (dfun-wrappers invalid-wrapper-p) + (apply miss-fn args) + (if invalid-wrapper-p + (apply miss-fn args) + (let ((found-p (not (eq *not-in-cache* + (probe-cache cache dfun-wrappers + *not-in-cache*))))) + (if found-p + (invoke-emf emf args) + (if return-value-p + t + (apply miss-fn args)))))))))) (defun emit-default-only-function (metatypes applyp) (declare (ignore metatypes applyp)) (values (lambda (emf) - (lambda (&rest args) - (invoke-emf emf args))) - t)) + (lambda (&rest args) + (invoke-emf emf args))) + t))