diff --git a/collects/tests/unstable/sequence.rkt b/collects/tests/unstable/sequence.rkt index 16158151d8..f73614da88 100644 --- a/collects/tests/unstable/sequence.rkt +++ b/collects/tests/unstable/sequence.rkt @@ -4,12 +4,26 @@ (run-tests (test-suite "sequence.rkt" - (check-true (sequence? (in-slice 1 '()))) - (check-equal? '() (for/list ([v (in-slice 1 '())]) v)) - (check-equal? '((0 1)) (for/list ([v (in-slice 3 (in-range 2))]) v)) - (check-equal? '((0 1 2) (3 4 5)) - (for/list ([v (in-slice 3 (in-range 6))]) v)) - (check-equal? '((0 1 2) (3 4 5) (6 7)) - (for/list ([v (in-slice 3 (in-range 8))]) v)) - (check-exn exn:fail:contract? - (lambda () (for/list ([x (in-slice 0 (in-range 8))]) x))))) + (check-equal? (for/list ([x (sequence-lift add1 (in-range 10))]) + x) + '(1 2 3 4 5 6 7 8 9 10)) + (check-equal? (for/list ([x (sequence-lift + + (in-parallel (in-range 10) (in-range 10)))]) + x) + '(0 2 4 6 8 10 12 14 16 18)) + (check-equal? (for/list ([x (in-sequence-forever (in-range 5) 5)] + [y (in-range 10)]) + x) + '(0 1 2 3 4 5 5 5 5 5)) + (check-equal? (for/list ([(x y) (in-pairs '((1 . 1) (2 . 2) (3 . 3)))]) + (+ x y)) + '(2 4 6)) + (check-true (sequence? (in-slice 1 '()))) + (check-equal? '() (for/list ([v (in-slice 1 '())]) v)) + (check-equal? '((0 1)) (for/list ([v (in-slice 3 (in-range 2))]) v)) + (check-equal? '((0 1 2) (3 4 5)) + (for/list ([v (in-slice 3 (in-range 6))]) v)) + (check-equal? '((0 1 2) (3 4 5) (6 7)) + (for/list ([v (in-slice 3 (in-range 8))]) v)) + (check-exn exn:fail:contract? + (lambda () (for/list ([x (in-slice 0 (in-range 8))]) x))))) diff --git a/collects/unstable/sequence.rkt b/collects/unstable/sequence.rkt index 8f44640fcc..7f9ce96b41 100644 --- a/collects/unstable/sequence.rkt +++ b/collects/unstable/sequence.rkt @@ -7,45 +7,44 @@ (provide in-syntax in-pairs in-sequence-forever sequence-lift) (define-sequence-syntax in-syntax - (lambda () #'(lambda (e) (in-list (syntax->list e)))) - (lambda (stx) + (λ () #'(λ (e) (in-list (syntax->list e)))) + (λ (stx) (syntax-case stx () [[ids (_ arg)] #'[ids (in-list (syntax->list arg))]]))) (define (in-pairs seq) (make-do-sequence - (lambda () + (λ () (let-values ([(more? gen) (sequence-generate seq)]) - (values (lambda (e) (let ([e (gen)]) (values (car e) (cdr e)))) - (lambda (_) #t) + (values (λ (e) (let ([e (gen)]) (values (car e) (cdr e)))) + (λ (_) #t) #t - (lambda (_) (more?)) - (lambda _ #t) - (lambda _ #t)))))) + (λ (_) (more?)) + (λ _ #t) + (λ _ #t)))))) (define (in-sequence-forever seq val) (make-do-sequence - (lambda () + (λ () (let-values ([(more? gen) (sequence-generate seq)]) - (values (lambda (e) (let ([e (if (more?) (gen) val)]) e)) - (lambda (_) #t) + (values (λ (e) (if (more?) (gen) val)) + (λ (_) #t) #t - (lambda (_) #t) - (lambda _ #t) - (lambda _ #t)))))) + (λ (_) #t) + (λ _ #t) + (λ _ #t)))))) (define (sequence-lift f seq) (make-do-sequence - (lambda () + (λ () (let-values ([(more? gen) (sequence-generate seq)]) - (values (lambda (e) (f (gen))) - (lambda (_) #t) + (values (λ (e) (call-with-values gen f)) + (λ (_) #t) #t - (lambda (_) (more?)) - (lambda _ #t) - (lambda _ #t)))))) - + (λ (_) (more?)) + (λ _ #t) + (λ _ #t)))))) ;; Added by stamourv (from David Vanderson (david.vanderson at gmail.com)): @@ -55,15 +54,14 @@ (define (in-slice k seq) (unless (sequence? seq) (raise-type-error 'in-slice "sequence" seq)) (make-do-sequence - (lambda () + (λ () (define-values (more? get) (sequence-generate seq)) (values - (lambda (_) - (for/list ((i k) - #:when (more?)) + (λ (_) + (for/list ([i k] #:when (more?)) (get))) values #f #f - (lambda (val) (0 . < . (length val))) + (λ (val) (0 . < . (length val))) #f))))