(error 'sequence::protocol-unimplemented
:datum sequence :expected-type '(or list vector)))
+(defgeneric sequence:emptyp (sequence)
+ (:method ((s list)) (null s))
+ (:method ((s vector)) (zerop (length s)))
+ (:method ((s sequence)) (zerop (length s))))
+
(defgeneric sequence:length (sequence)
(:method ((s list)) (length s))
(:method ((s vector)) (length s))
(values iterator limit from-end
#'sequence:iterator-step #'sequence:iterator-endp
#'sequence:iterator-element #'(setf sequence:iterator-element)
- #'sequence:iterator-index #'sequence:iterator-copy))))
+ #'sequence:iterator-index #'sequence:iterator-copy)))
+ (:method ((s t) &key from-end start end)
+ (declare (ignore from-end start end))
+ (error 'type-error
+ :datum s
+ :expected-type 'sequence)))
;;; the simple protocol: the simple iterator returns three values,
;;; STATE, LIMIT and FROM-END.
(defmacro sequence:with-sequence-iterator
((&rest vars) (s &rest args &key from-end start end) &body body)
(declare (ignore from-end start end))
- `(multiple-value-bind (,@vars) (sequence:make-sequence-iterator ,s ,@args)
- (declare (type function ,@(nthcdr 3 vars)))
- ,@body))
+ (let* ((ignored '())
+ (vars (mapcar (lambda (x)
+ (or x (let ((name (gensym)))
+ (push name ignored)
+ name)))
+ vars)))
+ `(multiple-value-bind (,@vars) (sequence:make-sequence-iterator ,s ,@args)
+ (declare (type function ,@(nthcdr 3 vars))
+ (ignore ,@ignored))
+ ,@body)))
(defmacro sequence:with-sequence-iterator-functions
((step endp elt setf index copy)
(,setf (new-value) (funcall ,nsetf new-value ,s ,nstate))
(,index () (funcall ,nindex ,s ,nstate))
(,copy () (funcall ,ncopy ,s ,nstate)))
- (declare (dynamic-extent #',step #',endp #',elt
+ (declare (truly-dynamic-extent #',step #',endp #',elt
#',setf #',index #',copy))
,@body))))
(:argument-precedence-order sequence new old))
(defmethod sequence:substitute (new old (sequence sequence) &rest args &key
(start 0) end from-end test test-not count key)
- (declare (dynamic-extent args))
+ (declare (truly-dynamic-extent args))
(declare (ignore start end from-end test test-not count key))
(let ((result (copy-seq sequence)))
(apply #'sequence:nsubstitute new old result args)))
(:argument-precedence-order sequence new predicate))
(defmethod sequence:substitute-if (new predicate (sequence sequence) &rest args
&key (start 0) end from-end count key)
- (declare (dynamic-extent args))
+ (declare (truly-dynamic-extent args))
(declare (ignore start end from-end count key))
(let ((result (copy-seq sequence)))
(apply #'sequence:nsubstitute-if new predicate result args)))
(defmethod sequence:substitute-if-not
(new predicate (sequence sequence) &rest args &key
(start 0) end from-end count key)
- (declare (dynamic-extent args))
+ (declare (truly-dynamic-extent args))
(declare (ignore start end from-end count key))
(let ((result (copy-seq sequence)))
(apply #'sequence:nsubstitute-if-not new predicate result args)))
(defmethod sequence:search
((sequence1 sequence) (sequence2 sequence) &key from-end (start1 0) end1
(start2 0) end2 test test-not key)
- (let ((test (sequence:canonize-test test test-not))
- (key (sequence:canonize-key key))
- (mainend2 (- (or end2 (length sequence2))
- (- (or end1 (length sequence1)) start1))))
- (when (< mainend2 0)
+ (let* ((test (sequence:canonize-test test test-not))
+ (key (sequence:canonize-key key))
+ (range1 (- (or end1 (length sequence1)) start1))
+ (range2 (- (or end2 (length sequence2)) start2))
+ (count (1+ (- range2 range1))))
+ (when (minusp count)
(return-from sequence:search nil))
- (sequence:with-sequence-iterator (statem limitm from-endm stepm endpm)
- (sequence2 :start start2 :end mainend2 :from-end from-end)
- (do ((s2 (if from-end mainend2 0) (if from-end (1- s2) (1+ s2))))
- (nil)
- (sequence:with-sequence-iterator (state1 limit1 from-end1 step1 endp1 elt1)
- (sequence1 :start start1 :end end1)
- (sequence:with-sequence-iterator (state2 limit2 from-end2 step2 endp2 elt2)
- (sequence2 :start s2)
- (declare (ignore limit2 endp2))
- (when (do ()
- ((funcall endp1 sequence1 state1 limit1 from-end1) t)
- (let ((o1 (funcall key (funcall elt1 sequence1 state1)))
- (o2 (funcall key (funcall elt2 sequence2 state2))))
- (unless (funcall test o1 o2)
- (return nil)))
- (setq state1 (funcall step1 sequence1 state1 from-end1))
- (setq state2 (funcall step2 sequence2 state2 from-end2)))
- (return-from sequence:search s2))))
- (when (funcall endpm sequence2 statem limitm from-endm)
- (return nil))
- (setq statem (funcall stepm sequence2 statem from-endm))))))
+ ;; Create an iteration state for SEQUENCE1 for the interesting
+ ;;range within SEQUENCE1. To compare this range against ranges in
+ ;;SEQUENCE2, we copy START-STATE1 and then mutate the copy.
+ (sequence:with-sequence-iterator (start-state1 nil from-end1 step1 nil elt1)
+ (sequence1 :start start1 :end end1 :from-end from-end)
+ ;; Create an iteration state for the interesting range within
+ ;; SEQUENCE2.
+ (sequence:with-sequence-iterator (start-state2 nil from-end2 step2 nil elt2 nil index2)
+ (sequence2 :start start2 :end end2 :from-end from-end)
+ ;; Copy both iterators at all COUNT possible match positions.
+ (dotimes (i count)
+ (let ((state1 (sequence:iterator-copy sequence1 start-state1))
+ (state2 (sequence:iterator-copy sequence2 start-state2)))
+ ;; Determine whether there is a match at the current
+ ;; position. Return immediately, if there is a match.
+ (dotimes
+ (j range1
+ (return-from sequence:search
+ (let ((position (funcall index2 sequence2 start-state2)))
+ (if from-end (- position range1 -1) position))))
+ (unless (funcall test
+ (funcall key (funcall elt1 sequence1 state1))
+ (funcall key (funcall elt2 sequence2 state2)))
+ (return nil))
+ (setq state1 (funcall step1 sequence1 state1 from-end1))
+ (setq state2 (funcall step2 sequence2 state2 from-end2))))
+ (setq start-state2 (funcall step2 sequence2 start-state2 from-end2)))))))
(defgeneric sequence:delete
(item sequence &key from-end test test-not start end count key)
(replace sequence sequence :start2 end :start1 (- end c)
:end1 (- (length sequence) c))))
(sequence:adjust-sequence sequence (- (length sequence) c))))
- (declare (dynamic-extent #'finish))
+ (declare (truly-dynamic-extent #'finish))
(do ()
((funcall endp2 sequence state2 limit2 from-end2) (finish))
(let ((e (funcall elt2 sequence state2)))
(replace sequence sequence :start2 end :start1 (- end c)
:end1 (- (length sequence) c))))
(sequence:adjust-sequence sequence (- (length sequence) c))))
- (declare (dynamic-extent #'finish))
+ (declare (truly-dynamic-extent #'finish))
(do ()
((funcall endp2 sequence state2 limit2 from-end2) (finish))
(let ((e (funcall elt2 sequence state2)))
(replace sequence sequence :start2 end :start1 (- end c)
:end1 (- (length sequence) c))))
(sequence:adjust-sequence sequence (- (length sequence) c))))
- (declare (dynamic-extent #'finish))
+ (declare (truly-dynamic-extent #'finish))
(do ()
((funcall endp2 sequence state2 limit2 from-end2) (finish))
(let ((e (funcall elt2 sequence state2)))
(:argument-precedence-order sequence item))
(defmethod sequence:remove (item (sequence sequence) &rest args &key
from-end test test-not (start 0) end count key)
- (declare (dynamic-extent args))
+ (declare (truly-dynamic-extent args))
(declare (ignore from-end test test-not start end count key))
(let ((result (copy-seq sequence)))
(apply #'sequence:delete item result args)))
(:argument-precedence-order sequence predicate))
(defmethod sequence:remove-if (predicate (sequence sequence) &rest args &key
from-end (start 0) end count key)
- (declare (dynamic-extent args))
+ (declare (truly-dynamic-extent args))
(declare (ignore from-end start end count key))
(let ((result (copy-seq sequence)))
(apply #'sequence:delete-if predicate result args)))
(:argument-precedence-order sequence predicate))
(defmethod sequence:remove-if-not (predicate (sequence sequence) &rest args
&key from-end (start 0) end count key)
- (declare (dynamic-extent args))
+ (declare (truly-dynamic-extent args))
(declare (ignore from-end start end count key))
(let ((result (copy-seq sequence)))
(apply #'sequence:delete-if-not predicate result args)))
(replace sequence sequence :start2 end :start1 (- end c)
:end1 (- (length sequence) c))))
(sequence:adjust-sequence sequence (- (length sequence) c))))
- (declare (dynamic-extent #'finish))
+ (declare (truly-dynamic-extent #'finish))
(do ((end (or end (length sequence)))
(step 0 (1+ step)))
((funcall endp2 sequence state2 limit2 from-end2) (finish))
(sequence &key from-end test test-not start end key))
(defmethod sequence:remove-duplicates
((sequence sequence) &rest args &key from-end test test-not (start 0) end key)
- (declare (dynamic-extent args))
+ (declare (truly-dynamic-extent args))
(declare (ignore from-end test test-not start end key))
(let ((result (copy-seq sequence)))
(apply #'sequence:delete-duplicates result args)))
(defgeneric sequence:sort (sequence predicate &key key))
(defmethod sequence:sort ((sequence sequence) predicate &rest args &key key)
- (declare (dynamic-extent args))
+ (declare (truly-dynamic-extent args))
(declare (ignore key))
(let* ((length (length sequence))
(vector (make-array length)))
(defgeneric sequence:stable-sort (sequence predicate &key key))
(defmethod sequence:stable-sort
((sequence sequence) predicate &rest args &key key)
- (declare (dynamic-extent args))
+ (declare (truly-dynamic-extent args))
(declare (ignore key))
(let* ((length (length sequence))
(vector (make-array length)))