tweak performance of `for' with non-inlined sequences
This commit is contained in:
Matthew Flatt
parent
c51daeb392
commit
ad8e959a98
|
|
@ -278,10 +278,10 @@
|
|||
(#,((syntax-local-certifier #f) #'make-sequence) '(id ...) rhs)])
|
||||
(void)
|
||||
([pos init])
|
||||
(pos-cont? pos)
|
||||
(if pos-cont? (pos-cont? pos) #t)
|
||||
([(id ...) (pos->vals pos)])
|
||||
(val-cont? id ...)
|
||||
(all-cont? pos id ...)
|
||||
(if val-cont? (val-cont? id ...) #t)
|
||||
(if all-cont? (all-cont? pos id ...) #t)
|
||||
((pos-next pos)))))))]
|
||||
[_
|
||||
(raise-syntax-error #f
|
||||
|
|
@ -392,13 +392,13 @@
|
|||
(make-do-sequence (lambda () (: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)
|
||||
(make-do-sequence (lambda () (: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)
|
||||
(unless (input-port? p)
|
||||
|
|
@ -406,9 +406,9 @@
|
|||
(make-do-sequence (lambda () (: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)))
|
||||
void))
|
||||
#f))
|
||||
|
||||
(define (in-input-port-chars p)
|
||||
(unless (input-port? p)
|
||||
|
|
@ -478,8 +478,8 @@
|
|||
(lambda (pos) (hash-iterate-next ht pos))
|
||||
(hash-iterate-first ht)
|
||||
(lambda (pos) pos) ; #f position means stop
|
||||
void
|
||||
void))
|
||||
#f
|
||||
#f))
|
||||
|
||||
;; Vector-like sequences --------------------------------------------------
|
||||
|
||||
|
|
@ -549,8 +549,8 @@
|
|||
(if (> step 0)
|
||||
(lambda (i) (< i stop))
|
||||
(lambda (i) (> i stop)))
|
||||
void
|
||||
void))]))
|
||||
#f
|
||||
#f))]))
|
||||
|
||||
(define-for-syntax (make-in-vector-like in-vector-name
|
||||
type-name-str
|
||||
|
|
@ -692,9 +692,9 @@
|
|||
init
|
||||
pos-cont?
|
||||
(case-lambda
|
||||
[(val) (and (pre-cont? val)
|
||||
[(val) (and (if pre-cont? (pre-cont? val) #t)
|
||||
(not (pred val)))]
|
||||
[vals (and (apply pre-cont? vals)
|
||||
[vals (and (if pre-cont? (apply pre-cont? vals) #t)
|
||||
(not (apply pred vals)))])
|
||||
post-cont?)))))
|
||||
|
||||
|
|
@ -712,9 +712,9 @@
|
|||
pos-cont?
|
||||
pre-cont?
|
||||
(case-lambda
|
||||
[(pos val) (and (post-cont? pos val)
|
||||
[(pos val) (and (if post-cont? (post-cont? pos val) #t)
|
||||
(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)))]))))))
|
||||
|
||||
(define (in-indexed g)
|
||||
|
|
@ -725,9 +725,12 @@
|
|||
(values (lambda (pos) (values (pos->val (car pos)) (cdr pos)))
|
||||
(lambda (pos) (cons (pos-next (car pos)) (add1 (cdr pos))))
|
||||
(cons init 0)
|
||||
(lambda (pos) (pos-cont? (car pos)))
|
||||
(lambda (val idx) (pre-cont? val))
|
||||
(lambda (pos val idx) (post-cont? pos val)))))))
|
||||
(and pos-cont?
|
||||
(lambda (pos) (pos-cont? (car pos))))
|
||||
(and pre-cont?
|
||||
(lambda (val idx) (pre-cont? val)))
|
||||
(and post-cont?
|
||||
(lambda (pos val idx) (post-cont? pos val))))))))
|
||||
|
||||
(define (in-value v)
|
||||
(make-do-sequence (lambda ()
|
||||
|
|
@ -791,16 +794,22 @@
|
|||
pos-nexts
|
||||
poses))
|
||||
inits
|
||||
(lambda (poses) (andmap (lambda (pos-cont? pos) (pos-cont? pos))
|
||||
pos-cont?s
|
||||
poses))
|
||||
(lambda vals (andmap (lambda (pre-cont? val) (pre-cont? val))
|
||||
pre-cont?s
|
||||
vals))
|
||||
(lambda (poses . vals) (andmap (lambda (post-cont? pos val) (post-cont? pos val))
|
||||
post-cont?s
|
||||
poses
|
||||
vals))))))))
|
||||
(and (ormap values pos-cont?s)
|
||||
(lambda (poses) (andmap (lambda (pos-cont? pos)
|
||||
(if pos-cont? (pos-cont? pos) #t))
|
||||
pos-cont?s
|
||||
poses)))
|
||||
(and (ormap values pre-cont?s)
|
||||
(lambda vals (andmap (lambda (pre-cont? val)
|
||||
(if pre-cont? (pre-cont? val) #t))
|
||||
pre-cont?s
|
||||
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)
|
||||
(make-do-sequence
|
||||
|
|
@ -810,13 +819,13 @@
|
|||
(lambda (_) (apply producer more)))
|
||||
void
|
||||
(void)
|
||||
void
|
||||
#f
|
||||
(if (procedure? stop)
|
||||
(if (equal? 1 (procedure-arity stop))
|
||||
(lambda (x) (not (stop x)))
|
||||
(lambda xs (not (apply stop xs))))
|
||||
(lambda (x) (not (eq? x stop))))
|
||||
void))))
|
||||
#f))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; running sequences outside of a loop:
|
||||
|
|
@ -838,11 +847,11 @@
|
|||
(lambda () (prep-val!) (next))]
|
||||
[init-prep-val!
|
||||
(lambda ()
|
||||
(if (pos-cont? pos)
|
||||
(if (if pos-cont? (pos-cont? pos) #t)
|
||||
(call-with-values
|
||||
(lambda () (pos->val pos))
|
||||
(lambda vals
|
||||
(if (apply pre-cont? vals)
|
||||
(if (if pre-cont? (apply pre-cont? vals) #t)
|
||||
(begin
|
||||
(set! more? (lambda () #t))
|
||||
(set! next
|
||||
|
|
@ -850,7 +859,9 @@
|
|||
(let ([v vals])
|
||||
(set! prep-val!
|
||||
(lambda ()
|
||||
(if (apply post-cont? pos vals)
|
||||
(if (if post-cont?
|
||||
(apply post-cont? pos vals)
|
||||
#t)
|
||||
(begin
|
||||
(set! pos (pos-next pos))
|
||||
(set! prep-val! init-prep-val!)
|
||||
|
|
|
|||
|
|
@ -290,9 +290,9 @@ in the sequence.
|
|||
@defproc[(make-do-sequence [thunk (-> (values (any/c . -> . any)
|
||||
(any/c . -> . any/c)
|
||||
any/c
|
||||
(any/c . -> . any/c)
|
||||
(() () #:rest list? . ->* . any/c)
|
||||
((any/c) () #:rest list? . ->* . any/c)))])
|
||||
(or/c (any/c . -> . any/c) #f)
|
||||
(or/c (() () #:rest list? . ->* . any/c) #f)
|
||||
(or/c ((any/c) () #:rest list? . ->* . any/c) #f)))])
|
||||
sequence?]{
|
||||
Returns a sequence whose elements are generated by the procedures and
|
||||
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
|
||||
the current position and returns the next 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
|
||||
position, and false if the sequence should end instead of
|
||||
including the value(s).}
|
||||
@item{The fifth result is like the fourth result, but it takes the
|
||||
current element value(s) instead of the current position.}
|
||||
@item{The sixth result is like the fourth result, but it takes both
|
||||
including the value(s). Alternatively, the fourth result can be
|
||||
@racket[#f] to indicate that the sequence should always include the
|
||||
current value(s).}
|
||||
@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
|
||||
determines a sequence end after the current element is already
|
||||
included in the sequence.}]
|
||||
determines whether the sequence ends after the current element is already
|
||||
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.
|
||||
Among the last three procedures, as soon as one of the procedures
|
||||
returns @scheme[#f], the sequence ends, and none are called again.
|
||||
Typically, one of the functions determines the end condition, and the
|
||||
other two functions always return @scheme[#t].}
|
||||
Typically, one of the functions determines the end condition, and
|
||||
@scheme[#f] is used in place of the other two functions.}
|
||||
|
||||
@defthing[prop:sequence struct-type-property?]{
|
||||
|
||||
|
|
|
|||
|
|
@ -98,6 +98,53 @@
|
|||
(open-input-string "1 2 3\n4 5"))])
|
||||
(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.
|
||||
(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)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user