Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11770
Modified Files: sequences.lisp Log Message: Applied (declare (type index)) some more.
Date: Mon Aug 22 19:03:00 2005 Author: ffjeld
Index: movitz/losp/muerte/sequences.lisp diff -u movitz/losp/muerte/sequences.lisp:1.23 movitz/losp/muerte/sequences.lisp:1.24 --- movitz/losp/muerte/sequences.lisp:1.23 Sun Aug 21 19:59:16 2005 +++ movitz/losp/muerte/sequences.lisp Mon Aug 22 19:03:00 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Tue Sep 11 14:19:23 2001 ;;;; -;;;; $Id: sequences.lisp,v 1.23 2005/08/21 17:59:16 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.24 2005/08/22 17:03:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -80,7 +80,8 @@ (defun length%list (sequence) (do ((length 0 (1+ length)) (x sequence (cdr x))) - ((null x) length))) + ((null x) length) + (declare (type index length))))
(defun elt (sequence index) (sequence-dispatch sequence @@ -146,7 +147,8 @@ (funcall-function result (key (pop list))))) ((or (null list) (= end counter)) - result))) + result) + (declare (index counter)))) (vector (with-subvector-accessor (sequence-ref sequence start end) (do* ((index start) @@ -155,7 +157,8 @@ (key (sequence-ref (prog1 index (incf index))))) (key (sequence-ref (prog1 index (incf index))))) (funcall-function result (sequence-ref (prog1 index (incf index)))))) - ((= index end) result)))))))))))) + ((= index end) result) + (declare (index index)))))))))))))
(defun subseq (sequence start &optional end) (sequence-dispatch sequence @@ -205,11 +208,13 @@ (do ((end (length sequence)) (i 0 (1+ i))) ((>= i end)) + (declare (index i end)) (when (eql (sequence-ref i) item) (return i))))) (list (do ((i 0 (1+ i))) ((null sequence) nil) + (declare (index i)) (when (eql (pop sequence) item) (return i)))))) (t (item sequence &key from-end (test #'eql) test-not (start 0) end (key 'identity)) @@ -224,10 +229,12 @@ ((not from-end) (do ((i start (1+ i))) ((>= i end)) + (declare (index i)) (when (test (key (sequence-ref i)) item) (return i)))) (t (do ((i (1- end) (1- i))) ((< i start)) + (declare (index i)) (when (test (key (sequence-ref i)) item) (return i))))))) (list @@ -245,6 +252,7 @@ (t (do ((p (nthcdr start sequence)) (i start (1+ i))) ((or (null p) (>= i end)) nil) + (declare (index i)) (when (test (key (pop p)) item) (return (if (not from-end) i (let ((next-i (position item p :end (- end 1 i) :from-end t @@ -261,12 +269,14 @@ (do ((end (length sequence)) (i 0 (1+ i))) ((>= i end)) + (declare (index i end)) (when (predicate (sequence-ref i)) (return i))))) (list (do ((p sequence) (i 0 (1+ i))) ((null p)) + (declare (index i)) (when (predicate (pop p)) (return i))))))) (t (predicate sequence &key (start 0) end (key 'identity) from-end) @@ -322,6 +332,7 @@ (do ((i 0 (1+ i)) (j (1- (length sequence)) (1- j))) ((<= j i)) + (declare (index i j)) (let ((x (sequence-ref i))) (setf (sequence-ref i) (sequence-ref j) (sequence-ref j) x)))) @@ -356,19 +367,19 @@ (do* ((i start1 (1+ i)) (j start2 (1+ j))) ((>= i end1) nil) - (declare (type (unsigned-byte 16) i j start1 end1 start2 end2)) + (declare (index i j)) (test-return i j))) ((< length1 length2) (do* ((i start1 (1+ i)) (j start2 (1+ j))) ((>= i end1) end1) - (declare ((unsigned-byte 16) i j start1 end1 start2 end2)) + (declare (index i j)) (test-return i j))) ((> length1 length2) (do* ((i start1 (1+ i)) (j start2 (1+ j))) ((>= j end2) i) - (declare ((unsigned-byte 16) i j start1 end1 start2 end2)) + (declare (index i j)) (test-return i j)))))))) (list (let ((length1 (- end1 start1)) @@ -380,23 +391,27 @@ (do ((i1 start1 (1+ i1)) (p2 start-cons2 (cdr p2))) ((>= i1 end1) (if (null p2) nil i1)) + (declare (index i1)) (unless (and p2 (eql (seq1-ref i1) (car p2))) (return i1)))) ((< length1 (- end2 start2)) (do ((i1 start1 (1+ i1)) (p2 start-cons2 (cdr p2))) ((>= i1 end1) end1) + (declare (index i1)) (unless (eql (seq1-ref i1) (car p2)) (return i1)))) ((> length1 (- end2 start2)) (do ((i1 start1 (1+ i1)) (p2 start-cons2 (cdr p2))) ((null p2) end1) + (declare (index i1)) (unless (eql (seq1-ref i1) (car p2)) (return i1)))) (t (do ((i1 start1 (1+ i1)) (p2 start-cons2 (cdr p2))) ((null p2) nil) + (declare (index i1)) (unless (eql (seq1-ref i1) (car p2)) (return i1)))))))))) (list @@ -416,6 +431,7 @@ (p2 start-cons2 (cdr p2)) (i1 start1 (1+ i1))) ((null p1) (if (null p2) nil i1)) + (declare (index i1)) (unless (and p2 (eql (car p1) (car p2))) (return i1)))) (t (do ((p1 start-cons1 (cdr p1)) @@ -424,6 +440,7 @@ (i2 start2 (1+ i2))) ((if end1 (>= i1 end1) (null p1)) (if (if end2 (>= i2 end2) (null p2)) nil i1)) + (declare (index i1 i2)) (unless (and (or (not end2) (< i1 end2)) (eql (car p1) (car p2))) (return i1))))))))))) @@ -456,29 +473,29 @@ (with-subvector-accessor (sequence-1-ref sequence-1 start1 end1) (sequence-dispatch sequence-2 (vector - (unless end2 (setf end2 (length sequence-2))) - (with-subvector-accessor (sequence-2-ref sequence-2 start2 end2) - (macrolet ((test-return (index1 index2) - `(unless (test (key (sequence-1-ref ,index1)) - (key (sequence-2-ref ,index2))) - (return-from mismatch ,index1)))) - (let ((length1 (- end1 start1)) - (length2 (- end2 start2))) - (cond - ((< length1 length2) - (dotimes (i length1) - (declare ((unsigned-byte 16) i start1 start2)) - (test-return (+ start1 i) (+ start2 i))) - end1) - ((> length1 length2) - (dotimes (i length2) - (declare ((unsigned-byte 16) i start1 start2)) - (test-return (+ start1 i) (+ start2 i))) - (+ start1 length2)) - (t (dotimes (i length1) - (declare ((unsigned-byte 16) i start1 start2)) + (let ((end2 (check-the index (or end2 (length sequence-2))))) + (with-subvector-accessor (sequence-2-ref sequence-2 start2 end2) + (macrolet ((test-return (index1 index2) + `(unless (test (key (sequence-1-ref ,index1)) + (key (sequence-2-ref ,index2))) + (return-from mismatch ,index1)))) + (let ((length1 (- end1 start1)) + (length2 (- end2 start2))) + (cond + ((< length1 length2) + (dotimes (i length1) + (declare (index i)) (test-return (+ start1 i) (+ start2 i))) - nil)))))) + end1) + ((> length1 length2) + (dotimes (i length2) + (declare (index i)) + (test-return (+ start1 i) (+ start2 i))) + (+ start1 length2)) + (t (dotimes (i length1) + (declare (index i)) + (test-return (+ start1 i) (+ start2 i))) + nil))))))) (list (let ((length1 (- end1 start1)) (start-cons2 (nthcdr start2 sequence-2))) @@ -489,23 +506,27 @@ (do ((i1 start1 (1+ i1)) (p2 start-cons2 (cdr p2))) ((>= i1 end1) (if (null p2) nil i1)) + (declare (index i1)) (unless (and p2 (test (key (sequence-1-ref i1)) (key (car p2)))) (return-from mismatch i1)))) ((< length1 (- end2 start2)) (do ((i1 start1 (1+ i1)) (p2 start-cons2 (cdr p2))) ((>= i1 end1) end1) + (declare (index i1)) (unless (test (key (sequence-1-ref i1)) (key (car p2))) (return-from mismatch i1)))) ((> length1 (- end2 start2)) (do ((i1 start1 (1+ i1)) (p2 start-cons2 (cdr p2))) ((null p2) end1) + (declare (index i1)) (unless (test (key (sequence-1-ref i1)) (key (car p2))) (return-from mismatch i1)))) (t (do ((i1 start1 (1+ i1)) (p2 start-cons2 (cdr p2))) ((null p2) nil) + (declare (index i1)) (unless (test (key (sequence-1-ref i1)) (key (car p2))) (return-from mismatch i1)))))))))) (list @@ -526,6 +547,7 @@ (p2 start-cons2 (cdr p2)) (i1 start1 (1+ i1))) ((null p1) (if (null p2) nil i1)) + (declare (index i1)) (unless (and p2 (test (key (car p1)) (key (car p2)))) (return i1)))) (t (do ((p1 start-cons1 (cdr p1)) @@ -534,6 +556,7 @@ (i2 start2 (1+ i2))) ((if end1 (>= i1 end1) (null p1)) (if (if end2 (>= i2 end2) (null p2)) nil i1)) + (declare (index i1 i2)) (unless p2 (if end2 (error "Illegal end2 bounding index.")