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

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

@ -1357,20 +1357,36 @@
(lambda (x) x)
(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?)
(syntax-case stx ()
[(for*/vector (for-clause ...) body ...)
[(_ (for-clause ...) body ...)
(with-syntax ([orig-stx stx]
[for_/fold/derived for_/fold/derived-stx])
(syntax/loc stx
(list->vector
(reverse
(let-values ([(vec i)
(for_/fold/derived
orig-stx
([l null])
([vec (make-vector 16)]
[i 0])
(for-clause ...)
(cons (let () body ...) l))))))]
[(for*/vector #:length length-expr (for-clause ...) body ...)
(let ([new-vec (if (eq? i (unsafe-vector-length vec))
(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]
[(limited-for-clause ...)
;; If `wrap-all?', wrap all binding clauses. Otherwise, wrap

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

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