Work on functional updates.

src/Makefile

@@ -155,7 +155,7 @@ MBASE-SOURCES=mbase.scm testing.import.scm util-dict-list.import.scm	\
 	 cal-period.import.scm cal-month.import.scm			\
 	 configuration.import.scm progress.import.scm			\
 	 mbase-dir.import.scm util-tag.import.scm			\
-	 racket-kwargs.import.scm util-dict-bst.import.scm		\
+	 racket-kwargs.import.scm util-bst-dict.import.scm		\
 	 util-list.import.scm
 
 mbase.o: mbase.import.scm

src/mbase.scm

@@ -82,7 +82,7 @@
 	 mbase-dir
 	 util-tag
 	 racket-kwargs
-	 util-dict-bst)
+	 util-bst-dict)
 
  ;; Constant unique tag
  (define TAG-MBASE (make-tag mbase))

src/util-bst-dict.scm

@@ -14,6 +14,7 @@
   bdict-keys
   bdict-map-list
   bdict-map-dict
+  bdict-update
   )
 
  (import scheme
@@ -39,4 +40,6 @@
 
  (define bdict-map-dict bst-map-bst)
 
+ (define bdict-update bst-update)
+
  )

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