/[flexichain]/flexichain/flexichain.lisp
ViewVC logotype

Diff of /flexichain/flexichain.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by rstrandh, Sun Oct 3 09:29:19 2010 UTC revision 1.10 by rstrandh, Tue Oct 5 05:05:06 2010 UTC
# Line 247  element of the CHAIN." Line 247  element of the CHAIN."
247    
248  (defmethod insert* ((chain standard-flexichain) position object)  (defmethod insert* ((chain standard-flexichain) position object)
249    (with-slots (buffer gap-start) chain    (with-slots (buffer gap-start) chain
250       (assert (<= 0 position (nb-elements chain)) ()      (assert (<= 0 position (nb-elements chain)) ()
251               'flexi-position-error :chain chain :position position)              'flexi-position-error :chain chain :position position)
252       (ensure-gap-position chain position)      (ensure-gap-position chain position)
253       (ensure-room chain (1+ (nb-elements chain)))      (ensure-room chain (1+ (nb-elements chain)))
254       (setf (aref buffer gap-start) object)      (setf (aref buffer gap-start) object)
255       (incf gap-start)      (incf gap-start)
256       (when (= gap-start (length buffer))      (when (= gap-start (length buffer))
257         (setf gap-start 0))))        (setf gap-start 0))))
258    
259  (defmethod insert-vector* ((chain standard-flexichain) position vector)  (defmethod insert-vector* ((chain standard-flexichain) position vector)
260    (with-slots (buffer gap-start) chain    (with-slots (buffer gap-start) chain
261       (assert (<= 0 position (nb-elements chain)) ()      (assert (<= 0 position (nb-elements chain)) ()
262               'flexi-position-error :chain chain :position position)               'flexi-position-error :chain chain :position position)
263       (ensure-gap-position chain position)      (ensure-gap-position chain position)
264       (ensure-room chain (+ (nb-elements chain) (length vector)))      (ensure-room chain (+ (nb-elements chain) (length vector)))
265       (loop for elem across vector      (if (>= (+ gap-start (length vector)) (length buffer))
266          do (setf (aref buffer gap-start) elem)          (progn
267            (incf gap-start)            (replace buffer vector :start1 gap-start :end1 (length buffer))
268            (when (= gap-start (length buffer))            (replace buffer vector
269              (setf gap-start 0)))))                     :start2 (- (length buffer) gap-start))
270              (setf gap-start (- (length vector) (- (length buffer) gap-start))))
271            (progn
272              (replace buffer vector :start1 gap-start :end1 (+ gap-start (length vector)))
273              (incf gap-start (length vector))))))
274    
275  (defmethod delete* ((chain standard-flexichain) position)  (defmethod delete* ((chain standard-flexichain) position)
276    (with-slots (buffer expand-factor min-size fill-element gap-end) chain    (with-slots (buffer expand-factor min-size fill-element gap-end) chain

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

  ViewVC Help
Powered by ViewVC 1.1.5