From 9ccd7f941c7309c66701f377cbc2e23ebbdf4dd5 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 28 Apr 2013 16:41:48 +0300 Subject: [PATCH] make FIND and REPLACE work on vectors as well Conflicts: src/boot.lisp --- src/boot.lisp | 57 +++++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 49 insertions(+), 8 deletions(-) diff --git a/src/boot.lisp b/src/boot.lisp index c9e47df..45bf307 100644 --- a/src/boot.lisp +++ b/src/boot.lisp @@ -381,17 +381,58 @@ (defun plusp (x) (< 0 x)) (defun minusp (x) (< x 0)) -(defun atom (x) - (not (consp x))) - -(defun remove (x list) +(defmacro doseq ((elt seq &optional index) &body body) + (let* ((nseq (gensym "seq")) + (i (or index (gensym "i"))) + (list-body (if index + `(let ((,i -1)) + (dolist (,elt ,nseq) + (incf ,i) + ,@body)) + `(dolist (,elt ,nseq) + ,@body)))) + `(let ((,nseq ,seq)) + (if (listp ,nseq) + ,list-body + (dotimes (,i (length ,nseq)) + (let ((,elt (aref ,nseq ,i))) + ,@body)))))) + +(defun find (item seq &key key (test #'eql)) + (if key + (doseq (x seq) + (when (funcall test (funcall key x) item) + (return x))) + (doseq (x seq) + (when (funcall test x item) + (return x))))) + +(defun remove (x seq) (cond - ((null list) + ((null seq) nil) - ((eql x (car list)) - (remove x (cdr list))) + ((listp seq) + (let* ((head (cons nil nil)) + (tail head)) + (doseq (elt seq) + (unless (eql x elt) + (let ((new (list elt))) + (rplacd tail new) + (setq tail new)))) + (cdr head))) (t - (cons (car list) (remove x (cdr list)))))) + (let (vector) + (doseq (elt seq index) + (if (eql x elt) + ;; Copy the beginning of the vector only when we find an element + ;; that does not match. + (unless vector + (setq vector (make-array 0)) + (dotimes (i index) + (vector-push-extend (aref seq i) vector))) + (when vector + (vector-push-extend elt vector)))) + (or vector seq))))) (defun remove-if (func list) (cond -- 1.7.10.4