[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: subtypep questions

	From: Brad Miller - EMD <bmiller%shamash.cdc.com@uunet>

	? (defclass lock () ((name :initarg :name :reader lock-name)))
	#<Standard-Class lock 2638932>
	? (defclass null-lock (lock) ())
	#<Standard-Class null-lock 2673068>
	? (defclass simple-lock (lock) 
		((owner :initform nil :accessor lock-owner)))
	#<Standard-Class simple-lock 2521500>
	? (subtypep 'simple-lock 'lock)

	***  QUESTION NUMBER 1, why does this not return t t as I would expect?

	? (setq *null-lock* 
		(make-instance 'null-lock :name "Null lock"))
	#<null-lock 2533152>
	? (setq *simple-lock* 
		(make-instance 'simple-lock :name "Simple lock"))
	#<simple-lock 2537148>
	? (type-of *null-lock*)

	***  QUESTION NUMBER 2, What is this iwmc-class, and what has happened to
				my null-lock class?

These are not bugs according to the CLtL spec. The second value of
SUBTYPEP is NIL and TYPE-OF returns a representation dependent value,
not the declared type as perceived by the programmer.

Maybe this does what you were looking for (.. cute .. pcl): 

(subclassp 'simple-lock 'lock) =>
	(#<Standard-Class LOCK 147577550> #<Standard-Class OBJECT 144222407>
#<Standard-Class T 144222412>)
(class-name (class-of *null-lock*)) ==> NULL-LOCK

A workaround towards your expections might be

(defmacro *type-of (object)
  `(let ((object ,object))
     (if (typep object 'pcl::iwmc-class)        ; not robust 'cause
IWMC-CLASS is internal 
	 (pcl:class-name (pcl:class-of object))
	 (lisp:type-of object))))

(defmacro *subtypep (type1 type2)
  `(let ((type1 ,type1)
	 (type2 ,type2))
     (if (and (pcl:find-class type1 nil) (pcl:find-class type2 nil))
	 ;; make the guess a certainty where pcl knows better
	 (values (when (pcl:subclassp type1 type2) t) t)
         (lisp:subtypep type1 type2))))


Heinz W. Schmidt				UUCP: hws@gmdzi.UUCP
German National Research Center			Tel:  (++49 2241) 14-2448
for Computer Science (GMD),
Institut fuer Systemtechnik                
Postf. 1240
D-5205 St. Augustin 1, FRG