Add operations to read or delete the min/max elements of a tree.

diff --git a/v7/src/runtime/rbtree.scm b/v7/src/runtime/rbtree.scm
index 557fac073d8137175bfcb87d25a5aef32c780a82..197093d9582b0f437e91d3f0a684e6dcb20232b2 100644 (file)
--- a/v7/src/runtime/rbtree.scm
+++ b/v7/src/runtime/rbtree.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rbtree.scm,v 1.4 1993/10/08 09:03:43 cph Exp $
+$Id: rbtree.scm,v 1.5 1998/05/04 18:43:25 cph Exp $
 
-Copyright (c) 1993 Massachusetts Institute of Technology
+Copyright (c) 1993-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -309,7 +309,7 @@ MIT in each case. |#
   (guarantee-rb-tree y 'RB-TREE/EQUAL?)
   (let ((key=? (tree-key=? x)))
     (and (eq? key=? (tree-key=? y))
-        (let loop ((nx (first-node x)) (ny (first-node y)))
+        (let loop ((nx (min-node x)) (ny (min-node y)))
           (if (not nx)
               (not ny)
               (and ny
@@ -319,7 +319,7 @@ MIT in each case. |#
 
 (define (rb-tree->alist tree)
   (guarantee-rb-tree tree 'RB-TREE->ALIST)
-  (let ((node (first-node tree)))
+  (let ((node (min-node tree)))
     (if node
        (let ((result (list (cons (node-key node) (node-datum node)))))
          (let loop ((node (next-node node)) (prev result))
@@ -332,7 +332,7 @@ MIT in each case. |#
 
 (define (rb-tree/key-list tree)
   (guarantee-rb-tree tree 'RB-TREE/KEY-LIST)
-  (let ((node (first-node tree)))
+  (let ((node (min-node tree)))
     (if node
        (let ((result (list (node-key node))))
          (let loop ((node (next-node node)) (prev result))
@@ -345,7 +345,7 @@ MIT in each case. |#
 
 (define (rb-tree/datum-list tree)
   (guarantee-rb-tree tree 'RB-TREE/DATUM-LIST)
-  (let ((node (first-node tree)))
+  (let ((node (min-node tree)))
     (if node
        (let ((result (list (node-datum node))))
          (let loop ((node (next-node node)) (prev result))
@@ -355,14 +355,113 @@ MIT in each case. |#
                  (loop (next-node node) pair))))
          result)
        '())))
+\f
+(define (rb-tree/min tree default)
+  (guarantee-rb-tree tree 'RB-TREE/MIN)
+  (let ((node (min-node tree)))
+    (if node
+       (node-key node)
+       default)))
 
-(define (first-node tree)
+(define (rb-tree/min-datum tree default)
+  (guarantee-rb-tree tree 'RB-TREE/MIN-DATUM)
+  (let ((node (min-node tree)))
+    (if node
+       (node-datum node)
+       default)))
+
+(define (rb-tree/min-pair tree)
+  (guarantee-rb-tree tree 'RB-TREE/MIN-PAIR)
+  (let ((node (min-node tree)))
+    (and node
+        (node-pair node))))
+
+(define (rb-tree/delete-min! tree default)
+  (guarantee-rb-tree tree 'RB-TREE/DELETE-MIN!)
+  (let ((node (min-node tree)))
+    (if node
+       (let ((key (node-key node)))
+         (delete-node! tree node)
+         key)
+       default)))
+
+(define (rb-tree/delete-min-datum! tree default)
+  (guarantee-rb-tree tree 'RB-TREE/DELETE-MIN-DATUM!)
+  (let ((node (min-node tree)))
+    (if node
+       (let ((datum (node-datum node)))
+         (delete-node! tree node)
+         datum)
+       default)))
+
+(define (rb-tree/delete-min-pair! tree)
+  (guarantee-rb-tree tree 'RB-TREE/DELETE-MIN-PAIR!)
+  (let ((node (min-node tree)))
+    (and node
+        (let ((pair (node-pair node)))
+          (delete-node! tree node)
+          pair))))
+\f
+(define (rb-tree/max tree default)
+  (guarantee-rb-tree tree 'RB-TREE/MAX)
+  (let ((node (max-node tree)))
+    (if node
+       (node-key node)
+       default)))
+
+(define (rb-tree/max-datum tree default)
+  (guarantee-rb-tree tree 'RB-TREE/MAX-DATUM)
+  (let ((node (max-node tree)))
+    (if node
+       (node-datum node)
+       default)))
+
+(define (rb-tree/max-pair tree)
+  (guarantee-rb-tree tree 'RB-TREE/MAX-PAIR)
+  (let ((node (max-node tree)))
+    (and node
+        (node-pair node))))
+
+(define (rb-tree/delete-max! tree default)
+  (guarantee-rb-tree tree 'RB-TREE/DELETE-MAX!)
+  (let ((node (max-node tree)))
+    (if node
+       (let ((key (node-key node)))
+         (delete-node! tree node)
+         key)
+       default)))
+
+(define (rb-tree/delete-max-datum! tree default)
+  (guarantee-rb-tree tree 'RB-TREE/DELETE-MAX-DATUM!)
+  (let ((node (max-node tree)))
+    (if node
+       (let ((datum (node-datum node)))
+         (delete-node! tree node)
+         datum)
+       default)))
+
+(define (rb-tree/delete-max-pair! tree)
+  (guarantee-rb-tree tree 'RB-TREE/DELETE-MAX-PAIR!)
+  (let ((node (max-node tree)))
+    (and node
+        (let ((pair (node-pair node)))
+          (delete-node! tree node)
+          pair))))
+\f
+(define (min-node tree)
   (and (tree-root tree)
        (let loop ((x (tree-root tree)))
         (if (node-left x)
             (loop (node-left x))
             x))))
 
+(define (max-node tree)
+  (and (tree-root tree)
+       (let loop ((x (tree-root tree)))
+        (if (node-right x)
+            (loop (node-right x))
+            x))))
+
 (define (next-node x)
   (if (node-right x)
        (let loop ((x (node-right x)))
@@ -373,4 +472,7 @@ MIT in each case. |#
        (let ((y (node-up x)))
          (if (and y (eq? x (node-right y)))
              (loop y)
-             y)))))
\ No newline at end of file
+             y)))))
+
+(define-integrable (node-pair node)
+  (cons (node-key node) (node-datum node)))
\ No newline at end of file

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index ff50d5ad00f4431a65e36b66a55b459518aa8f64..38a6d6aaee1f0236ae54a643a6444ca600e5f04a 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.298 1998/04/30 21:28:17 cph Exp $
+$Id: runtime.pkg,v 14.299 1998/05/04 18:43:39 cph Exp $
 
 Copyright (c) 1988-98 Massachusetts Institute of Technology
 
@@ -3262,19 +3262,31 @@ MIT in each case. |#
   (parent ())
   (export ()
          alist->rb-tree
+         make-rb-tree
          rb-tree->alist
          rb-tree/copy
          rb-tree/datum-list
          rb-tree/delete!
+         rb-tree/delete-max!
+         rb-tree/delete-max-datum!
+         rb-tree/delete-max-pair!
+         rb-tree/delete-min!
+         rb-tree/delete-min-datum!
+         rb-tree/delete-min-pair!
          rb-tree/empty?
          rb-tree/equal?
          rb-tree/height
          rb-tree/insert!
          rb-tree/key-list
          rb-tree/lookup
+         rb-tree/max
+         rb-tree/max-datum
+         rb-tree/max-pair
+         rb-tree/min
+         rb-tree/min-datum
+         rb-tree/min-pair
          rb-tree/size
-         rb-tree?
-         make-rb-tree))
+         rb-tree?))
 
 (define-package (runtime wt-tree)
   (file-case options

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 0e21ce0335149b28c6d27b71a99f18a67ce2cf0b..11c458b2e999cf9271817dad321be51eefa19a99 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.304 1998/04/30 21:28:23 cph Exp $
+$Id: runtime.pkg,v 14.305 1998/05/04 18:43:32 cph Exp $
 
 Copyright (c) 1988-98 Massachusetts Institute of Technology
 
@@ -3266,19 +3266,31 @@ MIT in each case. |#
   (parent ())
   (export ()
          alist->rb-tree
+         make-rb-tree
          rb-tree->alist
          rb-tree/copy
          rb-tree/datum-list
          rb-tree/delete!
+         rb-tree/delete-max!
+         rb-tree/delete-max-datum!
+         rb-tree/delete-max-pair!
+         rb-tree/delete-min!
+         rb-tree/delete-min-datum!
+         rb-tree/delete-min-pair!
          rb-tree/empty?
          rb-tree/equal?
          rb-tree/height
          rb-tree/insert!
          rb-tree/key-list
          rb-tree/lookup
+         rb-tree/max
+         rb-tree/max-datum
+         rb-tree/max-pair
+         rb-tree/min
+         rb-tree/min-datum
+         rb-tree/min-pair
          rb-tree/size
-         rb-tree?
-         make-rb-tree))
+         rb-tree?))
 
 (define-package (runtime wt-tree)
   (file-case options