[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv24173

Modified Files:
	sequences.lisp 
Log Message:
More substitute madness. Might be decent now. Bring on the ANSI tests!


--- /project/movitz/cvsroot/movitz/losp/muerte/sequences.lisp	2006/03/24 22:22:50	1.30
+++ /project/movitz/cvsroot/movitz/losp/muerte/sequences.lisp	2006/03/25 20:59:16	1.31
@@ -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.30 2006/03/24 22:22:50 ffjeld Exp $
+;;;; $Id: sequences.lisp,v 1.31 2006/03/25 20:59:16 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -1769,12 +1769,10 @@
     (with-funcallable (key)
       (sequence-dispatch sequence
 	(vector
-	 (apply #'nsubstitute-if newitem predicate (copy-seq sequence) args))
+	 (apply 'nsubstitute-if newitem predicate (copy-seq sequence) args))
 	(list
 	 (if from-end
-	     (nreverse (nsubstitute-if newitem predicate (reverse sequence)
-				       :start start :end end
-				       :count count :key key))
+	     (apply 'nsubstitute-if newitem predicate (copy-list sequence) args)
 	   (if (or (null sequence)
 		   (and end (<= end start)))
 	       nil
@@ -1862,11 +1860,17 @@
 		     (return sequence)))))
 	      ((error 'program-error))))))
 	(list
-	 (if from-end
-	     (nreverse (nsubstitute newitem predicate (nreverse sequence)
-				    :start start :end end
-				    :count count :key key))
-	   (let ((p (nthcdr start sequence)))
+	 (let ((p (nthcdr start sequence)))
+	   (if (and from-end count)
+	       (let* ((end (and end (- end start)))
+		      (existing-count (count-if predicate p :key key :end end)))
+		 (do ((i count))
+		     ((>= i existing-count)
+		      (nsubstitute-if newitem predicate p :end end :key key)
+		      sequence)
+		   (when (predicate (key (car p)))
+		     (incf i))
+		   (setf p (cdr p))))
 	     (cond
 	      ((and (not end) (not count))
 	       (do ((p p (cdr p)))
@@ -1896,4 +1900,8 @@
 		   (setf (car p) newitem)
 		   (when (>= (incf c) count)
 		     (return sequence)))))
-	      ((error 'program-error))))))))))
\ No newline at end of file
+	      ((error 'program-error))))))))))
+
+(defun nsubstitute-if-not (newitem predicate sequence &rest keyargs)
+  (declare (dynamic-extent keyargs))
+  (apply #'nsubstitute-if newitem (complement predicate) sequence keyargs))