X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fnumbers.lisp;h=9eb5d54911f2309a46c7341d14139cbc3b9aeabd;hb=5edd74f6911093805a009a152b32216b3dba59f7;hp=8e7e6ed0a9d2a3b461008e275281a5b097848a0d;hpb=667ec9d494530079bef28e8589dd0d3274b935ec;p=sbcl.git diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index 8e7e6ed..9eb5d54 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -67,11 +67,11 @@ (let ((var (first vars)) (cases (sort cases #'type-test-order :key #'car))) `((typecase ,var - ,@(mapcar #'(lambda (case) - `(,(first case) - ,@(generate-number-dispatch (rest vars) - (rest error-tags) - (cdr case)))) + ,@(mapcar (lambda (case) + `(,(first case) + ,@(generate-number-dispatch (rest vars) + (rest error-tags) + (cdr case)))) cases) (t (go ,(first error-tags)))))) cases)) @@ -227,7 +227,7 @@ (defun complex (realpart &optional (imagpart 0)) #!+sb-doc - "Builds a complex number from the specified components." + "Return a complex number with the specified real and imaginary components." (flet ((%%make-complex (realpart imagpart) (cond #!+long-float ((and (typep realpart 'long-float) @@ -251,7 +251,7 @@ (defun realpart (number) #!+sb-doc - "Extracts the real part of a number." + "Extract the real part of a number." (typecase number #!+long-float ((complex long-float) @@ -267,7 +267,7 @@ (defun imagpart (number) #!+sb-doc - "Extracts the imaginary part of a number." + "Extract the imaginary part of a number." (typecase number #!+long-float ((complex long-float) @@ -329,8 +329,8 @@ (defun - (number &rest more-numbers) #!+sb-doc - "Subtracts the second and all subsequent arguments from the first. - With one arg, negates it." + "Subtract the second and all subsequent arguments from the first; + or with one argument, negate the first argument." (if more-numbers (do ((nlist more-numbers (cdr nlist)) (result number)) @@ -679,18 +679,18 @@ (+ rem divisor) rem))) -(macrolet ((def-frob (name op doc) +(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-frob ffloor floor + (def ffloor floor "Same as FLOOR, but returns first value as a float.") - (def-frob fceiling ceiling + (def fceiling ceiling "Same as CEILING, but returns first value as a float." ) - (def-frob ftruncate truncate + (def ftruncate truncate "Same as TRUNCATE, but returns first value as a float.") - (def-frob fround round + (def fround round "Same as ROUND, but returns first value as a float.")) ;;;; comparisons @@ -879,12 +879,12 @@ nil (macrolet ((foo (&rest stuff) `(typecase obj2 - ,@(mapcar #'(lambda (foo) - (let ((type (car foo)) - (fn (cadr foo))) - `(,type - (and (typep obj1 ',type) - (,fn obj1 obj2))))) + ,@(mapcar (lambda (foo) + (let ((type (car foo)) + (fn (cadr foo))) + `(,type + (and (typep obj1 ',type) + (,fn obj1 obj2))))) stuff)))) (foo (single-float eql) @@ -978,13 +978,13 @@ (fixnum (lognot (truly-the fixnum number))) (bignum (bignum-logical-not number)))) -(macrolet ((def-frob (name op big-op) +(macrolet ((def (name op big-op) `(defun ,name (x y) (number-dispatch ((x integer) (y integer)) (bignum-cross-fixnum ,op ,big-op))))) - (def-frob two-arg-and logand bignum-logical-and) - (def-frob two-arg-ior logior bignum-logical-ior) - (def-frob two-arg-xor logxor bignum-logical-xor)) + (def two-arg-and logand bignum-logical-and) + (def two-arg-ior logior bignum-logical-ior) + (def two-arg-xor logxor bignum-logical-xor)) (defun logcount (integer) #!+sb-doc @@ -1214,7 +1214,7 @@ (13 (boole 13 integer1 integer2)) (14 (boole 14 integer1 integer2)) (15 (boole 15 integer1 integer2)) - (t (error "~S is not of type (mod 16)." op)))) + (t (error 'type-error :datum op :expected-type '(mod 16))))) ;;;; GCD and LCM @@ -1315,10 +1315,10 @@ ;;;; miscellaneous number predicates -(macrolet ((def-frob (name doc) +(macrolet ((def (name doc) `(defun ,name (number) ,doc (,name number)))) - (def-frob zerop "Is this number zero?") - (def-frob plusp "Is this real number strictly positive?") - (def-frob minusp "Is this real number strictly negative?") - (def-frob oddp "Is this integer odd?") - (def-frob evenp "Is this integer even?")) + (def zerop "Is this number zero?") + (def plusp "Is this real number strictly positive?") + (def minusp "Is this real number strictly negative?") + (def oddp "Is this integer odd?") + (def evenp "Is this integer even?"))