suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

some spedup in merge!

Browse Source 
svn: r2566
This commit is contained in:
Eli Barzilay 2006-04-01 08:23:21 +00:00
parent 0f122fbc0d
commit a8e8e08677
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/mzlib/list.ss
View File

@ -45,21 +45,22 @@
;; used by sort-internal, but can be useful by itself ;; used by sort-internal, but can be useful by itself
(define (merge! a b less?) (define (merge! a b less?)
(define (loop r a b) (define (loop r a b r-a?) ; r-a? for optimization -- is r connected to a?
(if (less? (car b) (car a)) (if (less? (car b) (car a))
(begin (set-cdr! r b) (begin (when r-a? (set-cdr! r b))
(if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b)))) (if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b) #f)))
;; (car a) <= (car b) ;; (car a) <= (car b)
(begin (set-cdr! r a) (begin (unless r-a? (set-cdr! r a))
(if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b))))) (if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b #t)))))
(cond [(null? a) b] (cond [(null? a) b]
[(null? b) a] [(null? b) a]
[(less? (car b) (car a)) [(less? (car b) (car a))
(if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b))) (if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b) #f))
b] b]
[else ; (car a) <= (car b) [else ; (car a) <= (car b)
(if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b)) (if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b #t))
a])) a]))
;; a non-destructive version for symmetry with merge! ;; a non-destructive version for symmetry with merge!
(define (merge a b less?) (define (merge a b less?)
(cond [(null? a) b] (cond [(null? a) b]