X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fnumbers.lisp;h=1c405559c030c18a9d8362ee36f869da4cfb855b;hb=9603675940cce3bcac93b354dca62d20c991cbce;hp=6de67f281928e9fd8264dc1152cf49a5cc5a61be;hpb=672b2f6cb751566526c7f3bb3de6b7d8424760e2;p=sbcl.git diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index 6de67f2..1c40555 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -238,7 +238,7 @@ (defun realpart (number) #!+sb-doc "Extract the real part of a number." - (typecase number + (etypecase number #!+long-float ((complex long-float) (truly-the long-float (realpart number))) @@ -248,13 +248,13 @@ (truly-the single-float (realpart number))) ((complex rational) (sb!kernel:%realpart number)) - (t + (number number))) (defun imagpart (number) #!+sb-doc "Extract the imaginary part of a number." - (typecase number + (etypecase number #!+long-float ((complex long-float) (truly-the long-float (imagpart number))) @@ -266,13 +266,14 @@ (sb!kernel:%imagpart number)) (float (* 0 number)) - (t + (number 0))) (defun conjugate (number) #!+sb-doc "Return the complex conjugate of NUMBER. For non-complex numbers, this is an identity." + (declare (type number number)) (if (complexp number) (complex (realpart number) (- (imagpart number))) number)) @@ -742,7 +743,7 @@ (defun = (number &rest more-numbers) #!+sb-doc "Return T if all of its arguments are numerically equal, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (the number number) (do ((nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -752,7 +753,7 @@ (defun /= (number &rest more-numbers) #!+sb-doc "Return T if no two of its arguments are numerically equal, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((head (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -766,7 +767,7 @@ (defun < (number &rest more-numbers) #!+sb-doc "Return T if its arguments are in strictly increasing order, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -776,7 +777,7 @@ (defun > (number &rest more-numbers) #!+sb-doc "Return T if its arguments are in strictly decreasing order, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -786,7 +787,7 @@ (defun <= (number &rest more-numbers) #!+sb-doc "Return T if arguments are in strictly non-decreasing order, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -796,7 +797,7 @@ (defun >= (number &rest more-numbers) #!+sb-doc "Return T if arguments are in strictly non-increasing order, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -807,7 +808,7 @@ #!+sb-doc "Return the greatest of its arguments; among EQUALP greatest, return the first." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do ((nlist more-numbers (cdr nlist)) (result number)) ((null nlist) (return result)) @@ -819,7 +820,7 @@ the first." #!+sb-doc "Return the least of its arguments; among EQUALP least, return the first." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do ((nlist more-numbers (cdr nlist)) (result number)) ((null nlist) (return result))