diff --git a/src/util-bst.scm b/src/util-bst.scm index 25559db..03b5cfc 100644 --- a/src/util-bst.scm +++ b/src/util-bst.scm @@ -11,10 +11,10 @@ bst? bst-empty? - ;;bst-ref - ;;bst-contains? + bst-ref + bst-contains? - ;;bst-set + bst-set ;;bst-remove ;; ;;bst->kvv @@ -27,12 +27,45 @@ ) (import scheme + (chicken condition) util-tag testing) - ;; Unique tags + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Node + + ;; Creates BST node with no children + (define (make-bst-node key value) + (cons (cons key value) + (cons #f #f))) + + ;; Read-only accessors to BST node + (define bst-node-kv car) + (define bst-node-key caar) + (define bst-node-value cdar) + (define bst-node-left cadr) + (define bst-node-right cddr) + + ;; Returns BST node with updated node value + (define (set-bst-node-value n v) + (cons (cons (bst-node-key n) v) + (cdr n))) + + ;; Updates BST node left child + (define (set-bst-node-left n l) + (cons (car n) + (cons l (bst-node-right n)))) + + ;; Updates BST node right child + (define (set-bst-node-right n r) + (cons (car n) + (cons (bst-node-left n) r))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; BST + + ;; Unique tag (define TAG-BST (make-tag bst)) - (define TAG-KVV (make-tag kvv)) (define/doc (make-bst subtag EQ?