Update of /project/flexichain/cvsroot/flexichain In directory clnet:/tmp/cvs-serv25155

Modified Files: flexichain.lisp Log Message:

* typep -> subtypep in array element type check * add new standard-flexichain initargs :initial-nb-elements and initial element. This allows for non-consing construction of flexichains filled with a given element, in addition to the old way of using :initial-contents.

Date: Fri Nov 3 18:24:09 2006 Author: charmon

Index: flexichain/flexichain.lisp diff -u flexichain/flexichain.lisp:1.2 flexichain/flexichain.lisp:1.3 --- flexichain/flexichain.lisp:1.2 Tue Oct 17 12:02:02 2006 +++ flexichain/flexichain.lisp Fri Nov 3 18:24:09 2006 @@ -154,7 +154,10 @@

(defmethod initialize-instance :after ((chain standard-flexichain) &rest initargs - &key initial-contents) + &key + initial-contents + (initial-nb-elements 0) + (initial-element nil)) (declare (ignore initargs)) ;; Check initial-contents if provided (unless (null initial-contents) @@ -169,22 +172,32 @@ offending-element element-type))))) ;; Initialize slots (with-slots (element-type fill-element buffer) chain - (let* ((data-length (length initial-contents)) + (let* ((data-length (if (> (length initial-contents) initial-nb-elements) + (length initial-contents) + initial-nb-elements)) (size (required-space chain data-length)) (fill-size (- size data-length 2)) (sentinel-list (make-list 2 :initial-element fill-element)) (fill-list (make-list fill-size :initial-element fill-element))) (setf buffer - (make-array size - :element-type element-type - :initial-contents (concatenate 'list - sentinel-list - initial-contents - fill-list))))) - (with-slots (gap-start gap-end data-start) chain - (setf gap-start (+ 2 (length initial-contents)) - gap-end 0 - data-start 1))) + (if initial-contents + (make-array size + :element-type element-type + :initial-contents (concatenate 'list + sentinel-list + initial-contents + fill-list)) + (let ((arr (make-array size + :element-type element-type + :initial-element initial-element))) + (fill arr fill-element :end (length sentinel-list)) + (fill arr fill-element + :start (+ (length sentinel-list) initial-nb-elements) + :end size)))) + (with-slots (gap-start gap-end data-start) chain + (setf gap-start (+ 2 data-length) + gap-end 0 + data-start 1)))))

(defmacro with-virtual-gap ((bl ds gs ge) chain &body body) (let ((c (gensym))) @@ -252,7 +265,7 @@ (with-slots (element-type buffer gap-start) chain (assert (<= 0 position (nb-elements chain)) () 'flexi-position-error :chain chain :position position) - (assert (typep (array-element-type vector) element-type) () + (assert (subtypep (array-element-type vector) element-type) () 'flexi-incompatible-type-error :element vector :chain chain) (ensure-gap-position chain position) (ensure-room chain (+ (nb-elements chain) (length vector)))