; hash tables with open addressing
(define (string-hash str)
(let loop ((cs (string->list str)) (s 0))
(if (null? cs) s
(loop (cdr cs) (+ (* s 31)
(char->integer (car cs)))))))
(define (make-hash m) (make-vector m #f))
(define (lookup eql? h t k)
(let ((m (vector-length t)) (j (h k)))
(let loop ((i 0))
(let ((j+i (modulo (+ j i) m)))
(cond ((= i m) #f)
((not (vector-ref t j+i)) #f)
((null? (vector-ref t j+i)) (loop (+ i 1)))
((eql? (car (vector-ref t j+i)) k)
(vector-ref t j+i))
(else (loop (+ i 1))))))))
(define (insert eql? h t k v)
(let ((m (vector-length t)) (j (h k)))
(let loop ((i 0))
(let ((j+i (modulo (+ j i) m)))
(cond ((= i m) (error 'insert "overflow"))
((not (vector-ref t j+i))
(vector-set! t j+i (cons k v)) t)
((null? (vector-ref t j+i))
(vector-set! t j+i (cons k v)) t)
((eql? (car (vector-ref t j+i)) k)
(vector-set! t j+i (cons k v)) t)
(else (loop (+ i 1))))))))
(define (delete eql? h t k)
(let ((m (vector-length t)) (j (h k)))
(let loop ((i 0))
(let ((j+i (modulo (+ j i) m)))
(cond ((= i m) t)
((not (vector-ref t j+i)) t)
((null? (vector-ref t j+i))
(loop (+ i 1)))
((eql? (car (vector-ref t j+i)) k)
(vector-set! t j+i (list)) t)
(else (loop (+ i 1))))))))
(define (enlist t)
(let loop ((m (vector-length t)) (kvs (list)))
(cond ((zero? m) kvs)
((not (vector-ref t (- m 1))) (loop (- m 1) kvs))
((null? (vector-ref t (- m 1))) (loop (- m 1) kvs))
(else (loop (- m 1) (cons (vector-ref t (- m 1)) kvs))))))
(define t (make-hash 20))
(set! t (insert string=? string-hash t "aaa" 1))
(set! t (insert string=? string-hash t "bbb" 2))
(set! t (insert string=? string-hash t "ccc" 3))
(set! t (insert string=? string-hash t "ddd" 4))
(set! t (insert string=? string-hash t "eee" 5))
(display t) (newline)
(set! t (insert string=? string-hash t "xxx" 24))
(set! t (delete string=? string-hash t "ccc"))
(display t) (newline)
(display (lookup string=? string-hash t "ddd")) (newline)
(display (lookup string=? string-hash t "ccc")) (newline)
(display (enlist t)) (newline)
(set! t (delete string=? string-hash t "xxx"))
(display t) (newline)