Changeset 251

Timestamp:

Jan 10, 2004, 10:06:50 PM (21 years ago)

Author:

Gary Byers

Message:

Fix LCM/LCM-2 error checking.

File:

• trunk/ccl/lib/numbers.lisp (modified) (2 diffs)

trunk/ccl/lib/numbers.lisp

@@ -335 +335 @@
 
 (defun lcm-2 (n0 n1)
-  (let* ((small (if (< n0 n1) n0 n1))
-         (large (if (eq small n0) n1 n0)))
-    (* (truncate large (gcd n0 n1)) small)))
+  (or (typep n0 'integer) (report-bad-arg n0 'integer))
+  (or (typep n1 'integer) (report-bad-arg n1 'integer))
+  (locally (declare (integer n0 n1))
+    (if (zerop n0)
+      0
+      (if (zerop n1)
+        0
+        (let* ((small (if (< n0 n1) n0 n1))
+               (large (if (eq small n0) n1 n0)))
+          (* (truncate large (gcd n0 n1)) small))))))
 
 (defun lcm (&lexpr numbers)
@@ -347 +354 @@
         (if (= count 1)
           (%integer-abs n0)
-          (do* ((i 1 (1+ i)))
-               ((= i count) n0)
-            (declare (fixnum i))
-            (setq n0 (lcm-2 n0 (%lexpr-ref numbers count i)))))))))
+          (if (= count 2)
+            (lcm-2 n0 (%lexpr-ref numbers count 1))
+            (do* ((i 1 (1+ i)))
+                 ((= i count) n0)
+              (declare (fixnum i))
+              (setq n0 (lcm-2 n0 (%lexpr-ref numbers count i))))))))))