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

xanadu - btree

This commit is contained in:
erana 2012-01-21 14:03:12 +09:00
parent 3c9770e9d1
commit dcb0d28ae1
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -98,13 +98,13 @@
((and (string<? str (((vector-ref tree i)'get-data))) ((and (string<? str (((vector-ref tree i)'get-data)))
(string>? str (((vector-ref tree (+ i 1))'get-data)))) (string>? str (((vector-ref tree (+ i 1))'get-data))))
(display "node not found in tree.") 0) (display "node not found in tree.") 0)
((string=? str (vector-ref tree i)) ((string=? str (((vector-ref tree i)'get-data)))
(display "string found in tree.") str) (display "string found in tree.") str)
(else (display "never reached.")))) (else (display "never reached."))))
))) )))
(define (search str) (define (search str)
(search-rec *tree)) (search-rec str *tree))
(define (add-rec str tree) ;; root param in b-treenode (define (add-rec str tree) ;; root param in b-treenode
(let ((len (vector-length tree))) (let ((len (vector-length tree)))
@ -121,15 +121,19 @@
((new-node 'set-data!) str) ((new-node 'set-data!) str)
(vector-set! tree i new-node) (vector-set! tree i new-node)
))) )))
((string=? str (vector-ref tree i)) ((string=? str (((vector-ref tree i)'get-data)))
(set! i (vector-length tree))) (set! i (vector-length tree)))
(else (display "never reached."))))) (else (display "never reached.")))))
(define (add str) (define (add str)
(add-rec *tree)) (add-rec str *tree))
(define (dispatch msg) (define (dispatch msg)
(cond ((eq? msg 'add) add) (cond ((eq? msg 'add) add)
((eq? msg 'search) search) ((eq? msg 'search) search)
(else (display "b-tree : message not understood.")))) (else (display "b-tree : message not understood."))))
dispatch)) dispatch))
(define (bt) (make-b-tree 2))
((bt 'add) "abc")