add truly-dynamic-extent declarations for various &rest number functions
authorNathan Froyd <froydnj@gmail.com>
Wed, 19 Sep 2012 01:49:16 +0000 (21:49 -0400)
committerNathan Froyd <froydnj@gmail.com>
Wed, 19 Sep 2012 01:49:16 +0000 (21:49 -0400)
This change eliminates some spurious heap consing when using, e.g.
(REDUCE #'+ ...).  We ought to be able to do a better job of optimizing
REDUCE, but this is a helpful first step in any event.

src/code/numbers.lisp

index 2b86681..bb11649 100644 (file)
              #!-sb-doc (declare (ignore doc))
              `(defun ,op (&rest args)
                 #!+sb-doc ,doc
+                (declare (truly-dynamic-extent args))
                 (if (null args) ,init
                     (do ((args (cdr args) (cdr args))
                          (result (car args) (,op result (car args))))
   #!+sb-doc
   "Subtract the second and all subsequent arguments from the first;
   or with one argument, negate the first argument."
+  (declare (truly-dynamic-extent more-numbers))
   (if more-numbers
       (do ((nlist more-numbers (cdr nlist))
            (result number))
   #!+sb-doc
   "Divide the first argument by each of the following arguments, in turn.
   With one argument, return reciprocal."
+  (declare (truly-dynamic-extent more-numbers))
   (if more-numbers
       (do ((nlist more-numbers (cdr nlist))
            (result number))
@@ -1032,6 +1035,7 @@ the first."
   #!+sb-doc
   "Return the bit-wise or of its arguments. Args must be integers."
   (declare (list integers))
+  (declare (truly-dynamic-extent integers))
   (if integers
       (do ((result (pop integers) (logior result (pop integers))))
           ((null integers) result)
@@ -1042,6 +1046,7 @@ the first."
   #!+sb-doc
   "Return the bit-wise exclusive or of its arguments. Args must be integers."
   (declare (list integers))
+  (declare (truly-dynamic-extent integers))
   (if integers
       (do ((result (pop integers) (logxor result (pop integers))))
           ((null integers) result)
@@ -1052,6 +1057,7 @@ the first."
   #!+sb-doc
   "Return the bit-wise and of its arguments. Args must be integers."
   (declare (list integers))
+  (declare (truly-dynamic-extent integers))
   (if integers
       (do ((result (pop integers) (logand result (pop integers))))
           ((null integers) result)
@@ -1062,6 +1068,7 @@ the first."
   #!+sb-doc
   "Return the bit-wise equivalence of its arguments. Args must be integers."
   (declare (list integers))
+  (declare (truly-dynamic-extent integers))
   (if integers
       (do ((result (pop integers) (logeqv result (pop integers))))
           ((null integers) result)
@@ -1364,6 +1371,7 @@ the first."
   #!+sb-doc
   "Return the greatest common divisor of the arguments, which must be
   integers. Gcd with no arguments is defined to be 0."
+  (declare (truly-dynamic-extent integers))
   (cond ((null integers) 0)
         ((null (cdr integers)) (abs (the integer (car integers))))
         (t
@@ -1378,6 +1386,7 @@ the first."
   #!+sb-doc
   "Return the least common multiple of one or more integers. LCM of no
   arguments is defined to be 1."
+  (declare (truly-dynamic-extent integers))
   (cond ((null integers) 1)
         ((null (cdr integers)) (abs (the integer (car integers))))
         (t