[movitz-cvs] CVS update: movitz/losp/muerte/sequences.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv17089

Modified Files:
	sequences.lisp 
Log Message:
Added two-arguments implementations for find and count-if.

Date: Wed Mar 31 07:17:19 2004
Author: ffjeld

Index: movitz/losp/muerte/sequences.lisp
diff -u movitz/losp/muerte/sequences.lisp:1.5 movitz/losp/muerte/sequences.lisp:1.6
--- movitz/losp/muerte/sequences.lisp:1.5	Sun Feb 29 14:14:59 2004
+++ movitz/losp/muerte/sequences.lisp	Wed Mar 31 07:17:14 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Tue Sep 11 14:19:23 2001
 ;;;;                
-;;;; $Id: sequences.lisp,v 1.5 2004/02/29 19:14:59 ffjeld Exp $
+;;;; $Id: sequences.lisp,v 1.6 2004/03/31 12:17:14 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -775,35 +775,50 @@
       sequence-1)))
 
 (defun find (item sequence &key from-end (test 'eql) (start 0) end (key 'identity))
-  (with-funcallable (test)
-    (with-funcallable (key)
+  (numargs-case
+   (2 (item sequence)
       (sequence-dispatch sequence
 	(vector
-	 (setf end (or end (length sequence)))
-	 (with-subvector-accessor (sequence-ref sequence start end)
-	   (if (not from-end)
-	       (do ((i start (1+ i)))
-		   ((>= i end) nil)
-		 (when (test item (key (aref sequence i)))
-		   (return (sequence-ref i))))
-	     (do ((i (1- end) (1- i)))
-		 ((< i start) nil)
-	       (when (test item (key (sequence-ref i)))
-		 (return (sequence-ref i)))))))
+	 (with-subvector-accessor (sequence-ref sequence)
+	   (dotimes (i (length sequence))
+	     (when (eql item (sequence-ref i))
+	       (return item)))))
 	(list
-	 (if end
-	     (do ((p (nthcdr start sequence) (cdr p))
-		  (i start (1+ i)))
-		 ((or (>= i end) (endp p)) nil)
-	       (when (test item (key (car p)))
-		 (return (or (and from-end
-				  (find item (cdr p) :from-end t :test test :key key :end (- end i 1)))
-			     (car p)))))
-	   (do ((p (nthcdr start sequence) (cdr p)))
-	       ((endp p) nil)
-	     (when (test item (key (car p)))
-	       (return (or (and from-end (find item (cdr p) :from-end t :test test :key key))
-			   (car p)))))))))))
+	 (dolist (x sequence)
+	   (when (eql item x)
+	     (return x))))))
+   (t (item sequence &key from-end (test 'eql) (start 0) end (key 'identity))
+      (with-funcallable (test)
+	(with-funcallable (key)
+	  (sequence-dispatch sequence
+	    (vector
+	     (setf end (or end (length sequence)))
+	     (with-subvector-accessor (sequence-ref sequence start end)
+	       (if (not from-end)
+		   (do ((i start (1+ i)))
+		       ((>= i end) nil)
+		     (when (test item (key (aref sequence i)))
+		       (return (sequence-ref i))))
+		 (do ((i (1- end) (1- i)))
+		     ((< i start) nil)
+		   (when (test item (key (sequence-ref i)))
+		     (return (sequence-ref i)))))))
+	    (list
+	     (if end
+		 (do ((p (nthcdr start sequence) (cdr p))
+		      (i start (1+ i)))
+		     ((or (>= i end) (endp p)) nil)
+		   (when (test item (key (car p)))
+		     (return (or (and from-end
+				      (find item (cdr p)
+					    :from-end t :test test
+					    :key key :end (- end i 1)))
+				 (car p)))))
+	       (do ((p (nthcdr start sequence) (cdr p)))
+		   ((endp p) nil)
+		 (when (test item (key (car p)))
+		   (return (or (and from-end (find item (cdr p) :from-end t :test test :key key))
+			       (car p)))))))))))))
   
 
 (defun find-if (predicate sequence &key from-end (start 0) end (key 'identity))
@@ -897,24 +912,42 @@
 		 (incf n))))))))))
 
 (defun count-if (predicate sequence &key (start 0) end (key 'identity) #+ignore from-end)
-  (with-funcallable (predicate)
-    (with-funcallable (key)
-      (sequence-dispatch sequence
-	(list
-	 (if (not end)
-	     (do ((n 0)
-		  (p (nthcdr start sequence) (cdr p)))
-		 ((endp p) n)
-	       (when (predicate (key (car p)))
-		 (incf n)))
-	   (do ((n 0)
-		(i start (1+ i))
-		(p (nthcdr start sequence) (cdr p)))
-	       ((or (endp p) (>= i end)) n)
-	     (when (predicate (key (car p)))
-	       (incf n)))))
-	(vector
-	 (error "vector count-if not implemented."))))))
+  (numargs-case
+   (2 (predicate sequence)
+      (with-funcallable (predicate)
+	(sequence-dispatch sequence
+	  (list
+	   (let ((count 0))
+	     (dolist (x sequence)
+	       (when (predicate x)
+		 (incf count)))
+	     count))
+	  (vector
+	   (with-subvector-accessor (sequence-ref sequence)
+	     (let ((count 0))
+	       (dotimes (i (length sequence))
+		 (when (predicate (sequence-ref i))
+		   (incf count)))
+	       count))))))
+   (t (predicate sequence &key (start 0) end (key 'identity) #+ignore from-end)
+      (with-funcallable (predicate)
+	(with-funcallable (key)
+	  (sequence-dispatch sequence
+	    (list
+	     (if (not end)
+		 (do ((n 0)
+		      (p (nthcdr start sequence) (cdr p)))
+		     ((endp p) n)
+		   (when (predicate (key (car p)))
+		     (incf n)))
+	       (do ((n 0)
+		    (i start (1+ i))
+		    (p (nthcdr start sequence) (cdr p)))
+		   ((or (endp p) (>= i end)) n)
+		 (when (predicate (key (car p)))
+		   (incf n)))))
+	    (vector
+	     (error "vector count-if not implemented."))))))))
 
 
 (macrolet ((every-some-body ()