X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fnumbers.lisp;h=34ad585768b18edd4d9e60e711cbc120626a87d6;hb=aab24d77d0eeafb6880dce4420d3f422ef7a0971;hp=7546444b66bb15b1e5993bc6cdf05d1209b8b498;hpb=904d96b38f7035ff93ff56588e72b65b189800c8;p=sbcl.git

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index 7546444..34ad585 100644
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -211,10 +211,11 @@
 
 ;;;; 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.")
 
 ;;;; comparisons
 
@@ -765,6 +767,7 @@
        (result number))
       ((null nlist) (return result))
      (declare (list nlist))
+     (declare (type real number result))
      (if (> (car nlist) result) (setq result (car nlist)))))
 
 (defun min (number &rest more-numbers)
@@ -774,6 +777,7 @@
        (result number))
       ((null nlist) (return result))
      (declare (list nlist))
+     (declare (type real number result))
      (if (< (car nlist) result) (setq result (car nlist)))))
 
 (eval-when (:compile-toplevel :execute)
@@ -917,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)
@@ -926,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)
@@ -935,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)
@@ -944,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)