X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fsequence.lisp;h=cda0b411dfb489547718835272fc9d2ea54cb898;hb=227c815341a7956c3bfff6b93f406c0d7b8cefb7;hp=7e96df080b88b646e0e2b6823713b1686ffa487b;hpb=5dafe038d2ba676341b824c55e3f6bad16411c1a;p=jscl.git diff --git a/src/sequence.lisp b/src/sequence.lisp index 7e96df0..cda0b41 100644 --- a/src/sequence.lisp +++ b/src/sequence.lisp @@ -48,12 +48,36 @@ (when (funcall predicate x) (return x))))) -(defun position (elt sequence &key key (test #'eql testp) - (test-not #'eql test-not-p)) - (do-sequence (x sequence index) - (when (satisfies-test-p elt x :key key :test test :testp testp - :test-not test-not :test-not-p test-not-p ) - (return index)))) +(defun position (elt sequence + &key key (test #'eql testp) + (test-not #'eql test-not-p) + (start 0) end) + ;; TODO: Implement START and END efficiently for all the sequence + ;; functions. + (let ((end (or end (length sequence)))) + (do-sequence (x sequence index) + (when (and (<= start index) + (< index end) + (satisfies-test-p elt x + :key key :test test :testp testp + :test-not test-not :test-not-p test-not-p)) + (return index))))) + +;; TODO: need to support &key from-end +(defun position-if (predicate sequence + &key key (start 0) end) + ;; TODO: Implement START and END efficiently for all the sequence + ;; functions. + (let ((end (or end (length sequence)))) + (do-sequence (x sequence index) + (when (and (<= start index) + (< index end) + (funcall predicate (if key (funcall key x) x))) + (return index))))) + +(defun position-if-not (predicate sequence + &key key (start 0) end) + (position-if (complement predicate) sequence :key key :start start :end end)) (defun remove (x seq &key key (test #'eql testp) (test-not #'eql test-not-p)) (cond @@ -63,7 +87,7 @@ (let* ((head (cons nil nil)) (tail head)) (do-sequence (elt seq) - (unless (satisfies-test-p x elt :key key :test test :testp testp + (unless (satisfies-test-p x elt :key key :test test :testp testp :test-not test-not :test-not-p test-not-p) (let ((new (list elt))) (rplacd tail new) @@ -72,7 +96,7 @@ (t (let (vector) (do-sequence (elt seq index) - (if (satisfies-test-p x elt :key key :test test :testp testp + (if (satisfies-test-p x elt :key key :test test :testp testp :test-not test-not :test-not-p test-not-p) ;; Copy the beginning of the vector only when we find an element ;; that does not match. @@ -130,7 +154,7 @@ (if b (let ((diff (- b a))) (cond - ((zerop diff) ()) + ((zerop diff) ()) ((minusp diff) (error "Start index must be smaller than end index")) (t @@ -140,7 +164,7 @@ (setq pointer (cdr pointer)) (when (null pointer) (error "Ending index larger than length of list"))) - (rplacd pointer ()) + (rplacd pointer ()) drop-a)))) (copy-list (nthcdr a seq)))) ((vectorp seq) @@ -152,3 +176,6 @@ ((= j b) new) (aset new i (aref seq j))))) (t (not-seq-error seq)))) + +(defun copy-seq (sequence) + (subseq sequence 0))