source code
;; The Computer Language Benchmarks Game
;; https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
;;
;; Contributed by Karel Belohlavek
;;
;; Single core implementation.
;; Inspired by the Erlang one by Alkis Gotovos and Maria Christakis.
(eval-when (:execute) (proclaim '(optimize (speed))))
(defun fannkuch (n)
(labels
((mkperm (n)
(let*
((params (loop for i from 1 to n collect (gensym)))
(flip-branches
(loop
for j from 2 to n
collect
`((,j)
,(append '(flip (the fixnum (1+ acc)))
(reverse (subseq params 0 j))
(subseq params j)))))
(nextperm-branches
(loop
for j from 0 below n
for rparams = (append (subseq params 1 (1+ j))
(list (car params))
(subseq params (1+ j)))
collect
`((,j)
(if (< (aref c i) i)
(progn
(incf (aref c i))
(let ((nflips (the fixnum (flip 0 ,@rparams))))
(declare (type fixnum nflips))
(cond (even (incf csum nflips)
(setf even nil))
(t (decf csum nflips)
(setf even t)))
(when (> nflips max-flips)
(setf max-flips nflips)))
(perm 1 ,@rparams))
(progn
(setf (aref c i) 0)
(perm (+ i 1) ,@rparams)))))))
`(lambda ()
(let ((csum 0)
(max-flips 0)
(even nil)
(c (make-array ,n :initial-element 0 :element-type 'fixnum)))
(declare (type fixnum csum max-flips)
(type boolean even)
(type (simple-array fixnum (,n)) c))
(labels
((flip (acc ,@params)
(declare (type fixnum acc ,@params))
(ecase ,(car params) ((1) acc) ,@flip-branches))
(perm (i ,@params)
(declare (type fixnum i ,@params))
(ecase i
(,n (format t "~s~%Pfannkuchen(~s) = ~s~%" csum ,n max-flips))
,@nextperm-branches)))
(apply #'perm
1
(loop for j of-type fixnum from 1 to ,n collect j))))))))
(funcall (compile nil (mkperm n)))))
(defun main ()
(let* ((args (cdr sb-ext:*posix-argv*))
(n (parse-integer (car args))))
(fannkuch n)))
notes, command-line, and program output
NOTES:
64-bit Ubuntu quad core
SBCL 2.4.8
Fri, 06 Sep 2024 21:09:13 GMT
MAKE:
cp: 'fannkuchredux.sbcl-5.sbcl' and './fannkuchredux.sbcl-5.sbcl' are the same file
SBCL built with: /opt/src/sbcl-2.4.8/bin/sbcl --userinit /dev/null --batch --eval '(load "fannkuchredux.sbcl-5.sbcl_compile")'
### START fannkuchredux.sbcl-5.sbcl_compile
(handler-bind ((sb-ext:defconstant-uneql (lambda (c) (abort c)))) (require :sb-concurrency) (load (compile-file "fannkuchredux.sbcl-5.sbcl" ))) (save-lisp-and-die "sbcl.core" :purify t)
### END fannkuchredux.sbcl-5.sbcl_compile
; compiling file "/home/dunham/all-benchmarksgame/benchmarksgame_i53330/fannkuchredux/tmp/fannkuchredux.sbcl-5.sbcl" (written 26 APR 2018 12:47:38 PM):
; wrote /home/dunham/all-benchmarksgame/benchmarksgame_i53330/fannkuchredux/tmp/fannkuchredux.sbcl-5.fasl
; compilation finished in 0:00:00.068
### START fannkuchredux.sbcl-5.sbcl_run
(main) (quit)
### END fannkuchredux.sbcl-5.sbcl_run
2.40s to complete and log all make actions
COMMAND LINE:
/opt/src/sbcl-2.4.8/bin/sbcl --noinform --core sbcl.core --userinit /dev/null --load fannkuchredux.sbcl-5.sbcl_run 12
PROGRAM OUTPUT:
3968050
Pfannkuchen(12) = 65