Polishing and testing bdict implementation.

src/util-dict-bst.scm

@@ -39,6 +39,11 @@
   
   bdict-set
   bdict-remove
+  bdict-update
+
+  bdict-find-pair
+  bdict-find-value
+  bdict-find-key
 
   bdict-reduce
 
@@ -58,7 +63,7 @@
  (define TAG-BDICT (make-tag dict-bst))
 
  ;; Creates BST node with no children
- (define (make-bst-node key value . lrs)
+ (define (make-bst-node key value)
    (cons (cons key value)
 	 (cons #f #f)))
 
@@ -137,13 +142,56 @@
     (let loop ((n (bdict-root d)))
       (if n
 	  (let ((nk (bst-node-key n)))
-	    (if (eq? n nk)
+	    (if (eq? k nk)
 		(set-bst-node-value n v)
 		(if (< k nk)
 		    (set-bst-node-left n (loop (bst-node-left n)))
 		    (set-bst-node-right n (loop (bst-node-right n))))))
 	  (make-bst-node k v)))))
 
+ ;; Functional update with optional default value (defaults to #f)
+ (define (bdict-update d k p . vs)
+   (let ((v (if (null? vs)
+		#f
+		(car vs))))
+     (set-bdict-root
+      d
+      (let loop ((n (bdict-root d)))
+	(if n
+	    (let ((nk (bst-node-key n)))
+	      (if (eq? k nk)
+		  (set-bst-node-value n (p (bst-node-value n)))
+		  (if (< k nk)
+		      (set-bst-node-left n (loop (bst-node-left n)))
+		      (set-bst-node-right n (loop (bst-node-right n))))))
+	    (make-bst-node k (p v)))))))
+
+ ;; Finds key-value pair based on predicate - linear search from left
+ ;; to right
+ (define (bdict-find-pair d p?)
+   (let loop ((n (bdict-root d)))
+     (if n
+	 (let ((l (loop (bst-node-left n))))
+	   (or l
+	       (if (p? (bst-node-key n) (bst-node-value n))
+		   (car n)
+		   (loop (bst-node-right n)))))
+	 #f)))
+
+ ;; Finds value based on predicate
+ (define (bdict-find-value d p?)
+   (let ((p (bdict-find-pair d p?)))
+     (if p
+	 (cdr p)
+	 #f)))
+
+ ;; Finds key based on predicate
+ (define (bdict-find-key d p?)
+   (let ((p (bdict-find-pair d p?)))
+     (if p
+	 (car p)
+	 #f)))
+
  ;; Returns a dictionary with given key removed, if last argument is
  ;; #t, allows "removing" non-existent keys
  (define (bdict-remove d k . nos)
@@ -222,11 +270,22 @@
    (vector->bdict
     (bdict->vector d)))
 
+ ;; Returns a list
+ (define (bdict-filter d p)
+   '())
+
  ;; Performs module self-tests
  (define (bdict-tests!)
    (run-tests
     bdict
     (test-equal? make-bdict (make-bdict) `(,TAG-BDICT . #f))
+    (test-true bdict-empty?
+	       (bdict-empty? (make-bdict)))
+    (test-false bdict-set/bdict-empty?
+		(bdict-empty?
+		 (bdict-set
+		  (make-bdict)
+		  1 "Hello")))
     (test-true bdict-set/bdict-contains?
 	       (bdict-contains?
 		(bdict-set
@@ -280,6 +339,57 @@
 		     2 "World")
 		    3 "BST")))
 		 '(1 2 3))
+    (test-equal? bdict-values
+		 (bdict-values
+		  (bdict-balance
+		   (bdict-set
+		    (bdict-set
+		     (bdict-set
+		      (make-bdict)
+		      1 "Hello")
+		     2 "World")
+		    3 "BST")))
+		 '("Hello" "World" "BST"))
+    (test-exn bdict-ref
+	      (bdict-ref (make-bdict) 1))
+    (test-equal? bdict-ref
+		 (bdict-ref
+		  (bdict-set
+		   (bdict-set
+		    (bdict-set
+		     (make-bdict)
+		     1 "Hello")
+		    2 "World")
+		   3 "BST")
+		  2)
+		 "World")
+    (test-equal? bdict-update
+		 (bdict-ref
+		  (bdict-update
+		   (bdict-set
+		    (bdict-set
+		     (bdict-set
+		      (make-bdict)
+		      1 "Hello")
+		     2 "World")
+		    3 "BST")
+		   2
+		   (lambda (v)
+		     "Scheme"))
+		  2)
+		 "Scheme")
+    (test-equal? bdict-find-pair
+		 (bdict-find-pair
+		  (bdict-set
+		   (bdict-set
+		    (bdict-set
+		     (make-bdict)
+		     1 "Hello")
+		    2 "World")
+		   3 "BST")
+		  (lambda (k v)
+		    (equal? v "World")))
+		 (cons 2 "World"))
     ))
 
  )