Start working on generic BST backend for dictionaries and sets.

This commit is contained in:
Dominik Pantůček 2023-07-06 21:42:21 +02:00
parent b9a563d4ac
commit 8d6ca4697c
2 changed files with 76 additions and 2 deletions

View file

@ -55,7 +55,7 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o \
table-processor.o table-border.o table-style.o sgr-state.o \ table-processor.o table-border.o table-style.o sgr-state.o \
util-utf8.o sgr-cell.o template-list-expander.o \ util-utf8.o sgr-cell.o template-list-expander.o \
box-drawing.o util-list.o export-web-static.o util-dir.o \ box-drawing.o util-list.o export-web-static.o util-dir.o \
dokuwiki.o racket-kwargs.o duck.o dokuwiki.o racket-kwargs.o duck.o util-bst.o
GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \
util-time.import.scm util-csv.import.scm util-git.import.scm \ util-time.import.scm util-csv.import.scm util-git.import.scm \
@ -510,10 +510,15 @@ dokuwiki.import.scm: $(DOKUWIKI-SOURCES)
DUCK-SOURCES=duck.scm DUCK-SOURCES=duck.scm
duck.import.scm: $(DUCK-SOURCES)
duck.o: duck.import.scm duck.o: duck.import.scm
duck.import.scm: $(DUCK-SOURCES)
DUCK-EXTRACT-SOURCES=duck-extract.scm util-proc.import.scm DUCK-EXTRACT-SOURCES=duck-extract.scm util-proc.import.scm
duck-extract.o: duck-extract.import.scm duck-extract.o: duck-extract.import.scm
duck-extract.import.scm: $(DUCK-EXTRACT-SOURCES) duck-extract.import.scm: $(DUCK-EXTRACT-SOURCES)
UTIL-BST-SOURCES=util-bst.scm util-tag.import.scm testing.import.scm
util-bst.o: util-bst.import.scm
util-bst.import.scm: $(UTIL-BST-SOURCES)

69
src/util-bst.scm Normal file
View file

@ -0,0 +1,69 @@
(declare (unit util-bst))
(import duck)
(module*
util-bst
#:doc ("Binary Search Tree implementation")
(
make-bst
bst?
bst-empty?
;;bst-ref
;;bst-contains?
;;bst-set
;;bst-remove ;;
;;bst->kvv
;;kvv->bst
;;kvv-filter
;;bst-balance
)
(import scheme
util-tag
testing)
;; Unique tags
(define TAG-BST (make-tag 'bst))
(define TAG-KVV (make-tag 'kvv))
(define/doc (make-bst subtag EQ? <?)
("Creates empty BST with given comparators")
(cons TAG-BST
(cons (cons #f 0)
(cons subtag
(cons EQ? <?)))))
;; BST accessors
(define bst-tag car)
(define bst-root+count cadr)
(define bst-root caadr)
(define bst-count cdadr)
(define bst-type cddr)
(define bst-subtag caddr)
(define bst-comparators cdddr)
(define bst-EQ? cadddr)
(define bst-<? cddddr)
(define/doc ((bst? subtag) v)
("Curried predicate for particular bst type.")
(and (pair? v)
(eq? (bst-tag v) TAG-BST)
(eq? (bst-subtag v) subtag)))
(define/doc (bst-empty? bst)
("Returns #t if given BST is empty.")
(not (bst-root bst)))
;; Module self-tests
(define (util-bst-tests!)
(run-tests
util-bst
))
)