later versions of SBCL, and the other stuff in here is
definitely not guaranteed to be present in later versions of SBCL."
:use ("CL" "SB!INT" "SB!EXT" "SB!WALKER" "SB!KERNEL")
- :import-from (("SB!KERNEL" "FUNCALLABLE-INSTANCE-P" "%FUN-DOC"
- "PACKAGE-DOC-STRING"
- "PACKAGE-HASHTABLE-SIZE" "PACKAGE-HASHTABLE-FREE"
- "PACKAGE-INTERNAL-SYMBOLS" "PACKAGE-EXTERNAL-SYMBOLS"))
- ;; FIXME: should we now reexport CLASS and friends, too?
- ;; Probably. See if AMOP has a list of exported symbols.
:reexport ("ADD-METHOD" "ALLOCATE-INSTANCE"
- "COMPUTE-APPLICABLE-METHODS"
- "ENSURE-GENERIC-FUNCTION"
- "MAKE-INSTANCE" "METHOD-QUALIFIERS"
- "REMOVE-METHOD")
+ "CLASS-NAME" "COMPUTE-APPLICABLE-METHODS"
+ "ENSURE-GENERIC-FUNCTION" "MAKE-INSTANCE"
+ "METHOD-QUALIFIERS" "REMOVE-METHOD")
:export ("ADD-DEPENDENT"
"ADD-DIRECT-METHOD"
"ADD-DIRECT-SUBCLASS"
"CLASS-SLOTS"
"COMPUTE-APPLICABLE-METHODS-USING-CLASSES"
"COMPUTE-CLASS-PRECEDENCE-LIST"
+ "COMPUTE-DEFAULT-INITARGS"
"COMPUTE-DISCRIMINATING-FUNCTION"
"COMPUTE-EFFECTIVE-METHOD"
"COMPUTE-EFFECTIVE-SLOT-DEFINITION"
"ENSURE-CLASS"
"ENSURE-CLASS-USING-CLASS"
"ENSURE-GENERIC-FUNCTION-USING-CLASS"
- "EQL-SPECIALIZER-INSTANCE"
+ "EQL-SPECIALIZER-OBJECT"
"EXTRACT-LAMBDA-LIST"
"EXTRACT-SPECIALIZER-NAMES"
"FINALIZE-INHERITANCE"
"REMOVE-DEPENDENT"
"REMOVE-DIRECT-METHOD"
"REMOVE-DIRECT-SUBCLASS"
- "SET-FUNCALLABLE-INSTANCE-FUN"
+ "SET-FUNCALLABLE-INSTANCE-FUNCTION"
"SLOT-BOUNDP-USING-CLASS"
"SLOT-DEFINITION-ALLOCATION"
"SLOT-DEFINITION-INITARGS"
"SLOT-DEFINITION-TYPE"
"SLOT-MAKUNBOUND-USING-CLASS"
"SLOT-VALUE-USING-CLASS"
- "SPECIALIZER-DIRECT-GENERIC-FUNCTION"
+ "SPECIALIZER-DIRECT-GENERIC-FUNCTIONS"
"SPECIALIZER-DIRECT-METHODS"
"STANDARD-INSTANCE-ACCESS"
"UPDATE-DEPENDENT"
(defun make-early-gf (spec &optional lambda-list lambda-list-p
function argument-precedence-order)
(let ((fin (allocate-funcallable-instance *sgf-wrapper* *sgf-slots-init*)))
- (set-funcallable-instance-fun
+ (set-funcallable-instance-function
fin
(or function
(if (eq spec 'print-object)
(slots-init nil slots-init-p))
(let ((fin (%make-pcl-funcallable-instance nil nil
(get-instance-hash-code))))
- (set-funcallable-instance-fun
+ (set-funcallable-instance-function
fin
#'(instance-lambda (&rest args)
(declare (ignore args))
(let ((dfun (if early-p
(or dfun (make-initial-dfun generic-function))
(compute-discriminating-function generic-function))))
- (set-funcallable-instance-fun generic-function dfun)
+ (set-funcallable-instance-function generic-function dfun)
(set-fun-name generic-function gf-name)
(when (and ocache (not (eq ocache cache))) (free-cache ocache))
dfun)))
(import 'sb-kernel:funcallable-instance-p)
-(defun set-funcallable-instance-fun (fin new-value)
+(defun set-funcallable-instance-function (fin new-value)
(declare (type function new-value))
(aver (funcallable-instance-p fin))
(setf (funcallable-instance-fun fin) new-value))
;;; the funcallable instance function of the generic function for which
;;; it was computed.
;;;
-;;; More precisely, if compute-discriminating-function is called with an
-;;; argument <gf1>, and returns a result <df1>, that result must not be
-;;; passed to apply or funcall directly. Rather, <df1> must be stored as
-;;; the funcallable instance function of the same generic function <gf1>
-;;; (using set-funcallable-instance-fun). Then the generic function
-;;; can be passed to funcall or apply.
+;;; More precisely, if compute-discriminating-function is called with
+;;; an argument <gf1>, and returns a result <df1>, that result must
+;;; not be passed to apply or funcall directly. Rather, <df1> must be
+;;; stored as the funcallable instance function of the same generic
+;;; function <gf1> (using SET-FUNCALLABLE-INSTANCE-FUNCTION). Then the
+;;; generic function can be passed to funcall or apply.
;;;
;;; An important exception is that methods on this generic function are
;;; permitted to return a function which itself ends up calling the value
;;; (lambda (arg)
;;; (cond (<some condition>
;;; <store some info in the generic function>
-;;; (set-funcallable-instance-fun
+;;; (set-funcallable-instance-function
;;; gf
;;; (compute-discriminating-function gf))
;;; (funcall gf arg))
;;; (defmethod compute-discriminating-function ((gf my-generic-function))
;;; (lambda (arg)
;;; (cond (<some condition>
-;;; (set-funcallable-instance-fun
+;;; (set-funcallable-instance-function
;;; gf
;;; (lambda (a) ..))
;;; (funcall gf arg))
;;; of all built-in-classes is of the relevant type)
(assert (null (sb-pcl:class-prototype (find-class 'null))))
\f
+;;; simple consistency checks for the SB-PCL (perhaps AKA SB-MOP)
+;;; package: all of the functionality specified in AMOP is in
+;;; functions:
+(assert (null (loop for x being each external-symbol in "SB-PCL"
+ unless (fboundp x) collect x)))
+;;; and all generic functions in SB-PCL have at least one specified
+;;; method, except for UPDATE-DEPENDENT
+(assert (null (loop for x being each external-symbol in "SB-PCL"
+ unless (or (eq x 'sb-pcl:update-dependent)
+ (not (typep (fdefinition x) 'generic-function))
+ (> (length (sb-pcl:generic-function-methods
+ (fdefinition x)))
+ 0))
+ collect x)))
+\f
;;;; success
(sb-ext:quit :unix-status 104)
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.13.pcl-class.4"
+"0.7.13.pcl-class.5"
projects / sbcl.git / commitdiff