From: Christophe Rhodes Date: Fri, 21 Mar 2003 15:31:00 +0000 (+0000) Subject: 0.7.13.pcl-class.5 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8160f3ac81fff66563276cfbc7546d43891dae5c;p=sbcl.git 0.7.13.pcl-class.5 Fix up SB-PCL exports ... go through AMOP and make sure they agree, and add basic consistency check. Aargh, did I say "no regressions"? It looks like the CONDITION-CLASS stuff broke defining classes with STRUCTURE-CLASS as a metaclass :-( Hunting now... --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 3c94145..19dabe4 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1401,17 +1401,10 @@ extensions, but even they are not guaranteed to be present in 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" @@ -1426,6 +1419,7 @@ definitely not guaranteed to be present in later versions of SBCL." "CLASS-SLOTS" "COMPUTE-APPLICABLE-METHODS-USING-CLASSES" "COMPUTE-CLASS-PRECEDENCE-LIST" + "COMPUTE-DEFAULT-INITARGS" "COMPUTE-DISCRIMINATING-FUNCTION" "COMPUTE-EFFECTIVE-METHOD" "COMPUTE-EFFECTIVE-SLOT-DEFINITION" @@ -1435,7 +1429,7 @@ definitely not guaranteed to be present in later versions of SBCL." "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" @@ -1460,7 +1454,7 @@ definitely not guaranteed to be present in later versions of SBCL." "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" @@ -1473,7 +1467,7 @@ definitely not guaranteed to be present in later versions of SBCL." "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" diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index b1ef3f3..562ff1d 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -1773,7 +1773,7 @@ bootstrapping. (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) diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 9a36654..0fd84b3 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -65,7 +65,7 @@ (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)) diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index 70e47da..6846e0a 100644 --- a/src/pcl/dfun.lisp +++ b/src/pcl/dfun.lisp @@ -1545,7 +1545,7 @@ And so, we are saved. (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))) diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index 5007007..871b170 100644 --- a/src/pcl/low.lisp +++ b/src/pcl/low.lisp @@ -97,7 +97,7 @@ (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)) diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index d45670b..3ff601a 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -1345,12 +1345,12 @@ ;;; the funcallable instance function of the generic function for which ;;; it was computed. ;;; -;;; More precisely, if compute-discriminating-function is called with an -;;; argument , and returns a result , that result must not be -;;; passed to apply or funcall directly. Rather, must be stored as -;;; the funcallable instance function of the same generic function -;;; (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 , and returns a result , that result must +;;; not be passed to apply or funcall directly. Rather, must be +;;; stored as the funcallable instance function of the same generic +;;; function (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 @@ -1391,7 +1391,7 @@ ;;; (lambda (arg) ;;; (cond ( ;;; -;;; (set-funcallable-instance-fun +;;; (set-funcallable-instance-function ;;; gf ;;; (compute-discriminating-function gf)) ;;; (funcall gf arg)) @@ -1403,7 +1403,7 @@ ;;; (defmethod compute-discriminating-function ((gf my-generic-function)) ;;; (lambda (arg) ;;; (cond ( -;;; (set-funcallable-instance-fun +;;; (set-funcallable-instance-function ;;; gf ;;; (lambda (a) ..)) ;;; (funcall gf arg)) diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp index f78e6bb..135c330 100644 --- a/tests/mop.impure.lisp +++ b/tests/mop.impure.lisp @@ -111,5 +111,20 @@ ;;; of all built-in-classes is of the relevant type) (assert (null (sb-pcl:class-prototype (find-class 'null)))) +;;; 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))) + ;;;; success (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index ed3eb8a..a9fde45 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; 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"