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

optimize null and one-argument lists

Browse Source 
svn: r18736
This commit is contained in:
Eli Barzilay 2010-04-06 15:26:15 +00:00
parent cc3c334026
commit 90acb35315
1 changed files with 42 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
collects/scheme/list.ss
View File

@ -193,42 +193,48 @@
;; shorter ones too, but that adds a ton of code to the result (about 2k). ;; shorter ones too, but that adds a ton of code to the result (about 2k).
(define-syntax-rule (no-key x) x) (define-syntax-rule (no-key x) x)
(unless (list? l) (raise-type-error 'remove-duplicates "list" l)) (unless (list? l) (raise-type-error 'remove-duplicates "list" l))
(let ([h (cond [(< (length l) 40) #f] (let* ([len (length l)]
[(eq? =? eq?) (make-hasheq)] [h (cond [(<= len 1) #t]
[(eq? =? equal?) (make-hash)] [(<= len 40) #f]
[else #f])]) [(eq? =? eq?) (make-hasheq)]
(if h [(eq? =? equal?) (make-hash)]
;; Using a hash table when the list is long enough and when using [else #f])])
;; `equal?' or `eq?'. The length threshold (40) was determined by (case h
;; trying it out with lists of length n holding (random n) numbers. [(#t) l]
(let-syntax ([loop [(#f)
(syntax-rules () ;; plain n^2 list traversal (optimized for common cases) for short lists
[(_ getkey) ;; and for equalities other than `eq?' or `equal?' The length threshold
(let loop ([l l]) ;; above (40) was determined by trying it out with lists of length n
(if (null? l) ;; holding (random n) numbers.
l (let ([key (or key (lambda (x) x))])
(let* ([x (car l)] [k (getkey x)] [l (cdr l)]) (let-syntax ([loop (syntax-rules ()
(if (hash-ref h k #f) [(_ search)
(loop l) (let loop ([l l] [seen null])
(begin (hash-set! h k #t) (if (null? l)
(cons x (loop l)))))))])]) l
(if key (loop key) (loop no-key))) (let* ([x (car l)] [k (key x)] [l (cdr l)])
;; plain n^2 list traversal (optimized for common cases) (if (search k seen)
(let ([key (or key (lambda (x) x))]) (loop l seen)
(let-syntax ([loop (syntax-rules () (cons x (loop l (cons k seen)))))))])])
[(_ search) (cond [(eq? =? equal?) (loop member)]
(let loop ([l l] [seen null]) [(eq? =? eq?) (loop memq)]
(if (null? l) [(eq? =? eqv?) (loop memv)]
l [else (loop (lambda (x seen)
(let* ([x (car l)] [k (key x)] [l (cdr l)]) (ormap (lambda (y) (=? x y)) seen)))])))]
(if (search k seen) [else
(loop l seen) ;; Use a hash for long lists with simple hash tables.
(cons x (loop l (cons k seen)))))))])]) (let-syntax ([loop
(cond [(eq? =? equal?) (loop member)] (syntax-rules ()
[(eq? =? eq?) (loop memq)] [(_ getkey)
[(eq? =? eqv?) (loop memv)] (let loop ([l l])
[else (loop (lambda (x seen) (if (null? l)
(ormap (lambda (y) (=? x y)) seen)))])))))) l
(let* ([x (car l)] [k (getkey x)] [l (cdr l)])
(if (hash-ref h k #f)
(loop l)
(begin (hash-set! h k #t)
(cons x (loop l)))))))])])
(if key (loop key) (loop no-key)))])))
(define (filter-map f l . ls) (define (filter-map f l . ls)
(unless (and (procedure? f) (procedure-arity-includes? f (add1 (length ls)))) (unless (and (procedure? f) (procedure-arity-includes? f (add1 (length ls))))