projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.6.10.18:
[sbcl.git]
/
src
/
pcl
/
braid.lisp
diff --git
a/src/pcl/braid.lisp
b/src/pcl/braid.lisp
index
000103f
..
2a6d7ac
100644
(file)
--- a/
src/pcl/braid.lisp
+++ b/
src/pcl/braid.lisp
@@
-265,8
+265,8
@@
;;; Initialize a class metaobject.
;;;
;;; 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
(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
(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)))
`(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.
(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
'(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)))
\f
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)
(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*)
(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
(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)))
(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
(class-method-initargs (list :function
class-method-function))
(class-method (make-a-method 'standard-method