[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Wed Apr 21 15:07:28 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv12850
Modified Files:
los-closette.lisp
Log Message:
Added class illegal-object.
Date: Wed Apr 21 11:07:27 2004
Author: ffjeld
Index: movitz/losp/muerte/los-closette.lisp
diff -u movitz/losp/muerte/los-closette.lisp:1.9 movitz/losp/muerte/los-closette.lisp:1.10
--- movitz/losp/muerte/los-closette.lisp:1.9 Mon Apr 19 18:38:27 2004
+++ movitz/losp/muerte/los-closette.lisp Wed Apr 21 11:07:27 2004
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Tue Jul 23 14:29:10 2002
;;;;
-;;;; $Id: los-closette.lisp,v 1.9 2004/04/19 22:38:27 ffjeld Exp $
+;;;; $Id: los-closette.lisp,v 1.10 2004/04/21 15:07:27 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -227,44 +227,12 @@
(defun class-of (object)
(class-of object)) ; compiler-macro
-#+ignore
-(defun class-of (object)
- (typecase object
- (std-instance
- (movitz-accessor object movitz-std-instance class))
- (standard-gf-instance
- (movitz-accessor object movitz-funobj-standard-gf standard-gf-class))
- (null
- (find-class 'null))
- (cons
- (find-class 'cons))
- (symbol
- (find-class 'symbol))
- (fixnum
- (find-class 'fixnum))
- (vector
- (find-class 'vector))
- (compiled-function
- (find-class 'function))
- (hash-table
- (find-class 'hash-table))
- (package
- (find-class 'package))
- (structure-object
- (find-class 'structure-object))
- (t (warn "Don't know the class of ~Z!" object)
- (find-class t))))
-
(defun subclassp (c1 c2)
(not (null (find c2 (class-precedence-list c1)))))
;;;
-;;;
-;;;
-;;;
-;;;
-;;;
;;; Generic function stuff
+;;;
;;; Several tedious functions for analyzing lambda lists
@@ -1025,6 +993,8 @@
(defclass float (real) () (:metaclass built-in-class))
(defclass complex (number) () (:metaclass built-in-class))
+(defclass illegal-object (t) () (:metaclass built-in-class))
+
(defclass run-time-context (t)
()
(:metaclass built-in-class)
@@ -1144,7 +1114,7 @@
(declare (dynamic-extent init-args))
(let ((class (if (symbolp class) (find-class class nil) class)))
(check-type class structure-class)
- (let* ((slots (structure-slots class))
+ (let* ((slots (class-slots class))
(num-slots (length slots))
(struct (malloc-words num-slots)))
(setf (memref struct #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name)
@@ -1717,6 +1687,10 @@
(defmethod print-object ((x run-time-context) stream)
(print-unreadable-object (x stream :type t :identity t)
(format stream " ~S" (%run-time-context-slot 'name x)))
+ x)
+
+(defmethod print-object ((x illegal-object) stream)
+ (print-unreadable-object (x stream :type t :identity t))
x)
;;;
More information about the Movitz-cvs
mailing list