From 2fe483c947fff2f18b73511504abf1ed6ef2d90b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Fri, 7 Jul 2023 11:01:27 +0200
Subject: [PATCH] Remove old bdict implementation.

---
 src/Makefile          |  16 +-
 src/tests.scm         |   4 +-
 src/util-dict-bst.scm | 459 ------------------------------------------
 3 files changed, 7 insertions(+), 472 deletions(-)
 delete mode 100644 src/util-dict-bst.scm

diff --git a/src/Makefile b/src/Makefile
index e0648c1..f5c4d86 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -51,7 +51,7 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o		\
 	 util-parser.o texts.o tests.o util-proc.o util-mail.o		\
 	 notifications.o util-format.o brmember-format.o logging.o	\
 	 specification.o util-git.o cal-day.o util-stdout.o		\
-	 cal-format.o util-dict-bst.o table.o sgr-list.o sgr-block.o	\
+	 cal-format.o table.o sgr-list.o sgr-block.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	\
@@ -317,10 +317,10 @@ TESTS-SOURCES=tests.scm listing.import.scm util-dict-list.import.scm	\
 	primes.import.scm brmember.import.scm util-csv.import.scm	\
 	util-set-list.import.scm util-parser.import.scm			\
 	util-string.import.scm cal-day.import.scm			\
-	util-dict-bst.import.scm util-utf8.import.scm			\
-	sgr-state.import.scm sgr-list.import.scm sgr-block.import.scm	\
-	template-list-expander.import.scm table-style.import.scm	\
-	box-drawing.import.scm
+	util-utf8.import.scm sgr-state.import.scm sgr-list.import.scm	\
+	sgr-block.import.scm template-list-expander.import.scm		\
+	table-style.import.scm box-drawing.import.scm			\
+	util-bst.import.scm
 
 tests.o: tests.import.scm
 tests.import.scm: $(TESTS-SOURCES)
@@ -405,12 +405,6 @@ CAL-FORMAT-SOURCES=cal-format.scm cal-day.import.scm cal-month.import.scm
 cal-format.o: cal-format.import.scm
 cal-format.import.scm: $(CAL-FORMAT-SOURCES)
 
-UTIL-DICT-BST-SOURCES=util-dict-bst.scm util-tag.import.scm	\
-	testing.import.scm
-
-util-dict-bst.o: util-dict-bst.import.scm
-util-dict-bst.import.scm: $(UTIL-DICT-BST-SOURCES)
-
 RACKET-KWARGS-SOURCES=racket-kwargs.scm
 
 racket-kwargs.o: racket-kwargs.import.scm
diff --git a/src/tests.scm b/src/tests.scm
index f5483ca..18970dd 100644
--- a/src/tests.scm
+++ b/src/tests.scm
@@ -46,7 +46,7 @@
 	 util-set-list
 	 util-parser
 	 util-string
-	 util-dict-bst
+	 util-bst
 	 util-utf8
 	 sgr-state
 	 sgr-list
@@ -59,7 +59,7 @@
    (listing-tests!)
    (lset-tests!)
    (ldict-tests!)
-   (bdict-tests!)
+   (util-bst-tests!)
    (cal-month-tests!)
    (cal-period-tests!)
    (cal-day-tests!)
