Merge pull request jscl-project#224 from PuercoPop/pr-223

Split PR 223 in 3 commits

src/sequence.lisp

@@ -77,35 +77,43 @@
           (return x)))))
 
 (defun position (elt sequence
-                 &key key (test #'eql testp)
+                 &key from-end 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))))
+  (let ((end (or end (length sequence)))
+        (result nil))
     (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)))))
+        (setf result index)
+        (unless from-end
+            (return))))
+    result))
 
-;; TODO: need to support &key from-end
 (defun position-if (predicate sequence
-                 &key key (start 0) end)
+                 &key from-end key (start 0) end)
   ;; TODO: Implement START and END efficiently for all the sequence
   ;; functions.
-  (let ((end (or end (length sequence))))
+  (let ((end (or end (length sequence)))
+        (result nil))
     (do-sequence (x sequence index)
       (when (and (<= start index)
                  (< index end)
                  (funcall predicate (if key (funcall key x) x)))
-        (return index)))))
+        (setf result index)
+        (unless from-end
+          (return))))
+    result))
 
 (defun position-if-not (predicate sequence
-                 &key key (start 0) end)
-  (position-if (complement predicate) sequence :key key :start start :end end))
+                 &key from-end key (start 0) end)
+  (position-if (complement predicate) sequence
+               :from-end from-end :key key :start start :end end))
 
 (defun remove (x seq &key key (test #'eql testp) (test-not #'eql test-not-p))
   (cond

tests/seq.lisp

@@ -36,10 +36,16 @@
 (test (= (position '(1 2) #((1 2) (3 4)) :test #'equal) 0))
 (test (= (position 1 #(1 1 3) :test-not #'=) 2))
 (test (= (position 1 '(1 1 3) :test-not #'=) 2))
+(test (= (position 1 '(1 1 3) :from-end nil) 0))
+(test (= (position 1 '(1 1 3) :from-end t) 1))
+(test (= (position #\a "baobab" :from-end t) 4))
 
 ;; POSITION-IF, POSITION-IF-NOT
 (test (= 2 (position-if #'oddp '((1) (2) (3) (4)) :start 1 :key #'car)))
 (test (= 4 (position-if-not #'integerp '(1 2 3 4 X))))  ;; (hyperspec example used "5.0", but we don't have a full numeric tower yet!)
+(test (= 4 (position-if #'oddp '((1) (2) (3) (4) (5)) :start 1 :key #'car :from-end t)))
+(test (= 4 (position-if-not #'integerp '(1 2 3 4 X Y))))  ;; (hyperspec example used "5.0", but we don't have a full numeric tower yet!)
+(test (= 5 (position-if-not #'integerp '(1 2 3 4 X Y) :from-end t)))
 
 ; REMOVE-IF
 (test (equal (remove-if     #'zerop '(1 0 2 0 3)) '(1 2 3)))