X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fnumbers.lisp;h=58fdb29d36177078bbda7063316cc6782f681f95;hb=2c5a710f4da100f8aa9c7262fa76395f73ee4307;hp=9571988d6765363cd25b62a38015e1a32259b52e;hpb=6822034325136cde4e14773c83c3769b42721306;p=sbcl.git

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index 9571988..58fdb29 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))
@@ -362,9 +363,9 @@
                            (,op (imagpart x) (imagpart y))))
        (((foreach bignum fixnum ratio single-float double-float
                   #!+long-float long-float) complex)
-        (complex (,op x (realpart y)) (,op (imagpart y))))
+        (complex (,op x (realpart y)) (,op 0 (imagpart y))))
        ((complex (or rational float))
-        (complex (,op (realpart x) y) (imagpart x)))
+        (complex (,op (realpart x) y) (,op (imagpart x) 0)))
 
        (((foreach fixnum bignum) ratio)
         (let* ((dy (denominator y))
@@ -854,10 +855,10 @@ the first."
          ;; conversion.
          (multiple-value-bind (lo hi)
              (case '(dispatch-type y)
-               ('single-float
+               (single-float
                 (values most-negative-exactly-single-float-fixnum
                         most-positive-exactly-single-float-fixnum))
-               ('double-float
+               (double-float
                 (values most-negative-exactly-double-float-fixnum
                         most-positive-exactly-double-float-fixnum)))
            (if (<= lo y hi)
@@ -871,10 +872,10 @@ the first."
              ;; Likewise
              (multiple-value-bind (lo hi)
                  (case '(dispatch-type x)
-                   ('single-float
+                   (single-float
                     (values most-negative-exactly-single-float-fixnum
                             most-positive-exactly-single-float-fixnum))
-                   ('double-float
+                   (double-float
                     (values most-negative-exactly-double-float-fixnum
                             most-positive-exactly-double-float-fixnum)))
                (if (<= lo y hi)
@@ -1457,7 +1458,7 @@ the first."
       (do-mfuns sb!c::*untagged-unsigned-modular-class*)
       (do-mfuns sb!c::*untagged-signed-modular-class*)
       (do-mfuns sb!c::*tagged-modular-class*)))
-  `(progn ,@(forms)))
+  `(progn ,@(sort (forms) #'string< :key #'cadr)))
 
 ;;; KLUDGE: these out-of-line definitions can't use the modular
 ;;; arithmetic, as that is only (currently) defined for constant