Remove old FIND

[jscl.git] / src / boot.lisp

diff --git a/src/boot.lisp b/src/boot.lisp
index ccb6f9b..a6b08a9 100644 (file)
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -163,28 +163,35 @@
          ,result))))
 
 (defmacro cond (&rest clausules)
-  (if (null clausules)
-    nil
-    (if (eq (caar clausules) t)
-      `(progn ,@(cdar clausules))
-      (let ((test-symbol (gensym)))
-        `(let ((,test-symbol ,(caar clausules)))
-           (if ,test-symbol
-             ,(if (null (cdar clausules))
-                test-symbol
-                `(progn ,@(cdar clausules)))
-             (cond ,@(cdr clausules))))))))
+  (unless (null clausules)
+    (destructuring-bind (condition &body body)
+        (first clausules)
+      (cond
+        ((eq condition t)
+         `(progn ,@body))
+        ((null body)
+         (let ((test-symbol (gensym)))
+           `(let ((,test-symbol ,condition))
+              (if ,test-symbol
+                  ,test-symbol
+                  (cond ,@(rest clausules))))))
+        (t
+         `(if ,condition
+              (progn ,@body)
+              (cond ,@(rest clausules))))))))
 
 (defmacro case (form &rest clausules)
   (let ((!form (gensym)))
     `(let ((,!form ,form))
        (cond
          ,@(mapcar (lambda (clausule)
-                     (if (or (eq (car clausule) t)
-                             (eq (car clausule) 'otherwise))
-                         `(t ,@(cdr clausule))
-                         `((eql ,!form ',(car clausule))
-                           ,@(cdr clausule))))
+                     (destructuring-bind (keys &body body)
+                         clausule
+                       (if (or (eq keys 't) (eq keys 'otherwise))
+                           `(t nil ,@body)
+                           (let ((keys (if (listp keys) keys (list keys))))
+                             `((or ,@(mapcar (lambda (key) `(eql ,!form ',key)) keys))
+                               nil ,@body)))))
                    clausules)))))
 
 (defmacro ecase (form &rest clausules)
@@ -377,14 +384,58 @@
 (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
@@ -442,10 +493,10 @@
          (t
           (error "type-error!"))))))
 
-(defun find (item sequence &key (key #'identity) (test #'eql))
-  (do-sequence (x sequence)
-    (when (funcall test (funcall key x) item)
-      (return x))))
+;; (defun find (item sequence &key (key #'identity) (test #'eql))
+;;   (do-sequence (x sequence)
+;;     (when (funcall test (funcall key x) item)
+;;       (return x))))
 
 (defun find-if (predicate sequence &key (key #'identity))
   (do-sequence (x sequence)