0.6.10.18:
[sbcl.git] / src / pcl / braid.lisp
index 000103f..2a6d7ac 100644 (file)
 
 ;;; 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
     (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)))
                                        (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
                                 symbol)))))
       (error "~S is not a legal structure class name." symbol)))
 \f
-(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)
                    (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
          (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