X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fnumbers.lisp;h=03ba7c5d50a1ee2122b6e622a0b96b88f1e401ed;hb=581e3d62de8cb37e13ad9db63e5537c0f962be28;hp=9eb5d54911f2309a46c7341d14139cbc3b9aeabd;hpb=85bc4001453f09c80c4b9662dd5cf23f0b1fbaed;p=sbcl.git

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index 9eb5d54..03ba7c5 100644
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -194,9 +194,13 @@
       (if (minusp den)
 	  (values (- num) (- den))
 	  (values num den))
-    (if (eql den 1)
-	num
-	(%make-ratio num den))))
+    (cond
+      ((eql den 0)
+       (error 'division-by-zero
+	      :operands (list num den)
+	      :operation 'build-ratio))
+      ((eql den 1) num)
+      (t (%make-ratio num den)))))
 
 ;;; Truncate X and Y, but bum the case where Y is 1.
 #!-sb-fluid (declaim (inline maybe-truncate))
@@ -319,9 +323,11 @@
 	     `(defun ,op (&rest args)
 		#!+sb-doc ,doc
 		(if (null args) ,init
-		  (do ((args (cdr args) (cdr args))
-		       (res (car args) (,op res (car args))))
-		      ((null args) res))))))
+		    (do ((args (cdr args) (cdr args))
+			 (result (car args) (,op result (car args))))
+			((null args) result)
+		      ;; to signal TYPE-ERROR when exactly 1 arg of wrong type:
+		      (declare (type number result)))))))
   (define-arith + 0
     "Return the sum of its arguments. With no args, returns 0.")
   (define-arith * 1
@@ -405,7 +411,7 @@
 				(nd (if (eql t2 1) t3 (* t2 t3))))
 			   (if (eql nd 1) nn (%make-ratio nn nd))))))))))))
 
-); Eval-When (Compile)
+) ; EVAL-WHEN
 
 (two-arg-+/- two-arg-+ + add-bignums)
 (two-arg-+/- two-arg-- - subtract-bignum)
@@ -759,6 +765,7 @@
        (result number))
       ((null nlist) (return result))
      (declare (list nlist))
+     (declare (type real number result))
      (if (> (car nlist) result) (setq result (car nlist)))))
 
 (defun min (number &rest more-numbers)
@@ -768,6 +775,7 @@
        (result number))
       ((null nlist) (return result))
      (declare (list nlist))
+     (declare (type real number result))
      (if (< (car nlist) result) (setq result (car nlist)))))
 
 (eval-when (:compile-toplevel :execute)