(use extras)
(use llrb-tree srfi-69)
(import (prefix llrb-m-fixnum-table mu:))
(define y (fixnum-make-table))

;; Check basic update working at least once.
(fixnum-table-update! y 23 add1 (lambda () 41))
(ensure (lambda (x) (= x 42)) (fixnum-table-ref y 23))

(define numttype (make-llrb-treetype number? = <))
(define nt (make-table numttype))
(table-update! nt 42.23 add1 (lambda () 22))
(ensure (lambda (x) (= x 23)) (table-ref nt 42.23))
(receive
 (n v) (table-min nt (lambda () (values #f #f)))
 (or (and (= n 42.23) (= v 23)) (error "unexpected values in generic table")))

(define strttype
  (let ((equal (lambda (a b) (or (eq? a b) (string=? a b)))))
    (make-llrb-treetype string? equal string<?)))

(define nk 1000000)
;;(define nk 10000)

(define keys (make-vector nk))
(define rkeys (make-vector nk))
(define skeys (make-vector nk))

(define (init-keys!)
  (do ((i 0 (add1 i)))
      ((= i nk))
    (let* ((r (random 20000000))
	   (s (number->string r)))
      (vector-set! keys i r)
      (vector-set! rkeys i s)
      (vector-set! skeys i (string->symbol s)))))

(define (test-once-ht)
  (let* ((tbl (make-hash-table =))
	 (t0 (current-milliseconds)))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Hashtable ~a inserts in ~a\n" nk (- (current-milliseconds) t0)))
      (hash-table-set! tbl (vector-ref keys i) #t))
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Hashtable ~a refs in ~a\n" nk (- (current-milliseconds) t0)))
      (hash-table-ref/default tbl (vector-ref keys i #;(random nk)) #t))))

;; The same using fixum-table as LLRB.
(define (test-once-tt)
  (let* ((tbl (fixnum-make-table))
	 (t0 (current-milliseconds)))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Fixnumtable ~a inserts in ~a\n" nk (- (current-milliseconds) t0)))
      (fixnum-table-set! tbl (vector-ref keys i) #t))
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Fixnumtable ~a refs in ~a\n" nk (- (current-milliseconds) t0)))
      (fixnum-table-ref/default tbl (vector-ref keys i #;(random nk)) #t))))

;; The same using mutating fixum-table as LLRB.
(define (test-once-tmt)
  (let* ((tbl (mu:make-fixnum-table))
	 (t0 (current-milliseconds)))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "FixMnumtable ~a inserts in ~a\n" nk (- (current-milliseconds) t0)))
      (mu:fixnum-table-set! tbl (vector-ref keys i) #t))
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "FixMnumtable ~a refs in ~a\n" nk (- (current-milliseconds) t0)))
      (mu:fixnum-table-ref/default tbl (vector-ref keys i #;(random nk)) #t))))

;; Simillar using generic-table as LLRB.
(define (test-once-gt)
  (let* ((tbl (make-table numttype))
	 (t0 (current-milliseconds)))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Generictable ~a inserts in ~a\n" nk (- (current-milliseconds) t0)))
      (table-set! tbl (vector-ref keys i) #t))
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Generictable ~a refs in ~a\n" nk (- (current-milliseconds) t0)))
      (table-ref/default tbl (vector-ref keys i #;(random nk)) #t))))

;; Pure, alist-alike API with symbols as key.
(define (test-once-st)
  (let* ((t0 (current-milliseconds))
	 (tbl #f))
    (do ((i 0 (add1 i))
	 (tree (symbol-empty-binding-set)
	       (symbol-binding-set-cons (vector-ref skeys i) #t tree)))
	((= i nk)
	 (set! tbl tree)
	 (format #t "Symboltree ~a inserts in ~a\n" nk (- (current-milliseconds) t0))))
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Symboltree ~a refs in ~a\n" nk (- (current-milliseconds) t0)))
      (symbol-binding-set-ref/default tbl (vector-ref skeys i #;(random nk)) #t))))

;; srfi-69 alternative to the above.
(define (test-once-sht)
  (let* ((t0 (current-milliseconds))
	 (tbl (make-hash-table eq? symbol-hash)))
    ;; Now let's compare apples to appels.  "Symboltree" above to hashtables having symbol-hash.
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Symbolhash ~a inserts in ~a\n" nk (- (current-milliseconds) t0)))
      (hash-table-set! tbl (vector-ref skeys i #;(random nk)) #f))
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Symbolhash ~a refs in ~a\n" nk (- (current-milliseconds) t0)))
      (hash-table-ref/default tbl (vector-ref skeys i #;(random nk)) #f))))

;; string->symbol vs. alternative
(define (test-once-str2sym)
  (let* ((t0 (current-milliseconds))
	 (tbl (string-make-table) #;(make-table strttype)))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "string->symbol ~a refs in ~a\n" nk (- (current-milliseconds) t0)))
      (string->symbol (vector-ref rkeys i #;(random nk))))

    ;; string->symbol wrapped by LLRB (improves lookup at the cost of
    ;; inserts - should be the right thing for string->symbol).
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "str2sym ~a refs in ~a\n" nk (- (current-milliseconds) t0)))
      (str2sym (vector-ref rkeys i #;(random nk))))
#|
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Str2Sym ~a initial updates in ~a\n" nk (- (current-milliseconds) t0)))
      (let ((k0 i))
	(string-table-update! tbl (vector-ref rkeys k0) #f (lambda () (vector-ref skeys k0)))))
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Str2Sym ~a update (sure hit) in ~a\n" nk (- (current-milliseconds) t0)))
      (let ((k0 i))
	(string-table-update! tbl (vector-ref rkeys k0) #f (lambda () (vector-ref skeys k0)))))
    ;; Redo with different insert strategy.
    (set! tbl (string-make-table))
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Str2Sym ~a ref (sure MISS) in ~a\n" nk (- (current-milliseconds) t0)))
      (let ((k0 i #;(random nk)))
	(string-table-ref
	 tbl (vector-ref rkeys k0)
	 (lambda ()
	   (let ((value (vector-ref skeys k0)))
	     (string-table-set! tbl (vector-ref rkeys k0) value)
	     value)))))

    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Str2Sym ~a refs/default (sure hit) in ~a\n" nk (- (current-milliseconds) t0)))
      (let ((k0 i #;(random nk)))
	(or (string-table-ref/default tbl (vector-ref rkeys k0) #f)
	    (let ((value (vector-ref skeys k0)))
	      (string-table-set! tbl (vector-ref rkeys k0) value)
	      value))))

    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Str2Sym ~a plain refs/d (sure hit) in ~a\n" nk (- (current-milliseconds) t0)))
      (string-table-ref/default tbl (vector-ref rkeys i #;(random nk)) #f))
    (set! tbl (string-make-table))
    (set! t0 (current-milliseconds))
    (do ((i 0 (add1 i)))
	((= i nk)
	 (format #t "Str2Sym ~a alt/upins in ~a\n" nk (- (current-milliseconds) t0)))
      (let ((k0 i #;(random nk)))
	(or (string-table-ref/default tbl (vector-ref rkeys k0) #f)
	    (let ((value (vector-ref skeys k0)))
	      (string-table-set! tbl (vector-ref rkeys k0) value)
	      value))))
    |#
    
))

(define (test-once)
  (gc #t)
  (test-once-ht)
  (gc #t)
  (test-once-tt)
  (gc #t)
  (test-once-gt)
  (gc #t)
  (test-once-st)
  (gc #t)
  (test-once-sht)
  (gc #t)
  (test-once-str2sym)
  )


(define (test-several)
  (do ((i 0 (add1 i)))
      ((= i 10))
    (gc #t)
    (test-once-ht))
  (do ((i 0 (add1 i)))
      ((= i 10))
    (gc #t)
    (test-once-tt))
  (do ((i 0 (add1 i)))
      ((= i 10))
    (gc #t)
    (test-once-tmt))
  (do ((i 0 (add1 i)))
      ((= i 10))
    (gc #t)
    (test-once-gt))
  (do ((i 0 (add1 i)))
      ((= i 10))
    (test-once-st))
  (do ((i 0 (add1 i)))
      ((= i 10))
    (gc #t)
    (test-once-sht))
  (do ((i 0 (add1 i)))
      ((= i 10))
    (gc #t)
    (test-once-str2sym))
  )

#;(begin
  (init-keys!)
  (format #t "Starting Benchmark\n")
  ;;(test-once)
  (test-several)
)
#;  (do ((i 0 (add1 i)))
      ((= i 10))
    (gc #t)
    (test-once-str2sym))