Changeset 20639 in project


Ignore:
Timestamp:
10/04/10 10:00:26 (11 years ago)
Author:
Ivan Raikov
Message:

rb-tree: more general extension to the map combinator interface

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/rb-tree/trunk/rb-tree.scm

    r20637 r20639  
    867867           
    868868(define (wrap f)
    869   (lambda (m1 m2 #!key (f-key-compare #f))
     869  (lambda (m1 m2 #!key (k1 identity) (k2 identity))
    870870    (let ((m1 (m1 'tree-map))
    871871          (m2 (m2 'tree-map)))
     
    874874            (t1 (map-root m1))
    875875            (t2 (map-root m2)))
    876         (let ((f1 (f (or f-key-compare insdel-key-compare))))
     876        (let ((f1 (f k1 k2 insdel-key-compare)))
    877877          (match-let (((n result) (f1 (start t1) (start t2) 0 (Zero))))
    878878                     (make-tree-map n (link-all result) key-compare insdel-key-compare)))))))
     
    892892
    893893(define (union-with merge-fn)
    894   (define (union key-compare)
     894  (define (union k1 k2 key-compare)
    895895    (lambda (t1 t2 n result)
    896896      (let recur ((t1 t1) (t2 t2) (n n) (result result))
     
    907907               
    908908               (((($ tree 'Tree _ _ xk x _) r1) (($ tree 'Tree _ _ yk y _) r2))
    909                 (let ((c (key-compare xk yk)))
    910                   (cond ((negative? c)   (recur r1 t2 (+ 1 n) (add-item xk x result)))
    911                         ((zero? c)       (recur r1 r2 (+ 1 n) (add-item xk (merge-fn x y) result)))
    912                         ((positive? c)   (recur t1 r2 (+ 1 n) (add-item yk y result))))))
    913                
     909                (let ((xk1 (k1 xk)) (yk1 (k2 yk)))
     910                  (let ((c (key-compare xk1 yk1)))
     911                    (cond ((negative? c)   (recur r1 t2 (+ 1 n) (add-item xk1 x result)))
     912                          ((zero? c)       (recur r1 r2 (+ 1 n) (add-item xk1 (merge-fn x y) result)))
     913                          ((positive? c)   (recur t1 r2 (+ 1 n) (add-item yk1 y result)))))))
     914               
    914915               ))))
    915916  (wrap union))
     
    917918
    918919(define (union-withi merge-fn)
    919   (define (union key-compare)
     920  (define (union k1 k2 key-compare)
    920921    (lambda (t1 t2 n result)
    921922      (let recur ((t1 t1) (t2 t2) (n n) (result result))
     
    932933               
    933934               (((($ tree 'Tree _ _ xk x _) r1) (($ tree 'Tree_ _ yk y _) r2))
    934                 (let ((c (key-compare xk yk)))
    935                   (cond ((negative? c)   (recur r1 t2 (+ 1 n) (add-item xk x result)))
    936                         ((zero? c)       (recur r1 r2 (+ 1 n) (add-item xk (merge-fn xk x y) result)))
    937                         ((positive? c)   (recur t1 r2 (+ 1 n) (add-item yk y result))))))
     935                (let ((xk1 (k1 xk)) (yk1 (k2 yk)))
     936                  (let ((c (key-compare xk1 yk1)))
     937                    (cond ((negative? c)   (recur r1 t2 (+ 1 n) (add-item xk1 x result)))
     938                          ((zero? c)       (recur r1 r2 (+ 1 n) (add-item xk1 (merge-fn xk1 x y) result)))
     939                          ((positive? c)   (recur t1 r2 (+ 1 n) (add-item yk1 y result)))))))
    938940               
    939941               ))))
Note: See TracChangeset for help on using the changeset viewer.