slovo/benchmarks/string-eq-loop/common-lisp/string_eq_loop.lisp
2026-05-22 08:38:43 +02:00

44 lines
1.6 KiB
Common Lisp

(declaim (optimize (speed 3) (safety 0) (debug 0)))
(defconstant +loop-count+ 1000000)
(defconstant +expected-checksum+ 4600001)
(defparameter +words+ #("alpha" "omega" "delta" "omega" "sigma"))
(declaim (ftype (function () fixnum) configured-loop-count))
(defun configured-loop-count ()
(handler-case
(let ((line (read-line *standard-input* nil nil)))
(if line
(let ((value (parse-integer line :junk-allowed t)))
(if (> value 0) value +loop-count+))
+loop-count+))
(error () +loop-count+)))
(declaim (ftype (function () string) configured-target))
(defun configured-target ()
(or (second sb-ext:*posix-argv*) "omega"))
(declaim (ftype (function (fixnum string) fixnum) string-eq-loop))
(defun string-eq-loop (limit target)
(declare (type fixnum limit)
(type string target))
(loop with i of-type fixnum = 0
with acc of-type fixnum = 1
while (< i limit)
do (let* ((current (svref +words+ (rem i 5)))
(next (if (string= current target)
(+ acc 7)
(+ acc 3)))
(bounded (if (> next 1000000000)
(- next 1000000000)
next)))
(declare (type string current)
(type fixnum next bounded))
(setf acc bounded
i (+ i 1)))
finally (return acc)))
(let ((result (string-eq-loop (configured-loop-count) (configured-target))))
(format t "~D~%" result)
(sb-ext:exit :code (if (= result +expected-checksum+) 0 1)))