X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fsequence.lisp;fp=src%2Fsequence.lisp;h=981f5592b58fd3f5a394220cb65ecc04d662a030;hb=fd8bc90cbea141dc226097a8bd7fa71ba55ee481;hp=85d5276f3fe0d362999879dc0493505de625a431;hpb=d76123a32e8d5e5afcf9d0c8f407b731ef34edc5;p=jscl.git diff --git a/src/sequence.lisp b/src/sequence.lisp index 85d5276..981f559 100644 --- a/src/sequence.lisp +++ b/src/sequence.lisp @@ -48,12 +48,20 @@ (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))))) (defun remove (x seq &key key (test #'eql testp) (test-not #'eql test-not-p)) (cond @@ -63,7 +71,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 +80,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 +138,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 +148,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,6 +160,3 @@ ((= j b) new) (aset new i (aref seq j))))) (t (not-seq-error seq)))) - - -