(set! (*s7* 'heap-size) (* 12 1024000))

(define (reader)
  (let ((port (open-input-file "/home/bil/cl/bib"))
	(counts (make-hash-table))
	(start 0)
	(end 0)
	(new-pos 0))
    (do ((line (read-line port) (read-line port)))
	((eof-object? line))
      (set! new-pos 0)
      (do ((pos (char-position #\space line) (char-position #\space line (+ pos 1))))
	  ((not pos))
	(unless (= pos new-pos)
	  (set! start 
		(if (char-alphabetic? (string-ref line new-pos))
		    new-pos
		    (do ((k (+ new-pos 1) (+ k 1))) ; char-position here is slower!
			((or (char-alphabetic? (string-ref line k))
			     (>= k pos))
			 k))))
	  (set! end 
		(if (char-alphabetic? (string-ref line (- pos 1)))
		    pos
		    (do ((k (- pos 2) (- k 1)))
			((or (char-alphabetic? (string-ref line k))
			     (<= k start))
			 (+ k 1)))))
	  (when (> end start)
	    (let ((word (string->symbol (substring line start end))))
	      (hash-table-set! counts word (+ (or (hash-table-ref counts word) 0) 1)))))
	(set! new-pos (+ pos 1))))
    (close-input-port port)
    (sort! (copy counts (make-vector (hash-table-entries counts)))
	   (lambda (a b) (> (cdr a) (cdr b))))))

(format *stderr* "reader ")

(let ((counts (reader)))
  (unless (and (eq? (car (counts 0)) 'the)
	       (= (cdr (counts 0)) 62063))
    (do ((i 0 (+ i 1))) 
	((= i 40)) 
      (format *stderr* "~A: ~A~%" (car (counts i)) (cdr (counts i))))))

;; 1109: eval 254, resize_heap_to, fx_c_sss, fx_c_opssq_direct, fx_add_s1, make_symbol

;;; ----------------------------------------

(define global-val 0) ; for reader-cond in s7test.scm

(let ()
  (define (walk p counts)
    (if (pair? p)
	(begin
	  (walk (car p) counts)
	  (if (pair? (cdr p))
	      (walk (cdr p) counts)))
	(hash-table-set! counts p (+ (or (hash-table-ref counts p) 0) 1))))
  
  (define (s7test-reader)
    (let ((port (open-input-file "s7test.scm"))
	  (counts (make-hash-table)))
      (do ((expr (read port) (catch #t (lambda () (read port)) (lambda args 'error))))
	  ((eof-object? expr) 
	   (close-input-port port)
	   counts)
	(walk expr counts))))
  
  (define (sort-counts counts)
    (let ((len (hash-table-entries counts)))
      (do ((v (make-vector len))
	   (h (make-iterator counts))
	   (i 0 (+ i 1)))
	  ((= i len)
	   (sort! v (lambda (e1 e2) (> (cdr e1) (cdr e2))))
	   v)
	(vector-set! v i (iterate h)))))
  
  (sort-counts (s7test-reader)))

;; 1658: hash_equal_real 446, eval 257, hash_equal_complex 230, hash_equal_integer 175, hash_equal_ratio 144

;;; ----------------------------------------

(let ()
  (define (hash-ints calls)
    (let ((counts (make-hash-table)))
      (do ((i 0 (+ i 1))
	   (z (random 100) (random 100)))
	  ((= i calls) i)
	(hash-table-set! counts z (+ (or (hash-table-ref counts z) 0) 1)))))

  (let ((val (hash-ints 5000000)))
    (unless (= val 5000000)
      (format *stderr* "thash hash-ints: ~S?~%" val))))
;; 542: 184 fx_hash_table_increment_1, 135 fx_random_i, 80 hash_int, 51 resize_heap_to, 50 op_dox, 40 :opt_p_ppp_hash_table_increment

;;; ----------------------------------------

(define symbols (make-vector 1))
(define strings (make-vector 1))

(define (test1 size)
  (let ((int-hash (make-hash-table size))
	(p (cons #f #f)))
    (do ((i 0 (+ i 1))) 
	((= i size))
      (hash-table-set! int-hash i i))
    (do ((i 0 (+ i 1)))	
	((= i size))
      (unless (= (hash-table-ref int-hash i) i)
	  (display "oops")))
    (for-each (lambda (key&value)
		(unless (= (car key&value) (cdr key&value))
		    (display "oops"))) ;(format *stderr* "hash iter ~A~%" key&value)))
	      (make-iterator int-hash p))
    (set! int-hash #f)))

(define (test2 size)
  (let ((int-hash (make-hash-table size =)))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (hash-table-set! int-hash i i))
    (do ((i 0 (+ i 1)))	
	((= i size))
      (unless (= (hash-table-ref int-hash i) i)
	  (display "oops")))
    (set! int-hash #f)))

(define (test3 size)
  (let ((flt-hash (make-hash-table size)))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (hash-table-set! flt-hash (* i 2.0) i))
    (do ((i 0 (+ i 1)))	
	((= i size))
      (unless (= (hash-table-ref flt-hash (* 2.0 i)) i)
	  (display "oops")))
    (set! flt-hash #f)))

(define (random-string)
  (let* ((len (+ 1 (random 8)))
	 (s (make-string len)))
    (do ((i 0 (+ i 1)))
	((= i len) s)
      (string-set! s i (integer->char (+ 20 (random 100)))))))

(define (test4 size)
  (let ((sym-hash (make-hash-table size)))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (hash-table-set! sym-hash (vector-set! symbols i (string->symbol (vector-set! strings i (number->string i)))) i))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (unless (= (hash-table-ref sym-hash (vector-ref symbols i)) i)
	  (display "oops")))
    (set! sym-hash #f)))

(define (test5 size)
  (let ((str-hash (make-hash-table size eq?))) ; string=? here is pessimal because number->string above ruins hash_map_string
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (hash-table-set! str-hash (vector-ref strings i) i))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (unless (= (hash-table-ref str-hash (vector-ref strings i)) i)
	  (display "oops")))
    (set! str-hash #f)))

(define (test6 size)
  (let ((sym-hash (make-hash-table size eq?)))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (hash-table-set! sym-hash (vector-ref symbols i) i))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (unless (= (hash-table-ref sym-hash (vector-ref symbols i)) i)
	  (display "oops")))
    (set! sym-hash #f)))

(define (test7 size)
  (let ((chr-hash (make-hash-table 256 char=?)))
    (do ((i 0 (+ i 1))) 
	((= i 256)) 
      (hash-table-set! chr-hash (integer->char i) i))
    (do ((i 0 (+ i 1))) 
	((= i 256)) 
      (unless (= (hash-table-ref chr-hash (integer->char i)) i)
	  (display "oops")))
    (set! chr-hash #f)))

(define (test8 size)
  (let ((any-hash (make-hash-table size eq?)))
    (if (= size 1)
	(hash-table-set! any-hash (vector-set! strings 0 (list 0)) 0)
	(begin
	  (do ((i 0 (+ i 2)))
	      ((= i size))
	    (hash-table-set! any-hash (vector-set! strings i (list i)) i))
	  (do ((j 1 (+ j 2)))
	      ((>= j size))
	    (hash-table-set! any-hash (vector-set! strings j (int-vector j)) j))))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (unless (= i (hash-table-ref any-hash (vector-ref strings i)))
	  (display "oops")))
    (set! any-hash #f)))

(when (provided? 'pure-s7)
  (define (vector-fill! vect val . args)
    (if (vector? vect)
	(apply fill! vect val args)
	(error 'wrong-type-arg "vector-fill! argument should be a vector: ~A" str))))

(define (test9 size)
  (let ((any-hash1 (make-hash-table size eq?)))
    (if (= size 1)
	(hash-table-set! any-hash1 (vector-set! strings 0 (inlet 'a 0)) 0)
	(begin
	  (do ((i 0 (+ i 2)))
	      ((= i size))
	    (hash-table-set! any-hash1 (vector-set! strings i (inlet 'a i)) i))
	  (do ((j 1 (+ j 2))
	       (x 0.0 (+ x 2.0)))
	      ((>= j size))
	    (hash-table-set! any-hash1 (vector-set! strings j (float-vector x)) j))))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (unless (= i (hash-table-ref any-hash1 (vector-ref strings i)))
	  (display "oops")))
    (vector-fill! strings #f)
    (set! any-hash1 #f)))

(define (test10 size)
  (let ((cmp-hash (make-hash-table size =)))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (hash-table-set! cmp-hash (complex i i) i))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (unless (= (hash-table-ref cmp-hash (complex i i)) i)
	  (display "oops")))
    (set! cmp-hash #f)))

(define (test11 size)
  (let ((int-hash (make-hash-table size equivalent?)))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (hash-table-set! int-hash i i))
    (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-6))
      (do ((i 0 (+ i 1)))	
	  ((= i size))
	(unless (= (hash-table-ref int-hash (+ i (random 9.0e-7))) i)
	  (display "oops"))
	(unless (= (hash-table-ref int-hash (- i (random 9.0e-7))) i)
	  (display "oops"))
	(when (hash-table-ref int-hash (- i 1.0e-5 (random 1.0e-6)))
	  (display "oops")))
      (set! int-hash #f))))

(define (test12 size)
  (let ((rat-hash (make-hash-table size eqv?)))
    (do ((i 0 (+ i 1))) 
	((= i size))
      (hash-table-set! rat-hash (/ i 3) i))
    (do ((i 0 (+ i 1)))
	((= i size))
      (unless (= (hash-table-ref rat-hash (/ i 3)) i)
	(display "oops")))
    (set! rat-hash #f)))

(define (test13 size)
  (let ((vct-hash (make-hash-table size equal?)))
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (hash-table-set! vct-hash (float-vector i) i))
    (do ((i 0 (+ i 1)))	
	((= i size))
      (unless (= (hash-table-ref vct-hash (float-vector i)) i)
	(display "oops")))
    (set! vct-hash #f)))

(define (random-string-1)
  (let* ((len (+ 1 (random 20)))
	 (s (make-string len)))
    (do ((i 0 (+ i 1)))
	((= i len) s)
      (string-set! s i (integer->char (+ 20 (random 100)))))))
  
(define (test14 size)
  (when (< size 1000000) ; random-string is not interesting in this context
    (do ((i 0 (+ i 1))) 
	((= i size)) 
      (vector-set! strings i (random-string-1)))
    (let ((str-hash (make-hash-table size string=?)))
      (do ((i 0 (+ i 1))) 
	  ((= i size)) 
	(hash-table-set! str-hash (vector-ref strings i) i))
      (do ((i 0 (+ i 1))) 
	  ((= i size)) 
	(unless (hash-table-ref str-hash (vector-ref strings i))
	  (display "oops")))
      (set! str-hash #f))))

;; tmisc.scm has hash-table + typers

(define (test-hash size)
  (format *stderr* "~D " size)
  (set! symbols (make-vector size))
  (set! strings (make-vector size))
  (test1 size)
  (test2 size)
  (test3 size)
  (test4 size)
  (test5 size)
  (test6 size)
  (test7 size)
  (test8 size)
  (test9 size)
  (test10 size)
  (test11 size)
  (test12 size)
  (test13 size)
  (test14 size))

(for-each test-hash (list 1 10 100 1000 10000 100000 1000000))
(newline)

(when (> (*s7* 'profile) 0)
  (show-profile 200))
(exit)