xor

2 files changed, 35 insertions, 1 deletions

diff --git a/mcgoron.weight-balanced-trees.internal.scm b/mcgoron.weight-balanced-trees.internal.scm
index ff8b0aa..f0dc7c5 100644
--- a/mcgoron.weight-balanced-trees.internal.scm
+++ b/mcgoron.weight-balanced-trees.internal.scm
@@ -1,3 +1,17 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
 ;;; ;;;;;;;;;;;;;;;;;;;
 ;;; Definition of nodes and functions to calculate values for nodes.
 ;;; ;;;;;;;;;;;;;;;;;;;
@@ -325,6 +339,26 @@
                 (join2 (difference new-left left-of-right)
                        (difference new-right right-of-right))))))))
 
+(: xor (* node-type node-type --> node-type))
+(define (xor cmp left right)
+  (let xor ((left left)
+            (right right))
+    (cond
+      ((null? left) right)
+      ((null? right) left)
+      (else (with-node (right right-data
+                              ("<" left-of-right)
+                              (">" right-of-right))
+              (let-values (((new-left new-key new-right)
+                            (split cmp left right-data return-sentinel)))
+                (let ((final-left (xor new-left left-of-right))
+                      (final-right (xor new-right right-of-right)))
+                  ;; If new-key is a sentinel value, that means new-key was
+                  ;; not in the left tree, meaning it should be in the xor.
+                  (if (sentinel? new-key)
+                      (join right-data final-left final-right)
+                      (join2 final-left final-right)))))))))
+
 ;;; ;;;;;;;;;;;;;;;;;;;;
 ;;; Single value operations
 ;;; ;;;;;;;;;;;;;;;;;;;;
diff --git a/mcgoron.weight-balanced-trees.internal.sld b/mcgoron.weight-balanced-trees.internal.sld
index 246d2a3..5927d0d 100644
--- a/mcgoron.weight-balanced-trees.internal.sld
+++ b/mcgoron.weight-balanced-trees.internal.sld
@@ -34,7 +34,7 @@
           node->in-order-list
           join join2 split
           search
-          union intersection difference
+          union intersection difference xor
           update delete
           every)
   (include "mcgoron.weight-balanced-trees.internal.scm"))