Skip to content
Snippets Groups Projects
Commit f847c099 authored by gerd's avatar gerd
Browse files

Various problems with TYPE-OF found by Paul Dietz.

	* src/pcl/methods.lisp (setf class-name) <before>: New method
	setting the kernel class' name.

	* src/code/pred.lisp (type-of): Don't return list function types.
	Return boolean for t, (integer n n) for integers, keyword for
	keywords, standard-char for standard characters.  Return
	the CLOS class for classes not having a proper name.
parent 9d611502
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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
......
......@@ -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)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment