scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

xanadu - xml-tree

This commit is contained in:
erana 2012-01-21 20:57:21 +09:00
parent c3c6c8f355
commit 47225606d5
1 changed files with 12 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
scsh/xanadu/b-tree.scm
View File

@ -63,6 +63,8 @@
(lambda (msg) (lambda (msg)
(cond ((eq? msg 'get-left) (cond ((eq? msg 'get-left)
get-left) get-left)
((eq? msg 'get-right)
get-right)
((eq? msg 'set-left-with-index!) ((eq? msg 'set-left-with-index!)
set-left-with-index!) set-left-with-index!)
((eq? msg 'set-right-with-index!) ((eq? msg 'set-right-with-index!)
@ -71,8 +73,6 @@
get-data) get-data)
((eq? msg 'set-data!) ((eq? msg 'set-data!)
set-data!) set-data!)
((eq? msg 'get-right)
get-right)
(else (display "b-tree-node : message not understood")(newline))))) (else (display "b-tree-node : message not understood")(newline)))))
dispatch)) dispatch))
@ -138,15 +138,17 @@
(dump-rec *tree)) (dump-rec *tree))
(define (add-rec str tree) ;; root param in b-treenode ;; refactor call-with-values (define (add-rec str tree) ;; root param in b-treenode ;; refactor call-with-values
(let ((lefttree (tree 'get-left));;FIXME () (let ((lefttree (tree 'get-left));;FIXME ()
(righttree (tree 'get-right))) (righttree (tree 'get-right)))
;;len (vector-length ((tree 'get-left))))) ;;len (vector-length ((tree 'get-left)))))
(call-with-values ;;(call-with-values
(lambda () (values lefttree righttree)) ;; (lambda () (values lefttree righttree))
(lambda (lefttree righttree) ;; (lambda (lefttree righttree)
(add-rec-side-tree str lefttree) (add-rec-side-tree str lefttree)
(add-rec-side-tree str righttree) (add-rec-side-tree str righttree)
)))) ;; ))
))
(define (add-rec-side-tree str side-tree) (define (add-rec-side-tree str side-tree)
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
@ -186,7 +188,7 @@
(let ((side-tree-node (vector-ref i side-tree))) (let ((side-tree-node (vector-ref i side-tree)))
(cond ((not (not side-tree-node)) (cond ((not (not side-tree-node))
#f) #f)
(else (add-rec str side-tree-node))))) (else (add-rec str side-tree-node)))));;NOTE add-rec not the other add-rec
) )
@ -203,8 +205,8 @@
dispatch)) dispatch))
;; test program ;; test program
;;(define bt (make-b-tree 2)) (define bt (make-b-tree 2))
;;((bt 'add)"abc") ((bt 'add)"abc")
;;((bt 'add)"def") ;;((bt 'add)"def")
;;((bt 'add)"hij") ;;((bt 'add)"hij")
;;((bt 'search)"abc") ;;((bt 'search)"abc")