X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fnumbers.lisp;h=34ad585768b18edd4d9e60e711cbc120626a87d6;hb=860543cc7ba0266e41e1d41ac9b6a208f3795f1a;hp=03ba7c5d50a1ee2122b6e622a0b96b88f1e401ed;hpb=581e3d62de8cb37e13ad9db63e5537c0f962be28;p=sbcl.git diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index 03ba7c5..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 @@ -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)