Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24256 Modified Files: integers.lisp Log Message: Added gcd, mainly borrowed from cmucl. Date: Wed May 19 11:09:07 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.8 movitz/losp/muerte/integers.lisp:1.9 --- movitz/losp/muerte/integers.lisp:1.8 Fri Apr 23 09:02:22 2004 +++ movitz/losp/muerte/integers.lisp Wed May 19 11:09:05 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.8 2004/04/23 13:02:22 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.9 2004/05/19 15:09:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1103,3 +1103,32 @@ (defun minus-if (x y) (if (integerp x) (- x y) x)) +(defun gcd (&rest numbers) + (numargs-case + (1 (u) u) + (2 (u v) + ;; Code borrowed from CMUCL. + (do ((k 0 (1+ k)) + (u (abs u) (ash u -1)) + (v (abs v) (ash v -1))) + ((oddp (logior u v)) + (do ((temp (if (oddp u) (- v) (ash u -1)) + (ash temp -1))) + (nil) + (declare (fixnum temp)) + (when (oddp temp) + (if (plusp temp) + (setq u temp) + (setq v (- temp))) + (setq temp (- u v)) + (when (zerop temp) + (let ((res (ash u k))) + (declare (type (signed-byte 31) res) + (optimize (inhibit-warnings 3))) + (return res)))))))) + (t (&rest numbers) + (declare (dynamic-extent numbers)) + (do ((gcd (car numbers) + (gcd gcd (car rest))) + (rest (cdr numbers) (cdr rest))) + ((null rest) gcd)))))