(in-package :cl-user)

(defun find-symbol-subseq (string start end)
  (find-symbol (subseq string start end)))

(defun find-symbol-displaced (string start end)
  (let ((a (make-array (- end start)
                       :element-type (array-element-type string)
                       :displaced-to string
                       :displaced-index-offset start)))
    (declare (dynamic-extent a)
             (optimize (speed 3) (safety 0)))
    (find-symbol a)))

(defvar *buffer*
  (make-array 10000 :element-type 'character))

(defun bench-subseq (probe)
  (let* ((buffer *buffer*)
         (start 4711)
         (end (+ start (length probe))))
    (replace buffer probe :start1 start)
    (loop repeat 1e7 do (find-symbol-subseq buffer start end))))

(defun bench-displaced (probe)
  (let* ((buffer *buffer*)
         (start 4711)
         (end (+ start (length probe))))
    (replace buffer probe :start1 start)
    (loop repeat 1e7 do (find-symbol-displaced buffer start end))))

(print (list (lisp-implementation-type) (lisp-implementation-version)))

(print '(bench-subseq "CONS"))
(time (bench-subseq "CONS"))
(print '(bench-displaced "CONS"))
(time (bench-displaced "CONS"))

(print '(bench-subseq "FIND-SYMBOL"))
(time (bench-subseq "FIND-SYMBOL"))
(print '(bench-displaced "FIND-SYMBOL"))
(time (bench-displaced "FIND-SYMBOL"))

(print '(bench-subseq "FIND-SYMBOL"))
(time (bench-subseq "FIND-SYMBOL"))
(print '(bench-displaced "FIND-SYMBOL"))
(time (bench-displaced "FIND-SYMBOL"))

(print '(bench-subseq "LEAST-POSITIVE-SINGLE-FLOAT"))
(time (bench-subseq "LEAST-POSITIVE-SINGLE-FLOAT"))
(print '(bench-displaced "LEAST-POSITIVE-SINGLE-FLOAT"))
(time (bench-displaced "LEAST-POSITIVE-SINGLE-FLOAT"))