Changeset 8037 in project


Ignore:
Timestamp:
02/02/08 13:52:22 (12 years ago)
Author:
Ivan Raikov
Message:

Replaced values and let-values with list and match-let.

Location:
rb-tree/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • rb-tree/trunk/rb-tree-eggdoc.scm

    r7358 r8037  
    99
    1010     (history
     11      (version "2.4" "Replaced values/let-values with list and match-let")
    1112      (version "2.3" "Build script updated for better cross-platform compatibility")
    1213      (version "2.2" "Added fold-limit procedures")
  • rb-tree/trunk/rb-tree.scm

    r6055 r8037  
    3535
    3636(require-extension srfi-1)
     37(require-extension match)
    3738(require-extension datatype)
    3839
     
    213214      (define (ins root)
    214215        (cases tree root
    215                (Empty ()  (values #f (Tree R (Empty) key value (Empty))))
     216               (Empty ()  (list #f (Tree R (Empty) key value (Empty))))
    216217               (Tree (color a yk y b) 
    217218                     (dispatch-on-key
     
    223224                               key zk
    224225                               ;; Case 1.1: key < zk
    225                                (let-values (((found? c1) (ins c)))
    226                                  (values found?
    227                                          (match c1
    228                                                 (($ tree 'Tree 'Red e wk w f)
    229                                                  (Tree R (Tree B e wk w f) zk z (Tree B d yk y b)))
    230                                                 (else  (Tree B (Tree R c1 zk z d) yk y b)))))
     226                               (match-let (((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)))))
    231232                               ;; Case 1.2: key = zk
    232                                (values a (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))
    233234                               ;; Case 1.3: key > zk
    234                                (let-values (((found? d1) (ins d)))
    235                                  (values found?
    236                                          (match d1
    237                                                 (($ tree 'Tree 'Red e wk w f)
    238                                                  (Tree R (Tree B c zk z e)  wk  w  (Tree B f yk y b)))
    239                                                 (else (Tree B (Tree R c zk z d1) yk y b)))))))
    240                              (else  (let-values (((found? a1)  (ins a)))
    241                                       (values found? (Tree B a1 yk y b)))))
     235                               (match-let (((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  (match-let (((found? a1)  (ins a)))
     242                                               (list found? (Tree B a1 yk y b)))))
    242243                      ;; Case 2: key  = yk
    243                       (values root (Tree color a key value b))
     244                      (list root (Tree color a key value b))
    244245                      ;; Case 3: key  > yk
    245246                      (match b
     
    248249                               key zk
    249250                               ;; Case 3.1: key < zk
    250                                (let-values (((found? c1) (ins c)))
    251                                  (values found?
    252                                          (match c1
    253                                                 (($ tree 'Tree 'Red e wk w f)
    254                                                  (Tree R (Tree B a yk y e)  wk  w (Tree B f zk z d)))
    255                                                 (else (Tree B a yk y (Tree R c1 zk z d))))))
     251                               (match-let (((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))))))
    256257                               ;; Case 3.2: key = zk
    257                                (values b (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)))
    258259                               ;; Case 3.3: key > zk
    259                                (let-values (((found? d1) (ins d)))
    260                                  (values found?
    261                                          (match d1
    262                                                 (($ tree 'Tree 'Red e wk w f)
    263                                                  (Tree R (Tree B a yk y c)  zk z (Tree B e wk w f)))
    264                                                 (else (Tree B a yk y (Tree R c zk z d1))))))))
    265                              (else (let-values (((found? b1) (ins b)))
    266                                      (values found? (Tree B a yk y b1)))))))))
     260                               (match-let (((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 (match-let (((found? b1) (ins b)))
     267                                               (list found? (Tree B a yk y b1)))))))))
    267268
    268269      (ins root))
     
    334335        (match tree
    335336               (($ tree 'Tree 'Red ($ tree 'Empty) yk y b)
    336                 (values yk y (cons #f (zip z b))))
     337                (list yk y (cons #f (zip z b))))
    337338               (($ tree 'Tree 'Black ($ tree Empty) yk y b)
    338                 (values yk y (bbZip z b)))
     339                (list yk y (bbZip z b)))
    339340               (($ tree 'Tree color a yk y b)
    340341                (delMin a (Left color yk y b z)))
     
    350351                (cdr  (bbZip z b)))
    351352               (( color a b)
    352                 (let-values (((xk x b)  (delMin b (Top))))
    353                     (match b
    354                            ((#t . b1)  (cdr  (bbZip z (Tree color a xk x b1))))
    355                            ((#f . b1)  (zip z (Tree color a xk x b1))))))))
     353                (match-let (((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))))))))
    356357
    357358
     
    549550        ((put!)
    550551         (lambda (key value)
    551            (let-values (((found? new-root)  (insert root key value)))
    552                        (set! root new-root)
    553                        (if (not found?)  (set! size (+ 1 size)))
    554                        found?)))
     552           (match-let (((found? new-root)  (insert root key value)))
     553                      (set! root new-root)
     554                      (if (not found?)  (set! size (+ 1 size)))
     555                      found?)))
    555556
    556557        ((put)
    557558         (lambda (key value)
    558            (let-values (((found? new-root)  (insert root key value)))
    559                        (make-rb-tree-dispatcher  new-root (if (not found?) (+ 1 size) size)))))
     559           (match-let (((found? new-root)  (insert root key value)))
     560                      (make-rb-tree-dispatcher  new-root (if (not found?) (+ 1 size) size)))))
    560561
    561562
  • rb-tree/trunk/rb-tree.setup

    r6628 r8037  
    2121
    2222  ; Assoc list with properties for your extension:
    23   '((version 2.3)
     23  '((version 2.4)
    2424    (documentation "rb-tree.html")
    2525    ,@(if has-exports? `((exports "rb-tree.exports")) (list)) ))
  • rb-tree/trunk/tests/run.scm

    r5343 r8037  
    88(require-extension rb-tree)
    99
    10 (define-macro (++! x) `(set! ,x (fx+ 1 ,x)))
    11 (define-macro (++ x) `(fx+ 1 ,x))
    12 (define-macro (--! x) `(set! ,x (fx- ,x 1)))
    13 (define-macro (-- x) `(fx- ,x 1))
     10(define-macro (++! x) `(set! ,x (+ 1 ,x)))
     11(define-macro (++ x)  `(+ 1 ,x))
     12(define-macro (--! x) `(set! ,x (- ,x 1)))
     13(define-macro (-- x)  `(- ,x 1))
    1414
    1515
     
    7575           (test/equal "using fold to sum the elements in the rb-tree"
    7676                       ((rb-tree 'fold) (lambda (x sum) (+ x sum)) 0)
    77                        (* 50 (+ (+ 1 min-key) (+ 1 max-key))))
     77                       (* (/ max-key 2) (+ (+ 1 min-key) (+ 1 max-key))))
    7878
    7979           (test-define "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.