X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fbraid.lisp;h=2a6d7ac02d75deb6c836d2aae292c529bcf29265;hb=4aa82530da00c41e2751671ac75eda2d19a173a0;hp=000103f542eb71442ad55a5f0c98aec1e229179c;hpb=2abf77f6c4c559a3e5b7fc351a4743305381feb6;p=sbcl.git diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 000103f..2a6d7ac 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -265,8 +265,8 @@ ;;; Initialize a class metaobject. ;;; -;;; FIXME: This and most stuff in this file is probably only needed at init -;;; time. +;;; FIXME: This and most stuff in this file is probably only needed at +;;; init time. (defun !bootstrap-initialize-class (metaclass-name class name class-eq-wrapper source direct-supers direct-subclasses cpl wrapper @@ -279,6 +279,10 @@ (set-slot 'source source) (set-slot 'type (if (eq class (find-class 't)) t + ;; FIXME: Could this just be CLASS instead + ;; of `(CLASS ,CLASS)? If not, why not? + ;; (See also similar expression in + ;; SHARED-INITIALIZE :BEFORE (CLASS).) `(class ,class))) (set-slot 'class-eq-specializer (let ((spec (allocate-standard-instance class-eq-wrapper))) @@ -547,7 +551,7 @@ (cl:find-class symbol)))) ;; a hack to add the STREAM class as a ;; mixin to the LISP-STREAM class. - ((eq symbol 'sb-sys:lisp-stream) + ((eq symbol 'sb-kernel:lisp-stream) '(structure-object stream)) ((structure-type-included-type-name symbol) (list (structure-type-included-type-name @@ -558,14 +562,6 @@ symbol))))) (error "~S is not a legal structure class name." symbol))) -(defun method-function-returning-nil (args next-methods) - (declare (ignore args next-methods)) - nil) - -(defun method-function-returning-t (args next-methods) - (declare (ignore args next-methods)) - t) - (defun make-class-predicate (class name) (let* ((gf (ensure-generic-function name)) (mlist (if (eq *boot-state* 'complete) @@ -573,7 +569,7 @@ (early-gf-methods gf)))) (unless mlist (unless (eq class *the-class-t*) - (let* ((default-method-function #'method-function-returning-nil) + (let* ((default-method-function #'constantly-nil) (default-method-initargs (list :function default-method-function)) (default-method (make-a-method 'standard-method @@ -585,7 +581,7 @@ (setf (method-function-get default-method-function :constant-value) nil) (add-method gf default-method))) - (let* ((class-method-function #'method-function-returning-t) + (let* ((class-method-function #'constantly-t) (class-method-initargs (list :function class-method-function)) (class-method (make-a-method 'standard-method