Fixed max/min functions.
[jscl.git] / src / sequence.lisp
index 85d5276..cda0b41 100644 (file)
         (when (funcall predicate x)
           (return x)))))
 
         (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
 
 (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)
      (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)
                                    :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)
     (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.
                                :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.
      (if b
        (let ((diff (- b a)))
          (cond
      (if b
        (let ((diff (- b a)))
          (cond
-           ((zerop  diff) ()) 
+           ((zerop  diff) ())
            ((minusp diff)
             (error "Start index must be smaller than end index"))
            (t
            ((minusp diff)
             (error "Start index must be smaller than end index"))
            (t
                 (setq pointer (cdr pointer))
                 (when (null pointer)
                   (error "Ending index larger than length of list")))
                 (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)
               drop-a))))
        (copy-list (nthcdr a seq))))
     ((vectorp seq)
          (aset new i (aref seq j)))))
     (t (not-seq-error seq))))
 
          (aset new i (aref seq j)))))
     (t (not-seq-error seq))))
 
-
-
+(defun copy-seq (sequence)
+  (subseq sequence 0))