From c493bb2c2fed02d7cfb08599e6146de43e9a40d6 Mon Sep 17 00:00:00 2001 From: Owen Rodley Date: Sat, 18 May 2013 15:32:14 +1200 Subject: [PATCH] Rewrite POSITION using SATISFIES-TEST-P and add missing export --- src/sequence.lisp | 8 +++++--- src/toplevel.lisp | 18 +++++++++--------- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/sequence.lisp b/src/sequence.lisp index 2fe5108..d7dae46 100644 --- a/src/sequence.lisp +++ b/src/sequence.lisp @@ -48,9 +48,11 @@ (when (funcall predicate x) (return x))))) -(defun position (elt sequence &key (test #'eql)) - (do-sequence (x seq index) - (when (funcall test elt 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 remove (x seq) diff --git a/src/toplevel.lisp b/src/toplevel.lisp index 60e016a..923c302 100644 --- a/src/toplevel.lisp +++ b/src/toplevel.lisp @@ -69,15 +69,15 @@ multiple-value-bind multiple-value-call multiple-value-list multiple-value-prog1 nconc nil ninth not nreconc nth nthcdr null numberp or otherwise package-name package-use-list packagep pairlis - parse-integer plusp pop prin1-to-string print proclaim prog prog1 - prog2 progn psetq push quote rassoc read-from-string remove remove-if - remove-if-not return return-from revappend reverse rplaca rplacd - second set setf setq seventh sixth some string string-upcase string= - string< stringp subseq subst symbol-function symbol-name symbol-package - symbol-plist symbol-value symbolp t tagbody tailp tenth third throw - time trace tree-equal truncate unless untrace unwind-protect values - values-list variable vector-push-extend warn when write-line write-string - zerop)) + parse-integer plusp pop position prin1-to-string print proclaim prog + prog1 prog2 progn psetq push quote rassoc read-from-string remove + remove-if remove-if-not return return-from revappend reverse rplaca + rplacd second set setf setq seventh sixth some string string-upcase + string= string< stringp subseq subst symbol-function symbol-name + symbol-package symbol-plist symbol-value symbolp t tagbody tailp + tenth third throw time trace tree-equal truncate unless untrace + unwind-protect values values-list variable vector-push-extend warn + when write-line write-string zerop)) (setq *package* *user-package*) -- 1.7.10.4