diff --git a/src/util-dict-bst.scm b/src/util-dict-bst.scm
deleted file mode 100644
index 5764997..0000000
--- a/src/util-dict-bst.scm
+++ /dev/null
@@ -1,459 +0,0 @@
-;;
-;; util-dict-bst.scm
-;;
-;; Simple dictionary implementation using BST backend. Only numbers
-;; supported as keys.
-;;
-;; ISC License
-;;
-;; Copyright 2023 Brmlab, z.s.
-;; Dominik Pantůček <dominik.pantucek@trustica.cz>
-;;
-;; Permission to use, copy, modify, and/or distribute this software
-;; for any purpose with or without fee is hereby granted, provided
-;; that the above copyright notice and this permission notice appear
-;; in all copies.
-;; 
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
-;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
-;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
-;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
-;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
-;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
-;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
-
-(declare (unit util-dict-bst))
-
-(module
- util-dict-bst
- (
-  make-bdict
-
-  bdict?
-
-  bdict-empty?
-  bdict-contains?
-  bdict-ref
-  
-  bdict-set
-  bdict-remove
-  bdict-update
-
-  bdict-find-pair
-  bdict-find-value
-  bdict-find-key
-
-  bdict-reduce
-
-  bdict-keys
-  bdict-values
-
-  bdict-balance
-
-  bdict-filter-pairs
-  bdict-filter-keys
-  bdict-filter-values
-
-  list->bdict
-
-  bdict-map-list
-  bdict-map-dict
-  
-  bdict-tests!
-  )
- (import scheme
-	 (chicken base)
-	 util-tag
-	 testing)
-
- ;; Unique tag
- (define TAG-BDICT (make-tag dict-bst))
-
- ;; 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-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)))
-
- ;; Creates empty BST dictionary
- (define (make-bdict)
-   (cons TAG-BDICT #f))
-
- ;; Accessor for root
- (define bdict-root cdr)
-
- ;; Updates BST dictionary root node
- (define (set-bdict-root d r)
-   (cons (car d) r))
-
- ;; Checks whether given value is BST dictionary
- (define (bdict? v)
-   (and (pair? v)
-	(eq? (car v) TAG-BDICT)))
-
- ;; Returns true if given dictionary is empty
- (define (bdict-empty? d)
-   (and (bdict? d)
-	(not (bdict-root d))))
-
- ;; Returns true if dictionary contains given key
- (define (bdict-contains? d k)
-   (let loop ((n (bdict-root d)))
-     (if n
-	 (let ((nk (bst-node-key n)))
-	   (if (eq? k nk)
-	       #t
-	       (loop (if (< k nk)
-			 (bst-node-left n)
-			 (bst-node-right n)))))
-	 #f)))
-
- ;; Returns the value associated with given key
- (define (bdict-ref d k . vs)
-   (let loop ((n (bdict-root d)))
-     (if n
-	 (let ((nk (bst-node-key n)))
-	   (if (eq? k nk)
-	       (bst-node-value n)
-	       (loop (if (< k nk)
-			 (bst-node-left n)
-			 (bst-node-right n)))))
-	 (if (null? vs)
-	     (error 'bdict-ref "Key does not exist" k)
-	     (car vs)))))
-
- ;; Returns a dictionary with given key set to given value
- (define (bdict-set d k v)
-   (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 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)
-   (let ((new-root
-	  (let loop ((n (bdict-root d)))
-	    (if n
-		(let ((nk (bst-node-key n)))
-		  (if (eq? nk k)
-		      (if (bst-node-left n)
-			  (if (bst-node-right n)
-			      (let aloop ((an (bst-node-right n)))
-				(if an
-				    (set-bst-node-left an
-						       (aloop (bst-node-left an)))
-				    (bst-node-left n)))
-			      (bst-node-left n))
-			  (if (bst-node-right n)
-			      (bst-node-right n)
-			      #f))
-		      (if (< k nk)
-			  (set-bst-node-left n (loop (bst-node-left n)))
-			  (set-bst-node-right n (loop (bst-node-right n))))))
-		(if (and (not (null? nos))
-			 (car nos))
-		    #f
-		    (error 'bdict-remove "Key does not exist" k))))))
-     (if new-root
-	 (set-bdict-root d new-root)
-	 d)))
-
- ;; Reduce over key-value pairs
- (define (bdict-reduce init proc bd)
-   (let loop ((n (bdict-root bd))
-	      (acc init))
-     (if n
-	 (loop (bst-node-right n)
-	       (proc (loop (bst-node-left n) acc)
-		     (bst-node-key n) (bst-node-value n)))
-	 acc)))
-
- ;; Returns all the keys contained in given dictionary
- (define (bdict-keys d)
-   (reverse
-    (bdict-reduce '() (lambda (a k v) (cons k a)) d)))
-
- ;; Returns only values
- (define (bdict-values d)
-   (reverse
-    (bdict-reduce '() (lambda (a k v) (cons v a)) d)))
-
- ;; Converts to vector of key-value cons cells
- (define (bdict->vector d)
-   (apply
-    vector
-    (reverse
-     (bdict-reduce '() (lambda (a k v) (cons (cons k v) a)) d))))
-
- ;; Converts a vector of key-value cons cells to BST dictionary
- (define (vector->bdict v)
-   (cons
-    TAG-BDICT
-    (let loop ((s 0)
-	       (e (vector-length v)))
-      (if (= s e)
-	  #f
-	  (let* ((c (- e s))
-		 (h (quotient c 2))
-		 (m (+ s h))
-		 (kv (vector-ref v m)))
-	    (cons kv
-		  (cons (loop s m)
-			(loop (add1 m) e))))))))
-
- ;; Returns optimally-balanced version of given dictionary
- (define (bdict-balance d)
-   (vector->bdict
-    (bdict->vector d)))
-
- ;; Returns a list of key-value pairs matching predicate
- (define (bdict-filter-pairs d p)
-   (bdict-reduce
-    '()
-    (lambda (a k v)
-      (let ((e (p k v)))
-	(if e
-	    (cons (cons k v) a)
-	    a)))
-    d))
-
- ;; Returns a list of keys pairs matching predicate
- (define (bdict-filter-keys d p)
-   (bdict-reduce
-    '()
-    (lambda (a k v)
-      (let ((e (p k v)))
-	(if e
-	    (cons k a)
-	    a)))
-    d))
-
- ;; Returns a list of keys pairs matching predicate
- (define (bdict-filter-values d p)
-   (bdict-reduce
-    '()
-    (lambda (a k v)
-      (let ((e (p k v)))
-	(if e
-	    (cons v a)
-	    a)))
-    d))
-
- ;; Converts list of pairs into BST dictionary
- (define (list->bdict l)
-   (vector->bdict
-    (apply vector l)))
-
- ;; Returns arbitrary list created by mapping all elements
- (define (bdict-map-list d p)
-   (reverse
-    (bdict-reduce
-     '()
-     (lambda (a k v)
-       (cons (p k v) a))
-     d)))
-
- ;; Returns new dictionary with all values processed (keys are left
- ;; intact)
- (define (bdict-map-dict d p)
-   (set-bdict-root
-    d
-    (let loop ((n (bdict-root d)))
-      (if n
-	  (cons (cons (caar n) (p (caar n) (cdar n)))
-		(cons (loop (cadr n))
-		      (loop (cddr n))))
-	  #f))))
-
- ;; 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
-		 (make-bdict)
-		 1 "Hello")
-		1))
-    (test-false bdict-set/bdict-contains?
-		(bdict-contains?
-		 (bdict-set
-		  (make-bdict)
-		  1 "Hello")
-		 2))
-    (test-true bdict-set/bdict-contains?
-	       (bdict-contains?
-		(bdict-set
-		 (bdict-set
-		  (make-bdict)
-		  1 "Hello")
-		 2 "World")
-		1))
-    (test-equal? bdict-keys
-		 (bdict-keys
-		  (bdict-set
-		   (bdict-set
-		    (bdict-set
-		     (make-bdict)
-		     23 "Hello")
-		    666 "World")
-		   7 "BST"))
-		 '(7 23 666))
-    (test-false bdict-remove
-		(bdict-contains?
-		 (bdict-remove
-		  (bdict-set
-		   (bdict-set
-		    (bdict-set
-		     (make-bdict)
-		     23 "Hello")
-		    666 "World")
-		   7 "BST")
-		  23)
-		 23))
-    (test-equal? bdict-balance
-		 (bdict-keys
-		  (bdict-balance
-		   (bdict-set
-		    (bdict-set
-		     (bdict-set
-		      (make-bdict)
-		      1 "Hello")
-		     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"))
-    ))
-
- )