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

tweak performance of `for' with non-inlined sequences

Browse Source
This commit is contained in:
Matthew Flatt 2011-03-16 17:02:53 -06:00
parent c51daeb392
commit ad8e959a98
3 changed files with 114 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -278,10 +278,10 @@
(#,((syntax-local-certifier #f) #'make-sequence) '(id ...) rhs)]) (#,((syntax-local-certifier #f) #'make-sequence) '(id ...) rhs)])
(void) (void)
([pos init]) ([pos init])
(pos-cont? pos) (if pos-cont? (pos-cont? pos) #t)
([(id ...) (pos->vals pos)]) ([(id ...) (pos->vals pos)])
(val-cont? id ...) (if val-cont? (val-cont? id ...) #t)
(all-cont? pos id ...) (if all-cont? (all-cont? pos id ...) #t)
((pos-next pos)))))))] ((pos-next pos)))))))]
[_ [_
(raise-syntax-error #f (raise-syntax-error #f
@ -392,13 +392,13 @@
(make-do-sequence (lambda () (:list-gen l)))) (make-do-sequence (lambda () (:list-gen l))))
(define (:list-gen l) (define (:list-gen l)
(values car cdr l pair? void void)) (values car cdr l pair? #f #f))
(define (in-mlist l) (define (in-mlist l)
(make-do-sequence (lambda () (:mlist-gen l)))) (make-do-sequence (lambda () (:mlist-gen l))))
(define (:mlist-gen l) (define (:mlist-gen l)
(values mcar mcdr l mpair? void void)) (values mcar mcdr l mpair? #f #f))
(define (in-input-port-bytes p) (define (in-input-port-bytes p)
(unless (input-port? p) (unless (input-port? p)
@ -406,9 +406,9 @@
(make-do-sequence (lambda () (:input-port-gen p)))) (make-do-sequence (lambda () (:input-port-gen p))))
(define (:input-port-gen p) (define (:input-port-gen p)
(values read-byte values p void (values read-byte values p #f
(lambda (x) (not (eof-object? x))) (lambda (x) (not (eof-object? x)))
void)) #f))
(define (in-input-port-chars p) (define (in-input-port-chars p)
(unless (input-port? p) (unless (input-port? p)
@ -478,8 +478,8 @@
(lambda (pos) (hash-iterate-next ht pos)) (lambda (pos) (hash-iterate-next ht pos))
(hash-iterate-first ht) (hash-iterate-first ht)
(lambda (pos) pos) ; #f position means stop (lambda (pos) pos) ; #f position means stop
void #f
void)) #f))
;; Vector-like sequences -------------------------------------------------- ;; Vector-like sequences --------------------------------------------------
@ -549,8 +549,8 @@
(if (> step 0) (if (> step 0)
(lambda (i) (< i stop)) (lambda (i) (< i stop))
(lambda (i) (> i stop))) (lambda (i) (> i stop)))
void #f
void))])) #f))]))
(define-for-syntax (make-in-vector-like in-vector-name (define-for-syntax (make-in-vector-like in-vector-name
type-name-str type-name-str
@ -692,9 +692,9 @@
init init
pos-cont? pos-cont?
(case-lambda (case-lambda
[(val) (and (pre-cont? val) [(val) (and (if pre-cont? (pre-cont? val) #t)
(not (pred val)))] (not (pred val)))]
[vals (and (apply pre-cont? vals) [vals (and (if pre-cont? (apply pre-cont? vals) #t)
(not (apply pred vals)))]) (not (apply pred vals)))])
post-cont?))))) post-cont?)))))
@ -712,9 +712,9 @@
pos-cont? pos-cont?
pre-cont? pre-cont?
(case-lambda (case-lambda
[(pos val) (and (post-cont? pos val) [(pos val) (and (if post-cont? (post-cont? pos val) #t)
(not (pred val)))] (not (pred val)))]
[(pos . vals) (and (apply pos-cont? pos vals) [(pos . vals) (and (if post-cont? (apply post-cont? pos vals) #t)
(not (apply pred vals)))])))))) (not (apply pred vals)))]))))))
(define (in-indexed g) (define (in-indexed g)
@ -725,9 +725,12 @@
(values (lambda (pos) (values (pos->val (car pos)) (cdr pos))) (values (lambda (pos) (values (pos->val (car pos)) (cdr pos)))
(lambda (pos) (cons (pos-next (car pos)) (add1 (cdr pos)))) (lambda (pos) (cons (pos-next (car pos)) (add1 (cdr pos))))
(cons init 0) (cons init 0)
(lambda (pos) (pos-cont? (car pos))) (and pos-cont?
(lambda (val idx) (pre-cont? val)) (lambda (pos) (pos-cont? (car pos))))
(lambda (pos val idx) (post-cont? pos val))))))) (and pre-cont?
(lambda (val idx) (pre-cont? val)))
(and post-cont?
(lambda (pos val idx) (post-cont? pos val))))))))
(define (in-value v) (define (in-value v)
(make-do-sequence (lambda () (make-do-sequence (lambda ()
@ -791,16 +794,22 @@
pos-nexts pos-nexts
poses)) poses))
inits inits
(lambda (poses) (andmap (lambda (pos-cont? pos) (pos-cont? pos)) (and (ormap values pos-cont?s)
pos-cont?s (lambda (poses) (andmap (lambda (pos-cont? pos)
poses)) (if pos-cont? (pos-cont? pos) #t))
(lambda vals (andmap (lambda (pre-cont? val) (pre-cont? val)) pos-cont?s
pre-cont?s poses)))
vals)) (and (ormap values pre-cont?s)
(lambda (poses . vals) (andmap (lambda (post-cont? pos val) (post-cont? pos val)) (lambda vals (andmap (lambda (pre-cont? val)
post-cont?s (if pre-cont? (pre-cont? val) #t))
poses pre-cont?s
vals)))))))) vals)))
(and (ormap values post-cont?s)
(lambda (poses . vals) (andmap (lambda (post-cont? pos val)
(if post-cont? (post-cont? pos val) #t))
post-cont?s
poses
vals)))))))))
(define (in-producer producer stop . more) (define (in-producer producer stop . more)
(make-do-sequence (make-do-sequence
@ -810,13 +819,13 @@
(lambda (_) (apply producer more))) (lambda (_) (apply producer more)))
void void
(void) (void)
void #f
(if (procedure? stop) (if (procedure? stop)
(if (equal? 1 (procedure-arity stop)) (if (equal? 1 (procedure-arity stop))
(lambda (x) (not (stop x))) (lambda (x) (not (stop x)))
(lambda xs (not (apply stop xs)))) (lambda xs (not (apply stop xs))))
(lambda (x) (not (eq? x stop)))) (lambda (x) (not (eq? x stop))))
void)))) #f))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; running sequences outside of a loop: ;; running sequences outside of a loop:
@ -838,11 +847,11 @@
(lambda () (prep-val!) (next))] (lambda () (prep-val!) (next))]
[init-prep-val! [init-prep-val!
(lambda () (lambda ()
(if (pos-cont? pos) (if (if pos-cont? (pos-cont? pos) #t)
(call-with-values (call-with-values
(lambda () (pos->val pos)) (lambda () (pos->val pos))
(lambda vals (lambda vals
(if (apply pre-cont? vals) (if (if pre-cont? (apply pre-cont? vals) #t)
(begin (begin
(set! more? (lambda () #t)) (set! more? (lambda () #t))
(set! next (set! next
@ -850,7 +859,9 @@
(let ([v vals]) (let ([v vals])
(set! prep-val! (set! prep-val!
(lambda () (lambda ()
(if (apply post-cont? pos vals) (if (if post-cont?
(apply post-cont? pos vals)
#t)
(begin (begin
(set! pos (pos-next pos)) (set! pos (pos-next pos))
(set! prep-val! init-prep-val!) (set! prep-val! init-prep-val!)

35
collects/scribblings/reference/sequences.scrbl
View File

@ -290,9 +290,9 @@ in the sequence.
@defproc[(make-do-sequence [thunk (-> (values (any/c . -> . any) @defproc[(make-do-sequence [thunk (-> (values (any/c . -> . any)
(any/c . -> . any/c) (any/c . -> . any/c)
any/c any/c
(any/c . -> . any/c) (or/c (any/c . -> . any/c) #f)
(() () #:rest list? . ->* . any/c) (or/c (() () #:rest list? . ->* . any/c) #f)
((any/c) () #:rest list? . ->* . any/c)))]) (or/c ((any/c) () #:rest list? . ->* . any/c) #f)))])
sequence?]{ sequence?]{
Returns a sequence whose elements are generated by the procedures and Returns a sequence whose elements are generated by the procedures and
initial value returned by the thunk. The sequence is defined in terms initial value returned by the thunk. The sequence is defined in terms
@ -308,22 +308,33 @@ in the sequence.
@item{The second result is a @scheme[_next-pos] procedure that takes @item{The second result is a @scheme[_next-pos] procedure that takes
the current position and returns the next position.} the current position and returns the next position.}
@item{The third result is the initial position.} @item{The third result is the initial position.}
@item{The fourth result takes the current position and returns a @item{The fourth result is a @racket[_continue-with-val?] function that
takes the current position and returns a
true result if the sequence includes the value(s) for the current true result if the sequence includes the value(s) for the current
position, and false if the sequence should end instead of position, and false if the sequence should end instead of
including the value(s).} including the value(s). Alternatively, the fourth result can be
@item{The fifth result is like the fourth result, but it takes the @racket[#f] to indicate that the sequence should always include the
current element value(s) instead of the current position.} current value(s).}
@item{The sixth result is like the fourth result, but it takes both @item{The fifth result is a @racket[_continue-with-pos?] function that is
like the fourth result, but it takes the
current element value(s) instead of the current position.
Alternatively, the fifth result can be
@racket[#f] to indicate that the sequence should always include the
value(s) at the current position.}
@item{The sixth result is a @racket[_continue-after-pos+val?] procedure
that takes both
the current position and the current element value(s) and the current position and the current element value(s) and
determines a sequence end after the current element is already determines whether the sequence ends after the current element is already
included in the sequence.}] included in the sequence.
Alternatively, the sixth result can be
@racket[#f] to indicate that the sequence can always continue
after the current value(s).}]
Each of the procedures listed above is called only once per position. Each of the procedures listed above is called only once per position.
Among the last three procedures, as soon as one of the procedures Among the last three procedures, as soon as one of the procedures
returns @scheme[#f], the sequence ends, and none are called again. returns @scheme[#f], the sequence ends, and none are called again.
Typically, one of the functions determines the end condition, and the Typically, one of the functions determines the end condition, and
other two functions always return @scheme[#t].} @scheme[#f] is used in place of the other two functions.}
@defthing[prop:sequence struct-type-property?]{ @defthing[prop:sequence struct-type-property?]{

47
collects/tests/racket/for.rktl
View File

@ -98,6 +98,53 @@
(open-input-string "1 2 3\n4 5"))]) (open-input-string "1 2 3\n4 5"))])
(list i j))) (list i j)))
(let ([five-seq
(lambda (pos pre post)
(test-sequence [(1 2 3 4 5)]
(make-do-sequence (lambda ()
(values add1
add1
0
pos
pre
post)))))])
(five-seq (lambda (pos) (pos . < . 5))
#f
#f)
(five-seq #f
(lambda (val) (val . < . 6))
#f)
(five-seq #f
#f
(lambda (pos val) (val . < . 5))))
(let ([fives-seq
(lambda (pos pre post)
(test-sequence [(1 2 3 4 5) ("0" "1" "2" "3" "4")]
(make-do-sequence (lambda ()
(values (lambda (n) (values (add1 n)
(number->string n)))
add1
0
pos
pre
post)))))])
(fives-seq (lambda (pos) (pos . < . 5))
#f
#f)
(fives-seq #f
(lambda (val1 val2) (val1 . < . 6))
#f)
(fives-seq #f
(lambda (val1 val2) (not (string=? val2 "5")))
#f)
(fives-seq #f
#f
(lambda (pos val1 val2) (val1 . < . 5)))
(fives-seq #f
#f
(lambda (pos val1 val2) (not (string=? val2 "4")))))
;; Basic sanity checks. ;; Basic sanity checks.
(test '#(1 2 3 4) 'for/vector (for/vector ((i (in-range 4))) (+ i 1))) (test '#(1 2 3 4) 'for/vector (for/vector ((i (in-range 4))) (+ i 1)))
(test '#(1 2 3 4) 'for/vector-fast (for/vector #:length 4 ((i (in-range 4))) (+ i 1))) (test '#(1 2 3 4) 'for/vector-fast (for/vector #:length 4 ((i (in-range 4))) (+ i 1)))