Richard J. Fateman <fateman@eecs.berkeley.edu> wrote:
+
 Peter Luschny wrote:
 > Perhaps someone in this group could give me a
 > helping hand and show me the Lisp implementation of the algorithm

 here it is in lisp

 (defun sprfact(n)
 (cond ((< n 0)(error "bad arg ~s to factorial" n))
 ((< n 2) 1)
 (t
 (let ((p 1) (r 1) (N 1) (log2n (floor (log n 2)))
 (h 0) (shift 0) (high 1) (len 0))
 (declare (special N))
 (while (/= h n)
 (incf shift h)
 (setf h (ash n ( log2n)))
 (decf log2n)
 (setf len high)
 (setf high (if (oddp h) h (1 h)))
 (setf len (ash ( high len) 1))
 (cond ((> len 0)
 (setf p (* p (prod len)))
 (setf r (* r p)))))
 (ash r shift)))))

 (defun prod(n)
 (declare (special N))
 (let ((m (ash n 1)))
 (cond ((= m 0) (incf N 2)) ((= n 2) (* (incf N 2)(incf N 2)))
 (t (* (prod ( n m)) (prod m))))))
+
This will not run in Common Lisp as as written, because of the
WHILE, and even when that is corrected will give incorrect answers
[e.g., (SPRFACT 5) => 3] because the default READTABLECASE in
Common Lisp is :UPCASE. If you put this line at the top of your
program:
(setf (readtablecase *readtable*) :invert)
and then define WHILE as follows [yeah, yeah, I know, using DO
would be safer]:
(defmacro while (bool &body body)
`(loop while ,bool do ,@body))
and only *THEN* type [or paste] the above definitions for SPRFACT/PROD,
then it will work and give correct answers.
But on CMUCL it's more than twice as slow [0.21f0 s versus 0.1f0 s]
than the previous K/FACT version mentioned in this thread. [And, yes,
I did compile it.] I suspect that if you rewrite it without using
special variables it might improve [e.g., perhaps by making PROD be
an FLET inside the LET binding within SPRFACT].
Rob

Rob Warnock <rpw3@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)5722607