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

specialize sequence/c for one-element sequences

Browse Source 
this yields only a modest speed up and only when iterating
over long sequences, e.g. like in this program:

  #lang racket/base
  (require racket/sequence racket/contract/base)
  (define s (make-string 10000 #\a))
  (define str (contract (any/c . -> .  (sequence/c char?))
                        (λ (x) (in-string s))
                        'pos 'neg))
  (time
   (for ([x (in-range 100)])
     (for ([x (str 0)])
       (void))))
This commit is contained in:
Robby Findler 2016-01-04 19:55:01 -06:00
parent 94ac77d30e
commit 3df12dca58
1 changed files with 81 additions and 45 deletions

126
racket/collects/racket/sequence.rkt
View File

@ -202,51 +202,87 @@
(define blame (blame-add-context orig-blame "an element of"))
(define ps (for/list ([mk-proj (in-list elem/mk-projs)])
(mk-proj blame)))
(λ (seq neg-party)
(unless (sequence? seq)
(raise-blame-error
orig-blame #:missing-party neg-party seq
'(expected: "a sequence" given: "~e")
seq))
(define result-seq
(make-do-sequence
(lambda ()
(let*-values ([(more? next) (sequence-generate seq)])
(values
(lambda (idx)
(call-with-values
next
(lambda elems
(define n-elems (length elems))
(unless (= n-elems n-cs)
(raise-blame-error
blame #:missing-party neg-party seq
'(expected: "a sequence of ~a values" given: "~a values\n values: ~e")
n-cs n-elems elems))
(apply
values
(for/list ([elem (in-list elems)]
[p (in-list ps)])
(p elem neg-party))))))
add1
0
(lambda (idx)
(define ans (more?))
(when (and min-count (idx . < . min-count))
(unless ans
(raise-blame-error
orig-blame #:missing-party neg-party
seq
'(expected: "a sequence that contains at least ~a values" given: "~e")
min-count
seq)))
ans)
(lambda elems #t)
(lambda (idx . elems) #t))))))
(cond
[(list? seq) (sequence->list result-seq)]
[(stream? seq) (sequence->stream result-seq)]
[else result-seq])))))
(cond
[(and (= n-cs 1) (not min-count))
(define p (car ps))
(λ (seq neg-party)
(unless (sequence? seq)
(raise-blame-error
orig-blame #:missing-party neg-party seq
'(expected: "a sequence" given: "~e")
seq))
(define result-seq
(make-do-sequence
(lambda ()
(let*-values ([(more? next) (sequence-generate seq)])
(values
(lambda (idx)
(call-with-values
next
(case-lambda
[(elem)
(p elem neg-party)]
[elems
(define n-elems (length elems))
(raise-blame-error
blame #:missing-party neg-party seq
'(expected: "a sequence of ~a values" given: "~a values\n values: ~e")
n-cs n-elems elems)])))
add1
0
(lambda (idx) (more?))
(lambda elems #t)
(lambda (idx . elems) #t))))))
(cond
[(list? seq) (sequence->list result-seq)]
[(stream? seq) (sequence->stream result-seq)]
[else result-seq]))]
[else
(λ (seq neg-party)
(unless (sequence? seq)
(raise-blame-error
orig-blame #:missing-party neg-party seq
'(expected: "a sequence" given: "~e")
seq))
(define result-seq
(make-do-sequence
(lambda ()
(let*-values ([(more? next) (sequence-generate seq)])
(values
(lambda (idx)
(call-with-values
next
(lambda elems
(define n-elems (length elems))
(unless (= n-elems n-cs)
(raise-blame-error
blame #:missing-party neg-party seq
'(expected: "a sequence of ~a values" given: "~a values\n values: ~e")
n-cs n-elems elems))
(apply
values
(for/list ([elem (in-list elems)]
[p (in-list ps)])
(p elem neg-party))))))
add1
0
(lambda (idx)
(define ans (more?))
(when (and min-count (idx . < . min-count))
(unless ans
(raise-blame-error
orig-blame #:missing-party neg-party
seq
'(expected: "a sequence that contains at least ~a values" given: "~e")
min-count
seq)))
ans)
(lambda elems #t)
(lambda (idx . elems) #t))))))
(cond
[(list? seq) (sequence->list result-seq)]
[(stream? seq) (sequence->stream result-seq)]
[else result-seq]))]))))
;; additional sequence constructors