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

adjust `for/vector' et al. to avoid intermediate lists

Browse Source 
When a length is not specified, build the result by growing
a temporary vector to hold the results, instead of accumulating
them into a list.
This commit is contained in:
Matthew Flatt 2012-08-15 08:47:54 -06:00
parent 62fecb1b0b
commit 8a26d83651
2 changed files with 55 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/racket/private/for.rkt
View File

@ -1357,20 +1357,36 @@
(lambda (x) x) (lambda (x) x)
(lambda (x) `(,#'cons ,x ,#'fold-var))) (lambda (x) `(,#'cons ,x ,#'fold-var)))
(define (grow-vector vec)
(define n (vector-length vec))
(define new-vec (make-vector (* 2 n)))
(vector-copy! new-vec 0 vec 0 n)
new-vec)
(define (shrink-vector vec i)
(define new-vec (make-vector i))
(vector-copy! new-vec 0 vec 0 i)
new-vec)
(define-for-syntax (for_/vector stx for_/vector-stx for_/fold/derived-stx wrap-all?) (define-for-syntax (for_/vector stx for_/vector-stx for_/fold/derived-stx wrap-all?)
(syntax-case stx () (syntax-case stx ()
[(for*/vector (for-clause ...) body ...) [(_ (for-clause ...) body ...)
(with-syntax ([orig-stx stx] (with-syntax ([orig-stx stx]
[for_/fold/derived for_/fold/derived-stx]) [for_/fold/derived for_/fold/derived-stx])
(syntax/loc stx (syntax/loc stx
(list->vector (let-values ([(vec i)
(reverse (for_/fold/derived
(for_/fold/derived orig-stx
orig-stx ([vec (make-vector 16)]
([l null]) [i 0])
(for-clause ...) (for-clause ...)
(cons (let () body ...) l))))))] (let ([new-vec (if (eq? i (unsafe-vector-length vec))
[(for*/vector #:length length-expr (for-clause ...) body ...) (grow-vector vec)
vec)])
(unsafe-vector-set! new-vec i (let () body ...))
(values new-vec (unsafe-fx+ i 1))))])
(shrink-vector vec i))))]
[(_ #:length length-expr (for-clause ...) body ...)
(with-syntax ([orig-stx stx] (with-syntax ([orig-stx stx]
[(limited-for-clause ...) [(limited-for-clause ...)
;; If `wrap-all?', wrap all binding clauses. Otherwise, wrap ;; If `wrap-all?', wrap all binding clauses. Otherwise, wrap

45
collects/racket/private/vector-wraps.rkt
View File

@ -2,6 +2,7 @@
(require '#%flfxnum (require '#%flfxnum
"for.rkt" "for.rkt"
racket/unsafe/ops
(for-syntax racket/base)) (for-syntax racket/base))
(provide define-vector-wraps) (provide define-vector-wraps)
@ -31,13 +32,22 @@
#'in-fXvector* #'in-fXvector*
#'unsafe-fXvector-ref)) #'unsafe-fXvector-ref))
(define (list->fXvector l) (define (unsafe-fXvector-copy! vec dest-start flv start end)
(let ((n (length l))) (let ([len (- end start)])
(let ((v (make-fXvector n))) (for ([i (in-range len)])
(for ((i (in-range n)) (unsafe-fXvector-set! vec (unsafe-fx+ i dest-start)
(x (in-list l))) (unsafe-fXvector-ref flv (unsafe-fx+ i start))))))
(fXvector-set! v i x))
v))) (define (grow-fXvector vec)
(define n (fXvector-length vec))
(define new-vec (make-fXvector (* 2 n)))
(unsafe-fXvector-copy! new-vec 0 vec 0 n)
new-vec)
(define (shrink-fXvector vec i)
(define new-vec (make-fXvector i))
(unsafe-fXvector-copy! new-vec 0 vec 0 i)
new-vec)
(define-for-syntax (for_/fXvector stx for_/fXvector-stx for_/fold/derived-stx wrap-all?) (define-for-syntax (for_/fXvector stx for_/fXvector-stx for_/fold/derived-stx wrap-all?)
(syntax-case stx () (syntax-case stx ()
@ -45,13 +55,18 @@
(with-syntax ([orig-stx stx] (with-syntax ([orig-stx stx]
[for_/fold/derived for_/fold/derived-stx]) [for_/fold/derived for_/fold/derived-stx])
(syntax/loc stx (syntax/loc stx
(list->fXvector (let-values ([(vec i)
(reverse (for_/fold/derived
(for_/fold/derived orig-stx
orig-stx ([vec (make-fXvector 16)]
([l null]) [i 0])
(for-clause ...) (for-clause ...)
(cons (let () body ...) l))))))] (let ([new-vec (if (eq? i (unsafe-fXvector-length vec))
(grow-fXvector vec)
vec)])
(unsafe-fXvector-set! new-vec i (let () body ...))
(values new-vec (unsafe-fx+ i 1))))])
(shrink-fXvector vec i))))]
[(for*/fXvector #:length length-expr (for-clause ...) body ...) [(for*/fXvector #:length length-expr (for-clause ...) body ...)
(with-syntax ([orig-stx stx] (with-syntax ([orig-stx stx]
[(limited-for-clause ...) [(limited-for-clause ...)
@ -120,5 +135,5 @@
(let* ([len (- end start)] (let* ([len (- end start)]
[vec (make-fXvector len)]) [vec (make-fXvector len)])
(for ([i (in-range len)]) (for ([i (in-range len)])
(unsafe-fXvector-set! vec i (unsafe-fXvector-ref flv (+ i start)))) (unsafe-fXvector-set! vec i (unsafe-fXvector-ref flv (unsafe-fx+ i start))))
vec))))) vec)))))