From: Christophe R. <cr...@us...> - 2003-09-11 11:28:00
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1:/tmp/cvs-serv3545/src/code Modified Files: numbers.lisp Log Message: 0.8.3.51: Fix (LCM 0 0) Index: numbers.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/numbers.lisp,v retrieving revision 1.23 retrieving revision 1.24 diff -u -d -r1.23 -r1.24 --- numbers.lisp 4 Sep 2003 16:09:11 -0000 1.23 +++ numbers.lisp 11 Sep 2003 11:27:56 -0000 1.24 @@ -1263,13 +1263,20 @@ (defun two-arg-lcm (n m) (declare (integer n m)) - (let ((m (abs m)) - (n (abs n))) - (multiple-value-bind (max min) - (if (> m n) - (values m n) - (values n m)) - (* (truncate max (gcd n m)) min)))) + (if (or (zerop n) (zerop m)) + 0 + ;; KLUDGE: I'm going to assume that it was written this way + ;; originally for a reason. However, this is a somewhat + ;; complicated way of writing the algorithm in the CLHS page for + ;; LCM, and I don't know why. To be investigated. -- CSR, + ;; 2003-09-11 + (let ((m (abs m)) + (n (abs n))) + (multiple-value-bind (max min) + (if (> m n) + (values m n) + (values n m)) + (* (truncate max (gcd n m)) min))))) ;;; Do the GCD of two integer arguments. With fixnum arguments, we use the ;;; binary GCD algorithm from Knuth's seminumerical algorithms (slightly |