diff --git a/src/util-bst.scm b/src/util-bst.scm index 10948d6..8ad2d57 100644 --- a/src/util-bst.scm +++ b/src/util-bst.scm @@ -16,12 +16,21 @@ bst-set bst-remove + ;; bst-update - ;;bst->kvv - ;;kvv->bst - ;;kvv-filter + bst-keys + + bst->kvv + kvv->bst + kvv-filter - ;;bst-balance + bst-balance + + ;; bst-find-pair + ;; bst-filter-pairs + + ;; bst-map-list + ;; bst-map-dict util-bst-tests! ) @@ -213,6 +222,79 @@ new-root (- (bst-count bst) sub-count)))))) + ;; Unique tag for static vector representation that retains type info + (define TAG-KVV (make-tag kvv)) + + ;; Iterates over given BST and passes the KV pairs to given proc + (define (bst-iter-kv bst proc) + (let-comparators + (EQ? kvv bst) + (let ((vec (make-vector (bst-count bst))) + (idx 0)) + (bst-iter-kv bst + (lambda (kv) + (vector-set! vec idx kv) + (set! idx (add1 idx)))) + (cons TAG-KVV + (cons vec + (cddr bst))))) + + ;; Converts a vector of key-value cons cells to BST dictionary + (define (kvv->bst kvv) + (let* ((vec (cadr kvv)) + (count (vector-length vec))) + (cons TAG-BST + (cons (cons (let loop ((s 0) + (e count)) + (if (= s e) + #f + (let* ((c (- e s)) + (h (quotient c 2)) + (m (+ s h)) + (kv (vector-ref vec m))) + (cons kv + (cons (loop s m) + (loop (add1 m) e)))))) + count) + (cddr kvv))))) + + ;; Returns KVV that contains only KV pairs matching pred? + (define (kvv-filter kvv pred?) + (cons (car kvv) + (cons (apply vector + (let ((vec (cadr kvv))) + (let loop ((idx (sub1 (vector-length vec))) + (res '())) + (if (< idx 0) + res + (let ((kv (vector-ref vec idx))) + (loop (if (pred? (car kv) (cdr kv)) + (cons kv res) + res))))))) + (cddr kvv)))) + + (define/doc (bst-balance bst) + ("Unconditionally balances the BST.") + (kvv->bst + (bst->kvv bst))) + ;; Module self-tests (define (util-bst-tests!) (run-tests @@ -241,12 +323,25 @@ (bst-count (make-bst 'fixnum eq? <)) 0) - (test-equal? bst-count + (test-equal? bst-set (bst-count (bst-set (make-bst 'fixnum eq? <) 1 2)) 1) + (test-true bst-remove + (bst-empty? + (bst-remove + (bst-set + (make-bst 'fixnum eq? <) + 1 2) 1))) + (test-equal? bst-balance + (bst-count + (bst-balance + (bst-set + (make-bst 'fixnum eq? <) + 1 2))) + 1) )) )