;;; -*- lexical-binding: t -*-

(defun joaot/handrolled-nset-difference (list1 list2)
   (if (or (null list1) (null list2)) list1
     (let ((res nil))
       (while (consp list1)
         (if (funcall #'member (car list1) list2)
             (setf list1 (cdr list1))
           (cl-shiftf list1 (cdr list1) res list1)))
       res)))

(defun dmitry/set-difference-nocons (list1 list2)
   (let (ref)
     (while (member (car list1) list2)
       (setq list1 (cdr list1)))
     (setq ref list1)
     (while ref
       (if (member (cadr ref) list2)
           (setcdr ref (cddr ref))
         (setq ref (cdr ref))))
     list1))

(defvar joaot/bench-group-name nil)
(defvar joaot/setup-form nil)
(defvar joaot/timings-alist nil)
(defvar joaot/repetitions nil)

(defmacro joaot/with-benchmark-group (bench-name
                                      setup-form
                                      repetitions
                                      &rest body)
  (declare (indent 1))
  (let ((f `(alist-get ,bench-name joaot/timings-alist nil nil #'equal)))
    `(let ((joaot/bench-group-name ,bench-name)
           (joaot/setup-form ',setup-form)
           (joaot/repetitions ,repetitions))
       (setf ,f (list))
       ,@body
       (cl-loop with sorted = (setf ,f (cl-sort ,f #'< :key #'cadr))
                with fastest = (cadr (car sorted))
                for i from 0
                for res in sorted
                for prev-time = time
                for (_n time . more) = res
                do (setcdr res
                           (cl-list* (if (eq time fastest) "FASTEST"
                                       (format "%2.1fx %sSLOWER"
                                               (/ time fastest)
                                               (if (= i 1) ""
                                                 (format "(rel %2.1fx) "
                                                         (/ time prev-time)))))
                                     time
                                     more)))
       joaot/timings-alist)))

(defmacro joaot/bench (form)
  `(cl-progv
       (mapcar #'car joaot/setup-form)
       (mapcar #'eval (mapcar #'cdr joaot/setup-form))
     (let ((res
            (benchmark-call (prog1
                                (,(if (native-comp-available-p)
                                      'native-compile
                                    'byte-compile)
                                 '(lambda () ,form))
                              (garbage-collect))
                            joaot/repetitions))
           (group-name joaot/bench-group-name)
           (bench-name ',(car form)))
       (push (cons bench-name res)
             (alist-get group-name joaot/timings-alist nil nil #'equal)))))

(joaot/with-benchmark-group "set difference, big lists, #'equal pred"
  ((list1 . (all-completions "" obarray))
   (list2 . (make-list 12 "shooveedoowaa")))
  10
  (joaot/bench (joaot/handrolled-nset-difference list1 list2))
  (joaot/bench (dmitry/set-difference-nocons list1 list2))
  (joaot/bench (cl-nset-difference list1 list2 :test #'equal))
  (joaot/bench (cl-set-difference list1 list2 :test #'equal))
  (joaot/bench (seq-difference list1 list2))
  (joaot/bench (seq-difference-3 list1 list2)))

(joaot/with-benchmark-group "set difference, small lists, #'equal pred"
  ((list1 . (make-list 12 "bla"))
   (list2 . (make-list 12 "shooveedoowaa")))
  100000
  (joaot/bench (joaot/handrolled-nset-difference list1 list2))
  (joaot/bench (dmitry/set-difference-nocons list1 list2))
  (joaot/bench (cl-nset-difference list1 list2 :test #'equal))
  (joaot/bench (cl-set-difference list1 list2 :test #'equal))
  (joaot/bench (seq-difference list1 list2))
  (joaot/bench (seq-difference-3 list1 list2)))

(joaot/with-benchmark-group "set difference, big lists, #'eql pred"
  ((list1 . (all-completions "" obarray))
   (list2 . (make-list 12 "shooveedoowaa")))
  10
  (joaot/bench (cl-nset-difference list1 list2))
  (joaot/bench (cl-set-difference list1 list2))
  (joaot/bench (seq-difference list1 list2 #'eql))
  (joaot/bench (seq-difference-3 list1 list2 #'eql)))

(joaot/with-benchmark-group "set difference, small lists, #'eql pred"
  ((list1 . (make-list 12 "bla"))
   (list2 . (make-list 12 "shooveedoowaa")))
  100000
  (joaot/bench (cl-nset-difference list1 list2))
  (joaot/bench (cl-set-difference list1 list2))
  (joaot/bench (seq-difference list1 list2 #'eql))
  (joaot/bench (seq-difference-3 list1 list2 #'eql)))

(joaot/with-benchmark-group "set difference, big lists, custom pred"
  ((list1 . (all-completions "" obarray))
   (list2 . (make-list 12 "shooveedoowaa")))
  5
  (byte-compile (defun myequal (a b) (equal a b)))
  (joaot/bench (cl-nset-difference list1 list2 :test #'myequal))
  (joaot/bench (cl-set-difference list1 list2 :test #'myequal))
  (joaot/bench (seq-difference-3 list1 list2 #'myequal))
  (joaot/bench (seq-difference list1 list2 #'myequal)))

(joaot/with-benchmark-group "set difference, small lists, custom pred"
  ((list1 . (make-list 12 "bla"))
   (list2 . (make-list 12 "shooveedoowaa")))
  100000
  (byte-compile (defun myequal (a b) (equal a b)))
  (joaot/bench (cl-nset-difference list1 list2 :test #'myequal))
  (joaot/bench (cl-set-difference list1 list2 :test #'myequal))
  (joaot/bench (seq-difference-3 list1 list2 #'myequal))
  (joaot/bench (seq-difference list1 list2 #'myequal)))

(joaot/with-benchmark-group "\"some\" operation, big lists"
  ((list1 . (make-list 100000 nil)))
  100
  (joaot/bench (cl-some #'identity list1))
  (joaot/bench (seq-some #'identity list1)))

(joaot/with-benchmark-group "\"some\" operation, small lists"
  ((list1 . (make-list 10 nil)))
  100000
  (joaot/bench (cl-some #'identity list1))
  (joaot/bench (seq-some #'identity list1)))

(joaot/with-benchmark-group "destructuring"
  ((list1 . (make-list 3 0)))
  100000
  (joaot/bench (pcase-let ((`(,a ,b ,c) list1)) (+ a b c)))
  (joaot/bench (cl-destructuring-bind (a b c) list1 (+ a b c)))
  (joaot/bench (seq-let (a b c) list1 (+ a b c))))