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

Further optimizations to `merge'.

Browse Source 
svn: r17003
This commit is contained in:
Eli Barzilay 2009-11-23 18:48:06 +00:00
parent ebfdbe4bb0
commit c68eeb97ca
1 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/scheme/private/sort.ss
View File

@ -33,7 +33,7 @@ doing these checks.
(define-syntax foo (syntax-rules () [(_ . pattern) template]))]))
(define-syntax-rule (sort-internal-body v *<? n has-getkey? getkey)
(begin
(let ([n/2 (ceiling (/ n 2))])
(define-syntax-rule (<? x y)
(if has-getkey? (*<? (getkey x) (getkey y)) (*<? x y)))
(define-syntax-rule (ref n) (vector-ref v n))
@ -42,16 +42,22 @@ doing these checks.
(define-syntax-rule (merge lo? A1 A2 B1 B2 C1 C2)
(let ([b2 B2])
(let loop ([a1 A1] [b1 B1] [c1 C1])
(if (<= b2 b1)
(let loop ([a1 a1] [c1 c1])
(when (< c1 b1) (set! c1 (ref a1)) (loop (add1 a1) (add1 c1))))
(when (< c1 b1)
(let ([x (ref a1)] [y (ref b1)])
(if (if lo? (not (<? y x)) (<? x y))
(begin (set! c1 x) (loop (add1 a1) b1 (add1 c1)))
(begin (set! c1 y) (loop a1 (add1 b1) (add1 c1))))))))))
(begin (set! c1 x)
(let ([a1 (add1 a1)] [c1 (add1 c1)])
(when (< c1 b1) (loop a1 b1 c1))))
(begin (set! c1 y)
(let ([b1 (add1 b1)] [c1 (add1 c1)])
(if (<= b2 b1)
(let loop ([a1 a1] [c1 c1])
(when (< c1 b1)
(set! c1 (ref a1))
(loop (add1 a1) (add1 c1))))
(loop a1 b1 c1)))))))))
(define (copying-mergesort Alo Ahi Blo Bhi)
(unless (= (- Ahi Alo) (- Bhi Blo)) (error "poof!!!"))
(cond [(< Alo (sub1 Ahi))
(let ([Amid (/ (+ Alo Ahi) 2)] [Bmid (/ (+ Blo Bhi) 2)])
(copying-mergesort Amid Ahi Bmid Bhi)
@ -60,13 +66,10 @@ doing these checks.
[(= Alo (sub1 Ahi))
(set! Blo (ref Alo))]))
(define-syntax-rule (mergesort Alo Ahi B1lo B1hi)
(let ([Amid (/ (+ Alo Ahi) 2)])
(let ([Alo 0] [Amid n/2] [Ahi n] [B1lo n] [B1hi (+ n n/2)])
(copying-mergesort Amid Ahi B1lo B1hi)
(copying-mergesort Alo Amid Amid Ahi)
(merge #f B1lo B1hi Amid Ahi Alo Ahi)))
(mergesort 0 n n (+ n (/ n 2)))))
(merge #f B1lo B1hi Amid Ahi Alo Ahi))))
(define sort-internals (make-hasheq))
(define _