next-cdr.lisp

next-cdr.lisp

(defvar *l* (make-list 10000))
(defvar *a* (make-array 10000))

(declaim (inline next-cdr))
(defun next-cdr (cons)
  sb-vm::
  (inline-vop (((cons descriptor-reg) cons))
      ((res descriptor-reg))
    #+x86-64
    (progn
      (move res cons)
      (inst add res 16))
    #+arm64
    (inst add res cons 16)))

(defun find-list (l m)
  (declare (optimize speed (safety 0)))
  (loop named outer
        with cdr = l
        do 
        (when (eq (car cdr) m)
          (return-from outer cdr))
        (let ((list-cdr (cdr cdr)))
          (setf cdr (next-cdr cdr))
          (unless (eq cdr list-cdr)
            (setf cdr list-cdr)))
        until (null cdr)))

(defun find-list-normal (l m)
  (declare (optimize speed (safety 0)))
  (loop named outer
        with cdr = l
        do 
        (when (eq (car cdr) m)
          (return-from outer cdr))
        (setf cdr (cdr cdr))
        until (null cdr)))

(defun find-array (v m)
  (declare (optimize speed (safety 0)))
  (loop for x across (the simple-vector v)
        when (eq x m)
        return x))

;; (time (loop repeat 100000 count (find-list-normal *l* 10)))
;; =>
;;  1.157 seconds of real time

;; (time (loop repeat 100000 count (find-list *l* 10)))
;; =>
;; 0.376 seconds of real time

;; (time (loop repeat 100000 count (find-array *a* 10)))
;; =>
;; 0.346 seconds of real time