From 1d9edaa3201c9d296f1aa1a0b0b87e76ee15571b 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 12:00:47 +0200
Subject: [PATCH] Work on bst-equal implementation.

---
 doc/d-utils.md   |  8 ++++++++
 src/util-bst.scm | 39 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 47 insertions(+)

diff --git a/doc/d-utils.md b/doc/d-utils.md
index 019c05f..ebee6d4 100644
--- a/doc/d-utils.md
+++ b/doc/d-utils.md
@@ -571,6 +571,14 @@ accept two arguments.
 Like generic reduce, the proc gets accumulator, key and value
 arguments.
 
+### bst-equal? [procedure]
+
+    (bst-equal? b1
+                b2
+                (equality? equal?))
+
+Returns true if both BSTs contain the same keys and values.
+
 ## util-bst-bdict [module]
 
     (import util-bst-bdict)
diff --git a/src/util-bst.scm b/src/util-bst.scm
index 2cc7280..13a7f9a 100644
--- a/src/util-bst.scm
+++ b/src/util-bst.scm
@@ -38,6 +38,8 @@
   bst-filter
   bst-reduce
 
+  bst-equal?
+
   util-bst-tests!
   )
 
@@ -243,6 +245,23 @@
 	(proc (bst-node-kv n))
 	(loop (bst-node-right n))))))
 
+ ;; Used for iterating over multiple BSTs simultaneously
+ (define (bst-kv-iterator bst)
+   (let* ((break #f)
+	  (resume #f)
+	  (yield (lambda (val)
+		   (call/cc
+		    (lambda (r)
+		      (set! resume r)
+		      (break val))))))
+     (lambda ()
+       (call/cc
+	(lambda (cc)
+	  (set! break cc)
+	  (if resume
+	      (resume '())
+	      (bst-iter-kv bst yield))
+	  #f)))))
 
  (define/doc (bst-keys bst)
    ("Returns all the keys contained in given dictionary.")
@@ -395,6 +414,26 @@ arguments.")
 		    (set! acc (proc acc (car kv) (cdr kv)))))
      acc))
 
+ ;; Returns true if these are compatible BSTs
+ (define (bst-compat? b1 b2)
+   (and (eq? (bst-tag b1)
+	     (bst-tag b2))
+	(eq? (bst-subtag b1)
+	     (bst-subtag b2))
+	(eq? (bst-EQ? b1)
+	     (bst-EQ? b2))
+	(eq? (bst-<? b1)
+	     (bst-<? b2))))
+
+ (define*/doc (bst-equal? b1 b2 (equality? equal?))
+   ("Returns true if both BSTs contain the same keys and values.")
+   (if (bst-compat? b1 b2)
+       (let-comparators
+	(EQ? <? b1)
+	#t
+	)
+       #f))
+
  ;; Module self-tests
  (define (util-bst-tests!)
    (run-tests