This is a follow-up to my post about a time test for AKCL vs Fortran
and ML. Several people have asked for the code for Version 5, the
Lisp translation of the array-based Fortran version. Here is it.
For convenience, I'm reposting the Fortran version at the end.
(proclaim '(ftype (function () t)
pascal))
(defun pascal ()
(let ((ar (make-array (list 5001) :element-type 'fixnum)))
(declare (type (array fixnum (5001)) ar))
;; Is the declare statement a waste, since I've already given
;; the :element-type information?
(pascal1 5000 2 ar) ; overwrites ar
(when (= 1 (aref ar 0)) ; equivalent to (when t ...)
'done)))
(proclaim '(ftype (function (fixnum fixnum (array fixnum (5001))) t)
pascal1))
(defun pascal1 (n p ar)
(declare (fixnum n p))
(declare (type (array fixnum (5001)) ar))
(let ((ptr 0))
(declare (fixnum ptr))
(dotimes (i n)
(declare (fixnum i))
(incf ptr)
(setf (aref ar ptr) 1)
(do ((j (1- ptr) (1- j)))
((< j 1))
(declare (fixnum j))
(setf (aref ar j)
;; I don't need to wrap the next (mod ... p) form in a
;; (the fixnum ...) form, since the compiler already knows
;; ar holds only fixnum's--right? Also, two lines below,
;; the compiler "should" know that (1- j) is a fixnum,
;; since j is a fixnum => 1 ; but I told the compiler
;; anyway.
(mod
(the fixnum (+ (aref ar j) (aref ar (the fixnum (1- j)))))
p))))))
;;; -----------------
c -----------------
program pascal
implicit integer (a - z)
integer ar(0:5000)
ar(0)=1
call pascl1(5000, 2, ar)
if (ar(0).eq.1) write(*,*) 'done'
end
subroutine pascl1(n,p,ar)
implicit integer (a - z)
integer ar(0:5000)
ptr=0
do 10 i=1,n
ptr=ptr+1
ar(ptr)=1
do 20 j=ptr-1, 1, -1
ar(j)=mod(ar(j)+ar(j-1), p)
20 continue
c ar(0) is still 1
10 continue
return
end
········@coils.cims.nyu.edu (Mark McConnell) writes:
>This is a follow-up to my post about a time test for AKCL vs Fortran
>and ML. Several people have asked for the code for Version 5, the
>Lisp translation of the array-based Fortran version. Here is it.
>For convenience, I'm reposting the Fortran version at the end.
Thanks Mark, here are the CMU LISP times for the array-based-version of
your code. I modified it slightly as below. First is the array-based.
On my machine, the FORTRAN -O3 version ran in 10.2 user+sys.
CMU LISP array-based
12.38 seconds of user run time
0.06 seconds of system run time
0 page faults and
5016 bytes consed.
So much for gross inefficiency! Note the Allegro & GCL had a
similiar speedup, but CLICC, CLISP & ECL didn't improve much
(I didn't do as much as I could have with post-compile inling on CLiCC for one
thing.)
Yes, I realize that a bit more attention given to tuning this code
for any one of these implementations could probably erase those last few
seconds.
Of course it goes without saying that all these numbers only reflect
how well *these two particular* programs gets compiled. They may or may not
be generalizable. I can't believe people are so touch about numbers.
#+allegro (declaim (optimize (speed 3) (safety 0) (space 0) (debug 0)))
#-(or :ECL allegro KCL) (declaim (optimize (speed 3) (safety 0) (space 0)))
#+KCL (proclaim '(optimize (speed 3) (safety 0) (space 0)))
(deftype mod-type () '(unsigned-byte 8))
(deftype offset-type () '(unsigned-byte 16))
#-(or :ECL KCL) (declaim (ftype (function () t) pascal))
#-(or :ECL KCL) (declaim (ftype (function (offset-type mod-type (simple-array mod-type (5001))) t)))
#+KCL (proclaim '(ftype (function () t) pascal))
#+KCL (proclaim '(ftype (function (offset-type mod-type (simple-array mod-type (5001))) t)))
(defun pascal ()
(let ((ar (make-array 5001 :element-type 'mod-type :initial-element 0)))
(declare (type (simple-array mod-type (5001)) ar))
(pascal1 5000 2 ar) ; overwrites ar
(when (= 1 (aref ar 0)) ; equivalent to (when t ...)
'done)
))
(defun pascal1 (n p ar)
#-:ECL (declare (type offset-type n)
(type mod-type p)
(type (simple-array mod-type (5001)) ar))
(let ((ptr 0))
(declare (type offset-type ptr))
#+allegro (declare (dynamic-extent ptr))
(dotimes (i n)
(declare (type offset-type i))
#+allegro (declare (dynamic-extent i))
(incf ptr)
(setf (aref ar ptr) 1)
(do ((j (1- ptr) (1- j)))
((< j 1))
(declare (type offset-type j))
#+allegro (declare (dynamic-extent j))
(setf (aref ar j)
(mod
(the mod-type (+ (aref ar j) (aref ar (the offset-type (1- j)))))
p))))))
(defun run () (pascal))
CMU LISP recursive
Evaluation took:
58.5 seconds of real time
40.36 seconds of user run time
16.02 seconds of system run time
[Run times include 22.7 seconds GC run time]
96 page faults and
100150000 bytes consed.
#+allegro (declaim (optimize (speed 3) (safety 0) (space 0) (debug 0)))
#-(or :ECL allegro KCL) (declaim (optimize (speed 3) (safety 0) (space 0)))
#+KCL (proclaim '(optimize (speed 3) (safety 0) (space 0)))
(deftype mod-type () '(unsigned-byte 8))
(deftype offset-type () '(unsigned-byte 16))
#-(or :ECL KCL) (declaim (ftype (function (offset-type mod-type) list) pascal))
#-(or :ECL KCL) (declaim (ftype (function (offset-type mod-type list) list) pascal-aux))
#-(or :ECL KCL) (declaim (ftype (function (offset-type list list) list) pascal-aux2))
#+KCL (proclaim '(ftype (function (offset-type mod-type) list) pascal))
#+KCL (proclaim '(ftype (function (offset-type mod-type list) list) pascal-aux))
#+KCL (proclaim '(ftype (function (offset-type list list) list) pascal-aux2))
(defun pascal (n p)
;; Returns the n-th row of Pascal's triangle mod p.
(declare (type offset-type n))
(declare (type mod-type p))
(pascal-aux n p '(1)))
(defun pascal-aux (n p ans)
;; This merely calls pascal-aux2 n times, each time passing it
;; the right initial parameters.
(declare (type offset-type n))
(declare (type mod-type p))
(if (zerop n)
ans
(pascal-aux (the offset-type (1- n)) p (pascal-aux2 p ans '(1)))))
(defun pascal-aux2 (p in out)
;; This is the main workhorse: given a row of the triangle, it
;; computes the next row. Call it initially with the following
;; parameters: (p <old-row> '(1)) . At each step of the tail
;; recursion, one element is removed from the second argument, and a
;; new element is consed onto the third argument.
(declare (type offset-type p))
(if (null (cdr in)) ; if 2nd arg has only one element left...
(cons 1 out) ; ...then done; return 3rd arg, with final 1 stuck on
;; Otherwise tail-recurse.
(pascal-aux2 p
(cdr in) ; drop one elt of old row
;; The new elt to cons onto the answer is the sum of
;; the first two entries of the 2nd arg, mod p:
(cons (the mod-type
(mod (the mod-type (+ (the mod-type (car in))
(the mod-type (cadr in))))
p))
out))))
(defun run () (null (pascal 5000 2)))