X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fnumbers.lisp;h=f5dee9aeb1ecd43489c440a7a22dbf61a0c2ab86;hb=a2bb848e0037e127287781e99528bc4e93ccc2fb;hp=dd0946262626e76e372d052f6054808b5b803432;hpb=8b17fb21f80eb9028eecfe29e8d1b2a2613c7187;p=jscl.git

diff --git a/src/numbers.lisp b/src/numbers.lisp
index dd09462..f5dee9a 100644
--- a/src/numbers.lisp
+++ b/src/numbers.lisp
@@ -13,6 +13,8 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
 
+(/debug "loading numbers.lisp!")
+
 ;;;; Various numeric functions and constants
 
 (macrolet ((def (operator initial-value)
@@ -56,6 +58,9 @@
 (defun zerop (x) (= x 0))
 (defun plusp (x) (< 0 x))
 
+(defun signum (x)
+  (if (zerop x) x (/ x (abs x))))
+
 (macrolet ((def (operator)
              `(defun ,operator (x &rest args)
                 (dolist (y args) 
@@ -78,7 +83,7 @@
 (macrolet ((def (name comparison)
              `(defun ,name (x &rest xs)
                 (dolist (y xs) 
-                  (unless (,comparison x (car xs))
+                  (when (,comparison y x)
                     (setq x y)))
                 x)))
   (def max >)
@@ -88,3 +93,33 @@
 
 (defun expt (base power) (expt base              power))
 (defun exp  (power)      (expt 2.718281828459045 power))
+
+(defun gcd-2 (a b)
+  (if (zerop b)
+      (abs a)
+    (gcd-2 b (mod a b))))
+
+(defun gcd (&rest integers)
+  (cond ((null integers)
+	 0)
+	((null (cdr integers))
+	 (abs (first integers)))
+	((null (cddr integers))
+	 (gcd-2 (first integers) (second integers)))
+	(t
+	 (apply #'gcd (gcd (first integers) (second integers)) (nthcdr 2 integers)))))
+
+(defun lcm-2 (a b)
+  (if (or (zerop a) (zerop b))
+      0
+    (/ (abs (* a b)) (gcd a b))))
+
+(defun lcm (&rest integers)
+  (cond ((null integers)
+	 1)
+	((null (cdr integers))
+	 (abs (first integers)))
+	((null (cddr integers))
+	 (lcm-2 (first integers) (second integers)))
+	(t
+	 (apply #'lcm (lcm (first integers) (second integers)) (nthcdr 2 integers)))))