make FIND and REPLACE work on vectors as well
authorNikodemus Siivola <nikodemus@random-state.net>
Sun, 28 Apr 2013 13:41:48 +0000 (16:41 +0300)
committerDavid Vázquez <davazp@gmail.com>
Mon, 6 May 2013 13:01:30 +0000 (14:01 +0100)
Conflicts:
src/boot.lisp

src/boot.lisp

index c9e47df..45bf307 100644 (file)
 (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