0.7.1.18:

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

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index 8e7e6ed..9eb5d54 100644 (file)
--- 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
       (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))
                      cases)
            (t (go ,(first error-tags))))))
       cases))

@@ -227,7 +227,7 @@
 
 (defun complex (realpart &optional (imagpart 0))
   #!+sb-doc
 
 (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)
   (flet ((%%make-complex (realpart imagpart)
           (cond #!+long-float
                 ((and (typep realpart 'long-float)

@@ -251,7 +251,7 @@
 
 (defun realpart (number)
   #!+sb-doc
 
 (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)
   (typecase number
     #!+long-float
     ((complex long-float)

@@ -267,7 +267,7 @@
 
 (defun imagpart (number)
   #!+sb-doc
 
 (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)
   (typecase number
     #!+long-float
     ((complex long-float)

@@ -329,8 +329,8 @@
 
 (defun - (number &rest more-numbers)
   #!+sb-doc
 
 (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))
   (if more-numbers
       (do ((nlist more-numbers (cdr nlist))
           (result number))

@@ -679,18 +679,18 @@
        (+ rem divisor)
        rem)))
 
        (+ 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)))))
             `(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.")
     "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." )
     "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.")
     "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."))
 \f
 ;;;; comparisons
     "Same as ROUND, but returns first value as a float."))
 \f
 ;;;; comparisons

@@ -879,12 +879,12 @@
          nil
          (macrolet ((foo (&rest stuff)
                       `(typecase obj2
          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)
                                    stuff))))
            (foo
              (single-float eql)

@@ -978,13 +978,13 @@
     (fixnum (lognot (truly-the fixnum number)))
     (bignum (bignum-logical-not number))))
 
     (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)))))
             `(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
 
 (defun logcount (integer)
   #!+sb-doc

@@ -1214,7 +1214,7 @@
     (13 (boole 13 integer1 integer2))
     (14 (boole 14 integer1 integer2))
     (15 (boole 15 integer1 integer2))
     (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)))))

 \f
 ;;;; GCD and LCM
 
 \f
 ;;;; GCD and LCM
 

@@ -1315,10 +1315,10 @@
 \f
 ;;;; miscellaneous number predicates
 
 \f
 ;;;; miscellaneous number predicates
 

-(macrolet ((def-frob (name doc)
+(macrolet ((def (name doc)

             `(defun ,name (number) ,doc (,name number))))
             `(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?"))