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)