[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-serv26915

Modified Files:
	typep.lisp 
Log Message:
Cleaning up some minor stuff after the migration to the new
vectors. Also, inform typep that basic-vector corresponds to
simple-arrays.

Date: Thu Jul  8 04:30:41 2004
Author: ffjeld

Index: movitz/losp/muerte/typep.lisp
diff -u movitz/losp/muerte/typep.lisp:1.21 movitz/losp/muerte/typep.lisp:1.22
--- movitz/losp/muerte/typep.lisp:1.21	Wed Jul  7 10:37:34 2004
+++ movitz/losp/muerte/typep.lisp	Thu Jul  8 04:30:41 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.21 2004/07/07 17:37:34 ffjeld Exp $
+;;;; $Id: typep.lisp,v 1.22 2004/07/08 11:30:41 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -234,12 +234,13 @@
 		((function compiled-function)
 		 (make-other-typep :funobj))
 		((basic-vector)
+		 (break "Basic-vector typep?")
+		 (make-other-typep :basic-vector))
+		((vector simple-array array)
 		 (make-other-typep :basic-vector))
-		((vector array)
-		 `(typep ,object 'basic-vector))
 		(simple-vector
 		 (make-basic-vector-typep :any-t))
-		(string
+		((string simple-string)
 		 (make-basic-vector-typep :character))
 		(vector-u8
 		 (make-basic-vector-typep :u8))
@@ -262,6 +263,12 @@
 		(if deriver-function
 		    `(typep ,object ',(apply deriver-function (cdr type)))
 		  (case (car type)
+		    ((simple-array)
+		     (let ((et (cadr type)))
+		       (cond
+			((movitz:movitz-subtypep et '(unsigned-byte 8))
+			 (make-basic-vector-typep :u8))
+			(t (make-basic-vector-typep :any-t)))))
 		    ((integer)
 		     (destructuring-bind (&optional (lower-limit '*) (upper-limit '*))
 			 (cdr type)
@@ -383,7 +390,7 @@
 
 #+ignore
 (defun foo (x)
-  (typep x '(cons * symbol)))
+  (typep x '(simple-array (unsigned-byte 4))))
 
 (defmacro define-typep (tname lambda &body body)
   (let ((fname (format nil "~A-~A" 'typep tname)))