From: Christophe R. <cr...@us...> - 2002-10-26 11:00:19
|
Update of /cvsroot/sbcl/sbcl/src/pcl In directory usw-pr-cvs1:/tmp/cvs-serv7439/src/pcl Modified Files: boot.lisp cache.lisp generic-functions.lisp Log Message: 0.7.9.2: Some PCL fixups (again, thanks to Pierre Mai and Gerd Moellmann) ... make some DEFMETHOD/DEFGENERIC mismatches signal PROGRAM-ERROR ... delete an apparently no-op "optimization" ... comment from Gerd Moellmann on COMPUTE-EFFECTIVE-METHOD (arguably this should live in the user manual instead, when said document gains a section on the MOP) Index: boot.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/boot.lisp,v retrieving revision 1.53 retrieving revision 1.54 diff -u -d -r1.53 -r1.54 --- boot.lisp 15 Oct 2002 10:08:03 -0000 1.53 +++ boot.lisp 26 Oct 2002 11:00:10 -0000 1.54 @@ -1594,12 +1594,12 @@ (early-method-lambda-list method) (method-lambda-list method))) (flet ((lose (string &rest args) - (error - "attempt to add the method ~S to the generic function ~S.~%~ - But ~A" - method - gf - (apply #'format nil string args))) + (error 'simple-program-error + :format-control "attempt to add the method ~S ~ + to the generic function ~S.~%~ + But ~A" + :format-arguments (list method gf + (apply #'format nil string args)))) (comparison-description (x y) (if (> x y) "more" "fewer"))) (let ((gf-nreq (arg-info-number-required arg-info)) @@ -1615,8 +1615,8 @@ "the method has ~A optional arguments than the generic function." (comparison-description nopt gf-nopt))) (unless (eq (or keysp restp) gf-key/rest-p) - (error - "The method and generic function differ in whether they accept~%~ + (lose + "the method and generic function differ in whether they accept~%~ &REST or &KEY arguments.")) (when (consp gf-keywords) (unless (or (and restp (not keysp)) Index: cache.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/cache.lisp,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- cache.lisp 3 Oct 2002 02:00:24 -0000 1.24 +++ cache.lisp 26 Oct 2002 11:00:11 -0000 1.25 @@ -1329,24 +1329,3 @@ (otherwise 6))) (defvar *empty-cache* (make-cache)) ; for defstruct slot initial value forms - -;;; Pre-allocate generic function caches. The hope is that this will -;;; put them nicely together in memory, and that that may be a win. Of -;;; course the first GC copy will probably blow that out, this really -;;; wants to be wrapped in something that declares the area static. -;;; -;;; This preallocation only creates about 25% more caches than PCL -;;; itself uses. Some ports may want to preallocate some more of -;;; these. -;;; -;;; KLUDGE: Isn't something very similar going on in precom1.lisp? Do -;;; we need it both here and there? Why? -- WHN 19991203 -(eval-when (:load-toplevel) - (dolist (n-size '((1 513) (3 257) (3 129) (14 128) (6 65) - (2 64) (7 33) (16 32) (16 17) (32 16) - (64 9) (64 8) (6 5) (128 4) (35 2))) - (let ((n (car n-size)) - (size (cadr n-size))) - (mapcar #'free-cache-vector - (mapcar #'get-cache-vector - (make-list n :initial-element size)))))) Index: generic-functions.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/generic-functions.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- generic-functions.lisp 12 Oct 2002 16:02:37 -0000 1.11 +++ generic-functions.lisp 26 Oct 2002 11:00:12 -0000 1.12 @@ -400,6 +400,14 @@ (defgeneric (setf class-slot-value) (nv class slot-name)) +;;; CMUCL comment (from Gerd Moellmann/Pierre Mai, 2002-10-19): +;;; +;;; According to AMOP, COMPUTE-EFFECTIVE-METHOD should return two +;;; values. Alas, the second value is only vaguely described in AMOP, +;;; and, when asked on 2002-10-18, Gregor Kiczales said he couldn't +;;; remember what the second value was supposed to be. So, PCL's +;;; COMPUTE-EFFECTIVE-METHOD returns one value as do Allegro and +;;; Lispworks. (defgeneric compute-effective-method (generic-function combin applicable-methods)) |