Start implementing symbol ldict.

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)

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

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