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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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