From: William Harold Newman Date: Sat, 20 Jan 2001 03:30:51 +0000 (+0000) Subject: 0.6.10.3: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=39ecf3129db04ecf861c08459b6f5353bfc266c9;p=sbcl.git 0.6.10.3: DESCRIBE now works on STRUCTURE-OBJECTs again. --- diff --git a/make-target-2.sh b/make-target-2.sh index c03fcaa..35ad0d1 100644 --- a/make-target-2.sh +++ b/make-target-2.sh @@ -47,4 +47,5 @@ echo //doing warm init ;; wanted, it can easily be turned back on.) #+sb-show (setf sb-int:*/show* nil) (sb-ext:save-lisp-and-die "output/sbcl.core" :purify t) + EOF diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index a8b28ee..eaa6513 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -491,6 +491,63 @@ bootstrapping. (declare (ignore proto-gf proto-method)) (make-method-lambda-internal method-lambda env)) +;;; a helper function for creating Python-friendly type declarations +;;; in DEFMETHOD forms +(defun parameter-specializer-declaration-in-defmethod (parameter specializer) + (cond ((and (consp specializer) + (eq (car specializer) 'eql)) + ;; KLUDGE: ANSI, in its wisdom, says that + ;; EQL-SPECIALIZER-FORMs in EQL specializers are evaluated at + ;; DEFMETHOD expansion time. Thus, although one might think + ;; that in + ;; (DEFMETHOD FOO ((X PACKAGE) + ;; (Y (EQL 12)) + ;; ..)) + ;; the PACKAGE and (EQL 12) forms are both parallel type + ;; names, they're not, as is made clear when you do + ;; (DEFMETHOD FOO ((X PACKAGE) + ;; (Y (EQL 'BAR))) + ;; ..) + ;; where Y needs to be a symbol named "BAR", not some cons + ;; made by (CONS 'QUOTE 'BAR). I.e. when the + ;; EQL-SPECIALIZER-FORM is (EQL 'X), it requires an argument + ;; to be of type (EQL X). It'd be easy to transform one to + ;; the other, but it'd be somewhat messier to do so while + ;; ensuring that the EQL-SPECIALIZER-FORM is only EVAL'd + ;; once. (The new code wouldn't be messy, but it'd require a + ;; big transformation of the old code.) So instead we punt. + ;; -- WHN 20000610 + '(ignorable)) + ((member specializer + ;; KLUDGE: For some low-level implementation + ;; classes, perhaps because of some problems related + ;; to the incomplete integration of PCL into SBCL's + ;; type system, some specializer classes can't be + ;; declared as argument types. E.g. + ;; (DEFMETHOD FOO ((X SLOT-OBJECT)) + ;; (DECLARE (TYPE SLOT-OBJECT X)) + ;; ..) + ;; loses when + ;; (DEFSTRUCT BAR A B) + ;; (FOO (MAKE-BAR)) + ;; perhaps because of the way that STRUCTURE-OBJECT + ;; inherits both from SLOT-OBJECT and from + ;; SB-KERNEL:INSTANCE. In an effort to sweep such + ;; problems under the rug, we exclude these problem + ;; cases by blacklisting them here. -- WHN 2001-01-19 + '(slot-object)) + '(ignorable)) + ((not (eq *boot-state* 'complete)) + ;; KLUDGE: PCL, in its wisdom, sometimes calls methods with + ;; types which don't match their specializers. (Specifically, + ;; it calls ENSURE-CLASS-USING-CLASS (T NULL) with a non-NULL + ;; second argument.) Hopefully it only does this kind of + ;; weirdness when bootstrapping.. -- WHN 20000610 + '(ignorable)) + (t + ;; Otherwise, we can make Python very happy. + `(type ,specializer ,parameter)))) + (defun make-method-lambda-internal (method-lambda &optional env) (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda)) (error "The METHOD-LAMBDA argument to MAKE-METHOD-LAMBDA, ~S, ~ @@ -525,57 +582,15 @@ bootstrapping. parameters specializers)) ;; These TYPE declarations weren't in the original - ;; PCL code, but Python likes them a lot. (We're - ;; telling the compiler about our knowledge of - ;; specialized argument types so that it can avoid - ;; run-time type overhead, which can be a big win - ;; for Python.) - ,@(mapcar (lambda (a s) - (cond ((and (consp s) - (eql (car s) 'eql)) - ;; KLUDGE: ANSI, in its wisdom, says - ;; that EQL-SPECIALIZER-FORMs in EQL - ;; specializers are evaluated at - ;; DEFMETHOD expansion time. Thus, - ;; although one might think that in - ;; (DEFMETHOD FOO ((X PACKAGE) - ;; (Y (EQL 12)) - ;; ..)) - ;; the PACKAGE and (EQL 12) forms are - ;; both parallel type names, they're - ;; not, as is made clear when you do - ;; (DEFMETHOD FOO ((X PACKAGE) - ;; (Y (EQL 'BAR))) - ;; ..) - ;; where Y needs to be a symbol - ;; named "BAR", not some cons made by - ;; (CONS 'QUOTE 'BAR). I.e. when - ;; the EQL-SPECIALIZER-FORM is (EQL 'X), - ;; it requires an argument to be of - ;; type (EQL X). It'd be easy to transform - ;; one to the other, but it'd be somewhat - ;; messier to do so while ensuring that - ;; the EQL-SPECIALIZER-FORM is only - ;; EVAL'd once. (The new code wouldn't - ;; be messy, but it'd require a big - ;; transformation of the old code.) - ;; So instead we punt. -- WHN 20000610 - '(ignorable)) - ((not (eq *boot-state* 'complete)) - ;; KLUDGE: PCL, in its wisdom, - ;; sometimes calls methods with - ;; types which don't match their - ;; specializers. (Specifically, it calls - ;; ENSURE-CLASS-USING-CLASS (T NULL) - ;; with a non-NULL second argument.) - ;; Hopefully it only does this kind - ;; of weirdness when bootstrapping.. - ;; -- WHN 20000610 - '(ignorable)) - (t - ;; Otherwise, we can make Python - ;; very happy. - `(type ,s ,a)))) + ;; PCL code, but the Python compiler likes them a + ;; lot. (We're telling the compiler about our + ;; knowledge of specialized argument types so that + ;; it can avoid run-time type dispatch overhead, + ;; which can be a huge win for Python.) + ;; + ;; FIXME: Perhaps these belong in + ;; ADD-METHOD-DECLARATIONS instead of here? + ,@(mapcar #'parameter-specializer-declaration-in-defmethod parameters specializers))) (method-lambda diff --git a/src/pcl/describe.lisp b/src/pcl/describe.lisp index ee403fa..00dd346 100644 --- a/src/pcl/describe.lisp +++ b/src/pcl/describe.lisp @@ -59,25 +59,25 @@ (:class (push slotd class-slotds)) (otherwise (push slotd other-slotds)))) (setq max-slot-name-length (min (+ max-slot-name-length 3) 30)) - (format stream "~%~S is an instance of class ~S." object class) + (format stream "~%~@<~S ~_is an instance of class ~S.~:>" object class) ;; Now that we know the width, we can print. (when instance-slotds - (format stream "~% The following slots have :INSTANCE allocation:") + (format stream "~%The following slots have :INSTANCE allocation:") (dolist (slotd (nreverse instance-slotds)) (describe-slot (slot-definition-name slotd) (slot-value-or-default object (slot-definition-name slotd))))) (when class-slotds - (format stream "~% The following slots have :CLASS allocation:") + (format stream "~%The following slots have :CLASS allocation:") (dolist (slotd (nreverse class-slotds)) (describe-slot (slot-definition-name slotd) (slot-value-or-default object (slot-definition-name slotd))))) (when other-slotds - (format stream "~% The following slots have allocation as shown:") + (format stream "~%The following slots have allocation as shown:") (dolist (slotd (nreverse other-slotds)) (describe-slot (slot-definition-name slotd) diff --git a/version.lisp-expr b/version.lisp-expr index 9768663..cdf8cf4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.10.2" +"0.6.10.3"