Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv5347
Modified Files: storage-types.lisp Log Message: Changed the signature and workings of make-movitz-vector somewhat: Now the element-type argument is an actual (host) type-specifier. The idea is that movitz-read of an array will result in a movitz array with the corresponding element-type.
Date: Wed Jul 21 17:27:22 2004 Author: ffjeld
Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.29 movitz/storage-types.lisp:1.30 --- movitz/storage-types.lisp:1.29 Wed Jul 21 07:15:13 2004 +++ movitz/storage-types.lisp Wed Jul 21 17:27:22 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.29 2004/07/21 14:15:13 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.30 2004/07/22 00:27:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -441,18 +441,30 @@ 8)))
(defun movitz-vector-upgrade-type (type) - (case type - (movitz-unboxed-integer-u8 - (values :u8 0)) - (movitz-unboxed-integer-u32 - (values :u32 0)) - (movitz-character - (values :character #\null)) - (movitz-code - (values :code 0)) - (t (values :any-t nil)))) + (cond + ((eq type 'code) + (values :code 0)) + ((subtypep type '(unsigned-byte 8)) + (values :u8 0)) + ((subtypep type '(unsigned-byte 16)) + (values :u16 0)) + ((subtypep type '(unsigned-byte 32)) + (values :u32 0)) + ((subtypep type 'character) + (values :character #\null)) + (t (values :any-t nil))) + #+ignore (case type + (movitz-unboxed-integer-u8 + (values :u8 0)) + (movitz-unboxed-integer-u32 + (values :u32 0)) + (movitz-character + (values :character #\null)) + (movitz-code + (values :code 0)) + (t (values :any-t nil))))
-(defun make-movitz-vector (size &key (element-type 'movitz-object) +(defun make-movitz-vector (size &key (element-type t) (initial-contents nil) (initial-element *movitz-nil* initial-element-p) (alignment 8) @@ -462,13 +474,13 @@ (assert (or (null initial-contents) (= size (length initial-contents))) (size initial-contents) "The initial-contents must be the same length as SIZE.") - (assert (subtypep element-type 'movitz-object) () - "ELEMENT-TYPE must be a subtype of MOVITZ-OBJECT.") - (assert (or initial-contents - (not initial-element-p) - (typep initial-element element-type)) () - "INITIAL-ELEMENT's type ~A is not of ELEMENT-TYPE ~A." - (type-of initial-element) element-type) +;;; (assert (subtypep element-type 'movitz-object) () +;;; "ELEMENT-TYPE must be a subtype of MOVITZ-OBJECT.") +;;; (assert (or initial-contents +;;; (not initial-element-p) +;;; (typep initial-element element-type)) () +;;; "INITIAL-ELEMENT's type ~A is not of ELEMENT-TYPE ~A." +;;; (type-of initial-element) element-type) (assert (and (>= (log alignment 2) 3) (zerop (rem (log alignment 2) 1))) (alignment) @@ -489,14 +501,17 @@ (make-instance 'movitz-basic-vector :element-type et :num-elements size - :symbolic-data initial-contents ;; sv + :symbolic-data (case et + (:any-t + (map 'vector #'movitz-read initial-contents)) + (t initial-contents)) :fill-pointer (if (integerp fill-pointer) fill-pointer size))))
(defun make-movitz-string (string) (make-movitz-vector (length string) - :element-type 'movitz-character + :element-type 'character :initial-contents (map 'list #'identity string))) ;; (map 'list #'make-movitz-character string)))
@@ -1177,8 +1192,8 @@ bytes))))) (let ((l32 (merge-bytes byte-list 8 32))) (movitz-intern (make-movitz-vector (length l32) - :element-type 'movitz-unboxed-integer-u32 - :initial-contents l32))))) + :element-type '(unsigned-byte 32) + :initial-contents l32)))))
;;; std-instance