From fd8bc90cbea141dc226097a8bd7fa71ba55ee481 Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Fri, 7 Jun 2013 12:27:49 +0100 Subject: [PATCH] Fix long oget chaining adding :START and :END parameters to POSITION --- src/read.lisp | 4 ++-- src/sequence.lisp | 31 ++++++++++++++++++------------- 2 files changed, 20 insertions(+), 15 deletions(-) diff --git a/src/read.lisp b/src/read.lisp index 1d057bd..59838d7 100644 --- a/src/read.lisp +++ b/src/read.lisp @@ -253,8 +253,8 @@ (let ((descriptor (subseq (read-until stream #'terminalp) 1)) (subdescriptors nil)) (do* ((start 0 (1+ end)) - (end (position #\: (subseq descriptor start)) - (position #\: (subseq descriptor start)))) + (end (position #\: descriptor :start start) + (position #\: descriptor :start start))) ((null end) (push (subseq descriptor start) subdescriptors) `(oget *root* ,@(reverse subdescriptors))) 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)))) - - - -- 1.7.10.4