From 3df12dca585ce10a84c2fe07578fd80c73cfd5dc Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 4 Jan 2016 19:55:01 -0600
Subject: [PATCH] specialize sequence/c for one-element sequences
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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))))
---
 racket/collects/racket/sequence.rkt | 126 ++++++++++++++++++----------
 1 file changed, 81 insertions(+), 45 deletions(-)

diff --git a/racket/collects/racket/sequence.rkt b/racket/collects/racket/sequence.rkt
index 65c5ec8d92..494ade427c 100644
--- a/racket/collects/racket/sequence.rkt
+++ b/racket/collects/racket/sequence.rkt
@@ -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