diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index a64db690740f13ff9207dabad694ef2d89936953..ac450eabf4d11702aadccac8f120d4cc51cf21a6 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.106 2001/04/12 19:45:57 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.107 2001/09/24 15:26:50 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2331,6 +2331,38 @@
 		      values))))
 
 
+(defun signum-derive-type-aux (type)
+  ;; The signum of a complex number is a complex number of the same type.
+  ;; The signum of a real number is 0, 1, or -1, of the same type.
+  (if (eq (numeric-type-complexp type) :complex)
+      type
+      (let* ((type-interval (numeric-type->interval type))
+	     (range-info (interval-range-info type-interval))
+	     (contains-0-p (interval-contains-p 0 type-interval))
+	     (plus (make-numeric-type :class (numeric-type-class type)
+				      :format (numeric-type-format type)
+				      :low 1 :high 1))
+	     (minus (make-numeric-type :class (numeric-type-class type)
+				       :format (numeric-type-format type)
+				       :low -1 :high -1))
+	     (zero (make-numeric-type :class (numeric-type-class type)
+				      :format (numeric-type-format type)
+				      :low 0 :high 0)))
+	(cond ((eq range-info '+)
+	       (if contains-0-p
+		   (make-union-type (list plus zero))
+		   plus))
+	      ((eq range-info '-)
+	       (if contains-0-p
+		   (make-union-type (list minus zero))
+		   minus))
+	      (t
+	       (make-union-type (list minus plus zero)))))))
+
+	
+(defoptimizer (signum derive-type) ((num))
+  (one-arg-derive-type num #'signum-derive-type-aux nil))
+
 
 ;;;; Byte operations:
 ;;;