diff --git a/code/pred.lisp b/code/pred.lisp index f2dcf91dc0bb82dd9bb401cc0b3ad38763d8eb11..35b3c38b6262e7a6fffc031d9713a66ec6c8ab36 100644 --- a/code/pred.lisp +++ b/code/pred.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.58 2003/04/27 14:52:27 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.59 2003/06/06 12:22:33 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -130,19 +130,29 @@ ;;; (defun type-of (object) "Return the type of OBJECT." - (if (typep object '(or function array complex)) - (type-specifier (ctype-of object)) - (let* ((class (layout-class (layout-of object))) - (name (%class-name class))) - (if (%instancep object) - (case name - (alien-internals:alien-value - `(alien:alien - ,(alien-internals:unparse-alien-type - (alien-internals:alien-value-type object)))) - (t - (class-proper-name class))) - name)))) + (typecase object + ((or array complex) + (type-specifier (ctype-of object))) + (integer + `(integer ,object ,object)) + ((member t) + 'boolean) + (keyword + 'keyword) + (standard-char + 'standard-char) + (t + (let* ((class (layout-class (layout-of object))) + (name (%class-name class))) + (if (%instancep object) + (if (eq name 'alien-internals:alien-value) + `(alien:alien ,(alien-internals:unparse-alien-type + (alien-internals:alien-value-type object))) + (let ((proper-name (class-proper-name class))) + (if (kernel::class-p proper-name) + (%class-pcl-class proper-name) + proper-name))) + name))))) ;;;; UPGRADED-ARRAY-ELEMENT-TYPE -- public diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt index e3e23dcef578f473499dcfb258f3b4ad98c39c19..717325706c40943b15bd626fe61a70fa5986c23d 100644 --- a/general-info/release-19a.txt +++ b/general-info/release-19a.txt @@ -99,6 +99,10 @@ New in this release: - FIND-METHOD signaling an error when called with specializers not corresponding to the number of required arguments of the supplied generic function. + - TYPE-OF returning KEYWORD for keywords, STANDARD-CHAR for + standard characters, BOOLEAN for T, (INTEGER <N> <N>) for + integers N, non-list types for functions, and CLOS classes for + instances whose class doesn't have a proper name. * Numerous bugfixes: - NSET-EXCLUSIVE-OR returns the same results as SET-EXCLUSIVE-OR @@ -117,7 +121,6 @@ New in this release: it now has an extra argument that describes the nature of the error or warning. - * Numerous improvements to the PCL implementation of CLOS: - Gerd's PCL has been added, which fixes numerous bugs and ANSI/ AMOP non-compliances, and adds various new optimizations (also diff --git a/pcl/methods.lisp b/pcl/methods.lisp index aece039e285cdafa57d387592952e8ceafd676eb..a2c42ea6d02b733bfacf03143bba8a654bbf304d 100644 --- a/pcl/methods.lisp +++ b/pcl/methods.lisp @@ -26,7 +26,7 @@ ;;; (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.38 2003/06/05 08:33:45 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.39 2003/06/06 12:22:32 gerd Exp $") (in-package :pcl) @@ -1539,3 +1539,6 @@ (declare (ignore nreq nopt keysp restp)) (values keywords allow-other-keys-p))) +(defmethod (setf class-name) :before (new-name (class class)) + (let ((kernel-class (kernel::find-class (class-name class)))) + (setf (kernel:%class-name kernel-class) new-name)))