From 99da463f843f9ce92bb4e7b2e91e4d00401f2fc5 Mon Sep 17 00:00:00 2001
From: Jesse McDonald <nybble41@gmail.com>
Date: Mon, 25 Apr 2011 15:48:46 -0500
Subject: [PATCH] Add the ability to remove keys from a hash table.

---
 src/hash-table.rls      | 36 ++++++++++++++++++++++++++++++++++++
 src/test-hash-table.rls | 30 ++++++++++++++++++++++--------
 2 files changed, 58 insertions(+), 8 deletions(-)

diff --git a/src/hash-table.rls b/src/hash-table.rls
index ee1accd..f126c4d 100644
--- a/src/hash-table.rls
+++ b/src/hash-table.rls
@@ -82,4 +82,40 @@
                       (hash-table-node-right-child-set! node
                        (make-hash-table-node hash key val))))]))))))
 
+(define (hash-table-remove ht key [not-found (lambda () #f)])
+  (let ([hash ((hash-table-hash-function ht) key)]
+        [eq-fn (hash-table-eq-function ht)])
+    (let search ([node (hash-table-root-node ht)]
+                 [replace-node! (lambda (n) (hash-table-root-node-set! ht n))])
+      (if node
+          (let ([node-hash (hash-table-node-hash node)])
+            (cond
+              [(and (fix= hash node-hash)
+                    (eq-fn (hash-table-node-key node) key))
+                (let ([oldval (hash-table-node-value node)]
+                      [left   (hash-table-node-left-child node)]
+                      [right  (hash-table-node-right-child node)])
+                  (cond
+                    [(not left) (replace-node! right)]
+                    [(not right) (replace-node! left)]
+                    [else 
+                      (let find-leftmost ([parent node] [lnode right])
+                        (let ([lc (hash-table-node-left-child lnode)])
+                          (if lc
+                              (find-leftmost lnode lc)
+                              (let ([rc (hash-table-node-right-child lnode)])
+                                (hash-table-node-left-child-set! parent rc)
+                                (hash-table-node-left-child-set! lnode left)
+                                (unless (eq? lnode right)
+                                  (hash-table-node-right-child-set! lnode right))
+                                (replace-node! lnode)))))])
+                  oldval)]
+              [(fix<= hash node-hash)
+                (search (hash-table-node-left-child node)
+                        (lambda (n) (hash-table-node-left-child-set! node n)))]
+              [else
+                (search (hash-table-node-right-child node)
+                        (lambda (n) (hash-table-node-right-child-set! node n)))]))
+          (not-found)))))
+
 ; vim:set syntax=scheme sw=2 expandtab:
diff --git a/src/test-hash-table.rls b/src/test-hash-table.rls
index 84d789b..2bc539c 100644
--- a/src/test-hash-table.rls
+++ b/src/test-hash-table.rls
@@ -3,15 +3,29 @@
 
 (define ht (make-hash-table))
 
-(hash-table-insert ht "test" 5)
-(hash-table-insert ht "a longer key" '(4 5 6))
-(hash-table-insert ht '(9 8 7) "backwards")
+(define (foreach fn lst)
+  (when (pair? lst)
+    (fn (car lst))
+    (foreach fn (cdr lst))))
+
+(let ([insert (lambda (x) (hash-table-insert ht x x))])
+  (foreach insert '(47 32 18 90 46 38 21 93 49 10 92 34 71)))
 
 (values
-  (hash-table-lookup ht "test")
-  (hash-table-lookup ht "no such key")
-  (hash-table-lookup ht "a longer key")
-  (hash-table-lookup ht '(7 8 9))
-  (hash-table-lookup ht '(9 8 7)))
+  (hash-table-remove ht 92)
+  (hash-table-remove ht 71)
+  (hash-table-remove ht 49)
+  (hash-table-remove ht 46)
+  (hash-table-remove ht 47)
+  (hash-table-remove ht 21)
+  (hash-table-remove ht 30)
+  (hash-table-remove ht 34)
+  (hash-table-remove ht 18)
+  (hash-table-remove ht 32)
+  (hash-table-remove ht 90)
+  (hash-table-remove ht 10)
+  (hash-table-remove ht 38)
+  (hash-table-remove ht 93)
+  )
 
 ; vim:set syntax=scheme sw=2 expandtab: