[movitz-cvs] CVS update: movitz/losp/muerte/sequences.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Mon Aug 22 17:03:01 UTC 2005
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 at 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.")
More information about the Movitz-cvs
mailing list