0.8.0.24:

[sbcl.git] / src / code / numbers.lisp

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index 8e668dc..34ad585 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -211,10 +211,11 @@
 \f
 ;;;; COMPLEXes
 
-(defun upgraded-complex-part-type (spec)
+(defun upgraded-complex-part-type (spec &optional environment)
   #!+sb-doc
   "Return the element type of the most specialized COMPLEX number type that
    can hold parts of type SPEC."
+  (declare (ignore environment))
   (cond ((unknown-type-p (specifier-type spec))
         (error "undefined type: ~S" spec))
        ((subtypep spec 'single-float)
@@ -411,7 +412,7 @@
                                (nd (if (eql t2 1) t3 (* t2 t3))))
                           (if (eql nd 1) nn (%make-ratio nn nd))))))))))))
 
-); Eval-When (Compile)
+) ; EVAL-WHEN
 
 (two-arg-+/- two-arg-+ + add-bignums)
 (two-arg-+/- two-arg-- - subtract-bignum)
@@ -685,19 +686,20 @@
        (+ rem divisor)
        rem)))
 
-(macrolet ((def (name op doc)
-            `(defun ,name (number &optional (divisor 1))
-               ,doc
-               (multiple-value-bind (res rem) (,op number divisor)
-                 (values (float res (if (floatp rem) rem 1.0)) rem)))))
-  (def ffloor floor
-    "Same as FLOOR, but returns first value as a float.")
-  (def fceiling ceiling
-    "Same as CEILING, but returns first value as a float." )
-  (def ftruncate truncate
-    "Same as TRUNCATE, but returns first value as a float.")
-  (def fround round
-    "Same as ROUND, but returns first value as a float."))
+(defmacro !define-float-rounding-function (name op doc)
+  `(defun ,name (number &optional (divisor 1))
+    ,doc
+    (multiple-value-bind (res rem) (,op number divisor)
+      (values (float res (if (floatp rem) rem 1.0)) rem))))
+
+(!define-float-rounding-function ffloor floor
+  "Same as FLOOR, but returns first value as a float.")
+(!define-float-rounding-function fceiling ceiling
+  "Same as CEILING, but returns first value as a float." )
+(!define-float-rounding-function ftruncate truncate
+  "Same as TRUNCATE, but returns first value as a float.")
+(!define-float-rounding-function fround round
+  "Same as ROUND, but returns first value as a float.")
 \f
 ;;;; comparisons
 
@@ -919,7 +921,8 @@
   (declare (list integers))
   (if integers
       (do ((result (pop integers) (logior result (pop integers))))
-         ((null integers) result))
+         ((null integers) result)
+       (declare (integer result)))
       0))
 
 (defun logxor (&rest integers)
@@ -928,7 +931,8 @@
   (declare (list integers))
   (if integers
       (do ((result (pop integers) (logxor result (pop integers))))
-         ((null integers) result))
+         ((null integers) result)
+       (declare (integer result)))
       0))
 
 (defun logand (&rest integers)
@@ -937,7 +941,8 @@
   (declare (list integers))
   (if integers
       (do ((result (pop integers) (logand result (pop integers))))
-         ((null integers) result))
+         ((null integers) result)
+       (declare (integer result)))
       -1))
 
 (defun logeqv (&rest integers)
@@ -946,7 +951,8 @@
   (declare (list integers))
   (if integers
       (do ((result (pop integers) (logeqv result (pop integers))))
-         ((null integers) result))
+         ((null integers) result)
+       (declare (integer result)))
       -1))
 
 (defun lognand (integer1 integer2)