[movitz-cvs] CVS update: movitz/losp/muerte/typep.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv24694

Modified Files:
	typep.lisp 
Log Message:
Added bit-vector for typep, and some type-predicate-functions.

Date: Thu Jul  8 08:28:12 2004
Author: ffjeld

Index: movitz/losp/muerte/typep.lisp
diff -u movitz/losp/muerte/typep.lisp:1.22 movitz/losp/muerte/typep.lisp:1.23
--- movitz/losp/muerte/typep.lisp:1.22	Thu Jul  8 04:30:41 2004
+++ movitz/losp/muerte/typep.lisp	Thu Jul  8 08:28:12 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Dec  8 11:07:53 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: typep.lisp,v 1.22 2004/07/08 11:30:41 ffjeld Exp $
+;;;; $Id: typep.lisp,v 1.23 2004/07/08 15:28:12 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -242,6 +242,8 @@
 		 (make-basic-vector-typep :any-t))
 		((string simple-string)
 		 (make-basic-vector-typep :character))
+		((bit-vector simple-bit-vector)
+		 (make-basic-vector-typep :bit))
 		(vector-u8
 		 (make-basic-vector-typep :u8))
 		(vector-u16
@@ -268,6 +270,10 @@
 		       (cond
 			((movitz:movitz-subtypep et '(unsigned-byte 8))
 			 (make-basic-vector-typep :u8))
+			((movitz:movitz-subtypep et '(unsigned-byte 32))
+			 (make-basic-vector-typep :u32))
+			((movitz:movitz-subtypep et 'character)
+			 (make-basic-vector-typep :character))
 			(t (make-basic-vector-typep :any-t)))))
 		    ((integer)
 		     (destructuring-bind (&optional (lower-limit '*) (upper-limit '*))
@@ -482,6 +488,15 @@
 (define-simple-typep (vector vectorp) (obj)
   (typep obj 'vector))
 
+(define-simple-typep (simple-vector simple-vector-p) (obj)
+  (typep obj 'simple-vector))
+
+(define-simple-typep (simple-string simple-string-p) (obj)
+  (typep obj 'simple-string))
+
+(define-simple-typep (simple-bit-vector simple-bit-vector-p) (obj)
+  (typep obj 'simple-bit-vector))
+
 (define-simple-typep (pointer pointerp) (obj)
   (typep obj 'pointer))
 
@@ -489,7 +504,6 @@
   (and (typep x 'cons)
        (or (eq '* car) (typep (car x) car))
        (or (eq '* cdr) (typep (cdr x) cdr))))
-
 
 (define-simple-typep (atom atom) (x)
   (typep x 'atom))