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

[Frode Vatvedt Fjeld]

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

Modified Files:
	read.lisp 
Log Message:
Added bit-vector #* read syntax.

Date: Thu Jul  8 06:38:16 2004
Author: ffjeld

Index: movitz/losp/muerte/read.lisp
diff -u movitz/losp/muerte/read.lisp:1.4 movitz/losp/muerte/read.lisp:1.5
--- movitz/losp/muerte/read.lisp:1.4	Fri Apr 23 08:01:56 2004
+++ movitz/losp/muerte/read.lisp	Thu Jul  8 06:38:15 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Wed Oct 17 21:50:42 2001
 ;;;;                
-;;;; $Id: read.lisp,v 1.4 2004/04/23 15:01:56 ffjeld Exp $
+;;;; $Id: read.lisp,v 1.5 2004/07/08 13:38:15 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -266,6 +266,18 @@
 		     (values (make-array (length contents-list)
 					 :initial-contents contents-list)
 			     form-end
+			     string end)))
+	      (#\* (let* ((token-end (find-token-end string :start (incf i) :end end))
+			  (bit-vector (make-array (- token-end i) :element-type 'bit)))
+		     (do ((p i (1+ p))
+			  (q 0 (1+ q)))
+			 ((>= p token-end))
+		       (case (schar string p)
+			 (#\0 (setf (aref bit-vector q) 0))
+			 (#\1 (setf (aref bit-vector q) 1))
+			 (t (error "Illegal bit-vector element: ~S" (schar string p)))))
+		     (values bit-vector
+			     token-end
 			     string end)))
 	      (#\s (multiple-value-bind (struct-form form-end)
 		       (simple-read-from-string string eof-error-p eof-value :start (1+ i) :end end)