[Sbcl-commits] CVS: sbcl/src/code backq.lisp,1.10,1.11 seq.lisp,1.58,1.59

[Alexey D. <ade...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17299/src/code

Modified Files:
	backq.lisp seq.lisp 
Log Message:
0.8.18.24:
        * BACKQ-* wrappers have dynamic-extent argument lists.
        * Dereference FUNCTION designator argument of REDUCE at the
          beginning of the function.
        * Remove some FIXNUM declarations in REDUCE.



Index: backq.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/backq.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- backq.lisp	10 Jun 2004 15:47:53 -0000	1.10
+++ backq.lisp	10 Jan 2005 08:04:21 -0000	1.11
@@ -207,6 +207,7 @@
 	       ;; whether there's still an optimizer bug, and fix it if so, and
 	       ;; then make these INLINE.
 	       `(defun ,b-name (&rest ,args)
+                  (declare (dynamic-extent ,args))
 		  (apply #',name ,args)))))
   (def backq-list list)
   (def backq-list* list*)

Index: seq.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/seq.lisp,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -d -r1.58 -r1.59
--- seq.lisp	2 Nov 2004 08:37:52 -0000	1.58
+++ seq.lisp	10 Jan 2005 08:04:21 -0000	1.59
@@ -1079,8 +1079,7 @@
 			       ref)
   `(do ((index ,start (1+ index))
 	(value ,initial-value))
-       ((= index (the fixnum ,end)) value)
-     (declare (fixnum index))
+       ((>= index ,end) value)
      (setq value (funcall ,function value
 			  (apply-key ,key (,ref ,sequence index))))))
 
@@ -1094,8 +1093,7 @@
   `(do ((index (1- ,end) (1- index))
 	(value ,initial-value)
 	(terminus (1- ,start)))
-       ((= index terminus) value)
-     (declare (fixnum index terminus))
+       ((<= index terminus) value)
      (setq value (funcall ,function
 			  (apply-key ,key (,ref ,sequence index))
 			  value))))
@@ -1108,14 +1106,13 @@
 			     initial-value
 			     ivp)
   `(let ((sequence (nthcdr ,start ,sequence)))
-     (do ((count (if ,ivp ,start (1+ (the fixnum ,start)))
+     (do ((count (if ,ivp ,start (1+ ,start))
 		 (1+ count))
 	  (sequence (if ,ivp sequence (cdr sequence))
 		    (cdr sequence))
 	  (value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
 		 (funcall ,function value (apply-key ,key (car sequence)))))
-	 ((= count (the fixnum ,end)) value)
-       (declare (fixnum count)))))
+	 ((>= count ,end) value))))
 
 (sb!xc:defmacro list-reduce-from-end (function
 				      sequence
@@ -1124,17 +1121,15 @@
 				      end
 				      initial-value
 				      ivp)
-  `(let ((sequence (nthcdr (- (the fixnum (length ,sequence))
-			      (the fixnum ,end))
+  `(let ((sequence (nthcdr (- (length ,sequence) ,end)
 			   (reverse ,sequence))))
-     (do ((count (if ,ivp ,start (1+ (the fixnum ,start)))
+     (do ((count (if ,ivp ,start (1+ ,start))
 		 (1+ count))
 	  (sequence (if ,ivp sequence (cdr sequence))
 		    (cdr sequence))
 	  (value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
 		 (funcall ,function (apply-key ,key (car sequence)) value)))
-	 ((= count (the fixnum ,end)) value)
-       (declare (fixnum count)))))
+	 ((>= count ,end) value))))
 
 ) ; EVAL-WHEN
 
@@ -1142,7 +1137,8 @@
     (function sequence &key key from-end start end (initial-value nil ivp))
   (declare (type index start))
   (let ((start start)
-	(end (or end length)))
+	(end (or end length))
+        (function (%coerce-callable-to-fun function)))
     (declare (type index start end))
     (cond ((= end start)
 	   (if ivp initial-value (funcall function)))