X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fnumbers.lisp;h=34ad585768b18edd4d9e60e711cbc120626a87d6;hb=310d5f86d736ecf9525711b087b04797c549879c;hp=e6ae2979c42237d0cc36df3d7613ec4de3f27a25;hpb=6e73f7320651975ce7cd8e72e2334041b7e80df1;p=sbcl.git

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index e6ae297..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)
@@ -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