From 33fadab5e7a020b59afc2bab3ace3c180f7e7ac7 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:22:47 +0200
Subject: [PATCH] Start implementing symbol ldict.

---
 doc/d-utils.md         |  8 +++++++
 src/util-bst-ldict.scm | 48 ++++++++++++++++++++++++++++++++++++++++++
 src/util-bst.scm       | 10 +++++++++
 3 files changed, 66 insertions(+)
 create mode 100644 src/util-bst-ldict.scm

diff --git a/doc/d-utils.md b/doc/d-utils.md
index fa30ebf..cf72484 100644
--- a/doc/d-utils.md
+++ b/doc/d-utils.md
@@ -554,6 +554,14 @@ Converts list of pairs into BST dictionary.
 
 Functional update with optional default value (defaults to #f).
 
+### bst-filter [procedure]
+
+    (bst-filter bst
+                pred?)
+
+Returns a BST with only KV pairs matching the predicate which must
+accept two arguments.
+
 ## util-bst-bdict [module]
 
     (import util-bst-bdict)
diff --git a/src/util-bst-ldict.scm b/src/util-bst-ldict.scm
new file mode 100644
index 0000000..a87cf78
--- /dev/null
+++ b/src/util-bst-ldict.scm
@@ -0,0 +1,48 @@
+
+(declare (unit util-bst-ldict))
+
+(import duck)
+
+(module*
+ util-bst-ldict
+ #:doc ("xxx")
+ (
+  )
+
+ (import scheme
+	 util-bst)
+
+ (define (symbol<? a b)
+   (string<? (symbol->string a)
+	     (symbol->string b)))
+
+ (define (make-ldict)
+   (make-bst 'symbol eq? symbol<?))
+
+ (define ldict? (bst? 'symbol))
+
+ (define ldict-empty? bst-empty?)
+ (define ldict-contains? bst-contains?)
+ (define ldict-ref bst-ref)
+ (define ldict-remove bst-remove)
+ (define ldict-set bst-set)
+ (define ldict-keys bst-keys)
+
+ (define (ldict-map proc ld)
+   (let ((i 0)
+	 (both? ((procedure-arity>=? 2) proc))
+	 (index? ((procedure-arity=>? 3) proc)))
+     (bst-map-bst ld
+		  (lambda (k v)
+		    (let ((r (if both?
+				 (if index?
+				     (proc k v i)
+				     (proc k v))
+				 (proc v))))
+		      (set! i (add1 i))
+		      r)))))
+
+ (define (ldict-filter pred? ld)
+   (bst-filter ld pred?))
+
+ )
diff --git a/src/util-bst.scm b/src/util-bst.scm
index dd73d53..c5d4acf 100644
--- a/src/util-bst.scm
+++ b/src/util-bst.scm
@@ -35,6 +35,8 @@
 
   bst-update
 
+  bst-filter
+
   util-bst-tests!
   )
 
@@ -375,6 +377,14 @@
 			  new-root
 			  (+ (bst-count bst) add-count)))))
 
+ (define/doc (bst-filter bst pred?)
+   ("Returns a BST with only KV pairs matching the predicate which must
+accept two arguments.")
+   (kvv->bst
+    (cons TAG-KVV
+	  (cons (apply vector (bst-filter-pairs bst pred?))
+		(cddr bst)))))
+
  ;; Module self-tests
  (define (util-bst-tests!)
    (run-tests