Start working on generic BST backend for dictionaries and sets.

src/Makefile

@@ -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	\
 	 util-utf8.o sgr-cell.o template-list-expander.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			\
 	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.import.scm: $(DUCK-SOURCES)
 duck.o: duck.import.scm
+duck.import.scm: $(DUCK-SOURCES)
 
 DUCK-EXTRACT-SOURCES=duck-extract.scm util-proc.import.scm
 
 duck-extract.o: duck-extract.import.scm
 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)

src/util-bst.scm

@@ -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
+    ))
+
+ )