Work on functional updates.

src/util-bst.scm

@@ -34,6 +34,8 @@
 
   list->bst
 
+  bst-update
+
   util-bst-tests!
   )
 
@@ -41,7 +43,8 @@
 	 (chicken condition)
 	 (chicken sort)
 	 util-tag
-	 testing)
+	 testing
+	 racket-kwargs)
 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Node
@@ -348,6 +351,25 @@
 		(cons subtag
 		      (cons EQ? <?))))))
 
+ (define*/doc (bst-update bst k proc (v #f))
+   ("")
+   (let-comparators
+    (EQ? <? bst)
+    (let-values	(((new-root add-count)
+		  (let loop ((n (bst-root bst)))
+		    (if n
+			(let ((nk (bst-node-key n)))
+			  (if (EQ? k nk)
+			      (values (set-bst-node-value n (proc (bst-node-value n)))
+				      0)
+			      (if (<? k nk)
+				  (loop (bst-node-left n))
+				  (loop (bst-node-right n)))))
+			(values (make-bst-node k (proc v)) 1)))))
+      (set-bst-root+count bst
+			  new-root
+			  (+ (bst-count bst) add-count)))))
+
  ;; Module self-tests
  (define (util-bst-tests!)
    (run-tests