change around insert, delete, and update to hide representation

1 files changed, 37 insertions, 42 deletions

diff --git a/set.scm b/set.scm
index d00d96f..a8683b1 100644
--- a/set.scm
+++ b/set.scm
@@ -286,21 +286,22 @@
         (loop tree)))))
 
 ;;; (SET:UPDATE <=>) generates an update function for <=>.
-;;; (UPDATE TREE NODE UPDATE) inserts (UPDATE NODE #F) into the tree if
-;;; no node comparing equal to NODE is found, and (UPDATE NODE OLD) if
-;;; OLD compares equal to NODE.
+;;; (UPDATE TREE DATA UPDATE) inserts a node with data (UPDATE DATA #F)
+;;; into the tree if no node comparing equal to DATA is found, and a node
+;;; with data (UPDATE DATA OLD) if OLD compares equal to NODE.
 (define set:update
   (lambda (<=>)
-    (lambda (tree node update)
+    (lambda (tree data update)
       (letrec
           ((loop
             (lambda (tree)
               (if (null? tree)
-                  (update node #f)
-                  (let ((dir (<=> (set:get node '=)
-                                  (set:get tree '=))))
+                  (%set:node (update data '()) '< '() '> '())
+                  (let ((dir (<=> data (set:get tree '=))))
                     (if (eq? dir '=)
-                        (update node tree)
+                        (%set:node (update data tree)
+                                   '< (set:get tree '<)
+                                   '> (set:get tree '>))
                         (let ((invdir (%set:invdir dir)))
                           (set:join (set:get tree '=)
                                     dir (loop (set:get tree dir))
@@ -309,40 +310,35 @@
 
 ;;; (SET:INSERT <=>) generates an insert function for comparison function
 ;;; <=>.
-;;; (INSERT TREE NODE) inserts NODE into TREE. It returns
+;;; (INSERT TREE DATA) inserts a node with DATA into TREE. It returns
 ;;; (CONS NEWTREE FOUND), where FOUND is the node that was replaced by
-;;; NODE, and #F otherwise, and NEWTREE is the new root of the tree.
+;;; the node, and '() otherwise, and NEWTREE is the new root of the tree.
 (define set:insert
   (lambda (update)
     (lambda (tree node)
-      (let ((found #f))
+      (let ((found '()))
         (let ((newroot (update tree node
-                               (lambda (node oldnode)
-                                 (if (not oldnode)
-                                     node
-                                     (begin
-                                       (set! found oldnode)
-                                       (set:node-new-val oldnode
-                                                         (set:get node '=))))))))
+                               (lambda (data oldnode)
+                                 (set! found oldnode)
+                                 data))))
           (cons newroot found))))))
 
 ;;; (SET:DELETE <=>) generates a delete function for comparison function
 ;;; <=>.
 ;;; (DELETE TREE DATA) deletes a node from TREE that compares equal to
 ;;; DATA. The function returns (CONS NEWTREE FOUND), where FOUND is the
-;;; deleted node, or NULL if not found, and NEWTREE is the root of the new
+;;; deleted node, or '() if not found, and NEWTREE is the root of the new
 ;;; tree.
 (define set:delete
   (lambda (<=>)
-    (lambda (tree node)
+    (lambda (tree data)
       (let ((found '()))
         (letrec
             ((loop
               (lambda (tree)
                 (if (null? tree)
-                    node
-                    (let ((dir (<=> (set:get node '=)
-                                    (set:get tree '=))))
+                    '()
+                    (let ((dir (<=> data (set:get tree '=))))
                       (if (eq? dir '=)
                           (begin
                             (set! found tree)
@@ -357,6 +353,8 @@
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Converting sets to maps
+;;; 
+;;; The conversion stores (CONS KEY VAL) into each pair.
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;; Convert a <=> for sets to one for maps.
@@ -365,16 +363,6 @@
     (lambda (x y)
       (<=> (car x) (car y)))))
 
-(define map:node-new-val
-  (lambda (node newkey newval)
-    (set:node-new-val node
-                      (cons newkey newval))))
-
-(define map:empty-node
-  (lambda (key val)
-    (%set:node (cons key val)
-               '< '() '> '())))
-
 (define map:key
   (lambda (node)
     (car (set:get node '=))))
@@ -383,17 +371,22 @@
   (lambda (node)
     (cdr (set:get node '=))))
 
+;;; (UPDATE TREE KEY UPDATE*) runs inserts a node with value
+;;; (UPDATE KEY '()) if no node is found comparing equal to KEY, and
+;;; (UPDATE KEY NODE) if NODE compared equal to KEY.
 (define map:update
   (lambda (%update-recursive)
     (lambda (tree key update)
-      (%update-recursive tree (map:empty-node key '())
-                         update))))
+      (%update-recursive tree (cons key '())
+                         (lambda (_ oldnode)
+                           (cons key
+                                 (update key oldnode)))))))
 
 (define map:insert
   (lambda (%update-recursive)
     (let ((insert (set:insert %update-recursive)))
       (lambda (tree key val)
-        (insert tree (map:empty-node key val))))))
+        (insert tree (cons key val))))))
 
 (define map:search
   (lambda (<=>)
@@ -405,7 +398,7 @@
   (lambda (<=>)
     (let ((delete (set:delete <=>)))
       (lambda (tree key)
-        (delete tree (map:empty-node key '()))))))
+        (delete tree (cons key '()))))))
 
 (define map:split
   (lambda (<=>) (set:split <=>)))
@@ -467,6 +460,10 @@
                "should have been found")
               ((and already-in (not (equal? already-in
                                             (map:val (cdr insert-return)))))
+               (display (list already-in
+                              insert-return
+                              (map:val (cdr insert-return))))
+               (newline)
                "found is not correct")
               (else (%set:operate-all f (car insert-return) (cdr lst)))))))))
 
@@ -534,7 +531,7 @@
            (let ((insert-return (smap:insert '() (string #\a) 5)))
              (cond
                ((not (pair? insert-return)) "invalid insert return")
-               ((cdr insert-return) "string found in empty tree")
+               ((not (null? (cdr insert-return))) "string found in empty tree")
                (else
                 (let ((tree (car insert-return)))
                   (let ((found (smap:search tree (string #\a))))
@@ -600,10 +597,8 @@
                  tree
                  (let ((tree (smap:update tree
                                           (string #\a #\b #\c #\d #\e)
-                                          (lambda (node oldnode)
-                                            (map:node-new-val oldnode
-                                                              (string #\a #\b #\c #\d #\e)
-                                                              10)))))
+                                          (lambda (key oldnode)
+                                            10))))
                    (let ((res (%set:search-all tree
                                                (list
                                                 (list (string #\a #\b #\c #\d) 1 1)