Changeset 8037 in project
 Timestamp:
 02/02/08 13:52:22 (12 years ago)
 Location:
 rbtree/trunk
 Files:

 4 edited
Legend:
 Unmodified
 Added
 Removed

rbtree/trunk/rbtreeeggdoc.scm
r7358 r8037 9 9 10 10 (history 11 (version "2.4" "Replaced values/letvalues with list and matchlet") 11 12 (version "2.3" "Build script updated for better crossplatform compatibility") 12 13 (version "2.2" "Added foldlimit procedures") 
rbtree/trunk/rbtree.scm
r6055 r8037 35 35 36 36 (requireextension srfi1) 37 (requireextension match) 37 38 (requireextension datatype) 38 39 … … 213 214 (define (ins root) 214 215 (cases tree root 215 (Empty () ( values#f (Tree R (Empty) key value (Empty))))216 (Empty () (list #f (Tree R (Empty) key value (Empty)))) 216 217 (Tree (color a yk y b) 217 218 (dispatchonkey … … 223 224 key zk 224 225 ;; Case 1.1: key < zk 225 ( letvalues(((found? c1) (ins c)))226 (valuesfound?227 228 (($ tree 'Tree 'Red e wk w f)229 230 (else (Tree B (Tree R c1 zk z d) yk y b)))))226 (matchlet (((found? c1) (ins c))) 227 (list found? 228 (match c1 229 (($ tree 'Tree 'Red e wk w f) 230 (Tree R (Tree B e wk w f) zk z (Tree B d yk y b))) 231 (else (Tree B (Tree R c1 zk z d) yk y b))))) 231 232 ;; Case 1.2: key = zk 232 ( valuesa (Tree color (Tree R c key value d) yk y b))233 (list a (Tree color (Tree R c key value d) yk y b)) 233 234 ;; Case 1.3: key > zk 234 ( letvalues(((found? d1) (ins d)))235 (valuesfound?236 237 (($ tree 'Tree 'Red e wk w f)238 239 (else (Tree B (Tree R c zk z d1) yk y b)))))))240 (else ( letvalues(((found? a1) (ins a)))241 (valuesfound? (Tree B a1 yk y b)))))235 (matchlet (((found? d1) (ins d))) 236 (list found? 237 (match d1 238 (($ tree 'Tree 'Red e wk w f) 239 (Tree R (Tree B c zk z e) wk w (Tree B f yk y b))) 240 (else (Tree B (Tree R c zk z d1) yk y b))))))) 241 (else (matchlet (((found? a1) (ins a))) 242 (list found? (Tree B a1 yk y b))))) 242 243 ;; Case 2: key = yk 243 ( valuesroot (Tree color a key value b))244 (list root (Tree color a key value b)) 244 245 ;; Case 3: key > yk 245 246 (match b … … 248 249 key zk 249 250 ;; Case 3.1: key < zk 250 ( letvalues(((found? c1) (ins c)))251 (valuesfound?252 253 (($ tree 'Tree 'Red e wk w f)254 255 (else (Tree B a yk y (Tree R c1 zk z d))))))251 (matchlet (((found? c1) (ins c))) 252 (list found? 253 (match c1 254 (($ tree 'Tree 'Red e wk w f) 255 (Tree R (Tree B a yk y e) wk w (Tree B f zk z d))) 256 (else (Tree B a yk y (Tree R c1 zk z d)))))) 256 257 ;; Case 3.2: key = zk 257 ( valuesb (Tree color a yk y (Tree R c key value d)))258 (list b (Tree color a yk y (Tree R c key value d))) 258 259 ;; Case 3.3: key > zk 259 ( letvalues(((found? d1) (ins d)))260 (valuesfound?261 262 (($ tree 'Tree 'Red e wk w f)263 264 (else (Tree B a yk y (Tree R c zk z d1))))))))265 (else ( letvalues(((found? b1) (ins b)))266 (valuesfound? (Tree B a yk y b1)))))))))260 (matchlet (((found? d1) (ins d))) 261 (list found? 262 (match d1 263 (($ tree 'Tree 'Red e wk w f) 264 (Tree R (Tree B a yk y c) zk z (Tree B e wk w f))) 265 (else (Tree B a yk y (Tree R c zk z d1)))))))) 266 (else (matchlet (((found? b1) (ins b))) 267 (list found? (Tree B a yk y b1))))))))) 267 268 268 269 (ins root)) … … 334 335 (match tree 335 336 (($ tree 'Tree 'Red ($ tree 'Empty) yk y b) 336 ( valuesyk y (cons #f (zip z b))))337 (list yk y (cons #f (zip z b)))) 337 338 (($ tree 'Tree 'Black ($ tree Empty) yk y b) 338 ( valuesyk y (bbZip z b)))339 (list yk y (bbZip z b))) 339 340 (($ tree 'Tree color a yk y b) 340 341 (delMin a (Left color yk y b z))) … … 350 351 (cdr (bbZip z b))) 351 352 (( color a b) 352 ( letvalues(((xk x b) (delMin b (Top))))353 354 355 353 (matchlet (((xk x b) (delMin b (Top)))) 354 (match b 355 ((#t . b1) (cdr (bbZip z (Tree color a xk x b1)))) 356 ((#f . b1) (zip z (Tree color a xk x b1)))))))) 356 357 357 358 … … 549 550 ((put!) 550 551 (lambda (key value) 551 ( letvalues(((found? newroot) (insert root key value)))552 553 554 552 (matchlet (((found? newroot) (insert root key value))) 553 (set! root newroot) 554 (if (not found?) (set! size (+ 1 size))) 555 found?))) 555 556 556 557 ((put) 557 558 (lambda (key value) 558 ( letvalues(((found? newroot) (insert root key value)))559 559 (matchlet (((found? newroot) (insert root key value))) 560 (makerbtreedispatcher newroot (if (not found?) (+ 1 size) size))))) 560 561 561 562 
rbtree/trunk/rbtree.setup
r6628 r8037 21 21 22 22 ; Assoc list with properties for your extension: 23 '((version 2. 3)23 '((version 2.4) 24 24 (documentation "rbtree.html") 25 25 ,@(if hasexports? `((exports "rbtree.exports")) (list)) )) 
rbtree/trunk/tests/run.scm
r5343 r8037 8 8 (requireextension rbtree) 9 9 10 (definemacro (++! x) `(set! ,x ( fx+ 1 ,x)))11 (definemacro (++ x) `(fx+ 1 ,x))12 (definemacro (! x) `(set! ,x ( fx ,x 1)))13 (definemacro ( x) `(fx ,x 1))10 (definemacro (++! x) `(set! ,x (+ 1 ,x))) 11 (definemacro (++ x) `(+ 1 ,x)) 12 (definemacro (! x) `(set! ,x ( ,x 1))) 13 (definemacro ( x) `( ,x 1)) 14 14 15 15 … … 75 75 (test/equal "using fold to sum the elements in the rbtree" 76 76 ((rbtree 'fold) (lambda (x sum) (+ x sum)) 0) 77 (* 50(+ (+ 1 minkey) (+ 1 maxkey))))77 (* (/ maxkey 2) (+ (+ 1 minkey) (+ 1 maxkey)))) 78 78 79 79 (testdefine "Using 'map to create a copy of tree with each element x mapped to x*10"
Note: See TracChangeset
for help on using the changeset viewer.