mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-16 06:12:25 -08:00
Code Issues Projects Releases Packages Wiki Activity

Reimplemented REMOVE using specialized vector and list operations.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-21 21:05:22 +02:00
parent fa30623000
commit 61b86312e4
6 changed files with 139 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

41
src/lsp/arraylib.lsp
View file

@ -390,25 +390,22 @@ adjustable array."
))
;;; Copied from cmuci-compat.lisp of CLSQL by Kevin M. Rosenberg (LLGPL-licensed)
(defmacro shrink-vector (vec len)
"Shrinks a vector. Optimized if vector has a fill pointer.
Needs to be a macro to overwrite value of VEC."
(let ((new-vec (gensym)))
`(cond
((adjustable-array-p ,vec)
(adjust-array ,vec ,len))
((typep ,vec 'simple-array)
(let ((,new-vec (make-array ,len :element-type
(array-element-type ,vec))))
(check-type ,len fixnum)
(locally (declare (optimize (speed 3) (safety 0) (space 0)) )
(dotimes (i ,len)
(declare (fixnum i))
(setf (aref ,new-vec i) (aref ,vec i))))
(setq ,vec ,new-vec)))
((typep ,vec 'vector)
(setf (fill-pointer ,vec) ,len)
,vec)
(t
(error "Unable to shrink vector ~S which is type-of ~S" ,vec (type-of ,vec)))
)))
(defun shrink-vector (vec len)
"Shrinks a vector."
(cond ((adjustable-array-p vec)
(adjust-array vec len))
((typep vec 'simple-array)
(let ((new-vec (make-array len :element-type
(array-element-type vec))))
(check-type len fixnum)
(locally (declare (optimize (speed 3) (safety 0) (space 0)) )
(dotimes (i len)
(declare (fixnum i))
(setf (aref new-vec i) (aref vec i))))
new-vec))
((typep vec 'vector)
(setf (fill-pointer vec) len)
vec)
(t
(error "Unable to shrink vector ~S which is type-of ~S" vec (type-of vec)))
))