[plt-scheme] generators with sequences
One other thought: did your explorations with the call/cc variant
suggest ways that Ruby might be broken? Did you try to confirm that?
It may shed some light on the Scheme version.
Robby
On Wed, Aug 26, 2009 at 9:46 AM, Matthias Felleisen<matthias at ccs.neu.edu> wrote:
>
> Write up a section for the Guide, check it in as an aux library for
> for-loops, and advertise. I am sure Matthew can show you where the Guide
> lives and what the editorial rules are. -- Matthias
>
>
>
>
> On Aug 26, 2009, at 1:29 AM, Jon Rafkind wrote:
>
>> I wrote a generator syntax for use with the v4 `for' sequences. Some
>> example usages are below but the main point is you can say (yield 5) when
>> you want a function to produce a value that can be used as a sequence. It
>> took me a few tries to get this right and I left most of my attempts in so
>> others can maybe learn what not to do. This could go into collects/, so if
>> anyone has any improvements please share! The last attempt (test4) is my
>> best effort so far.
>>
>> #lang scheme
>>
>> (require scheme/control)
>> (require scheme/stxparam)
>> (define (check v1 v2)
>> (when (not (equal? v1 v2))
>> (printf "test failed expected ~a actual ~a\n" v1 v2)))
>>
>> (define (do-tests for-function)
>> (check (for/list ([i (in-range 0 10)])
>> i)
>> (for/list ([i (in-range 0 10)])
>> i))
>>
>> #;
>> (let ([x 0])
>> (for/list ([i (for-function)])
>> (printf "i ~a x ~a\n" i x)
>> (set! x (add1 x))
>> i))
>>
>> (check (for/list ([i (in-range 0 10)])
>> i)
>> (let ([x 0])
>> (for/list ([i (for-function)])
>> ;; (printf "i ~a x ~a\n" i x)
>> (set! x (add1 x))
>> i)))
>>
>> (for/list ([i (for-function)]
>> [j (in-range 0 5)])
>> ;; (printf "i ~a j ~a\n" i j)
>> (list i j))
>>
>> (check (for/list ([i (in-range 0 10)]
>> [j (in-range 0 5)])
>> (list i j))
>> (for/list ([i (for-function)]
>> [j (in-range 0 5)])
>> ;; (printf "i ~a j ~a\n" i j)
>> (list i j)))
>>
>> (check (for/list ([i (in-range 0 10)]
>> [j (in-range 0 10)])
>> (list i j))
>> (for/list ([i (for-function)]
>> [j (for-function)])
>> (list i j)))
>>
>> (check (for/list ([(v vi) (in-indexed (in-range 0 10))])
>> (list v vi))
>> (for/list ([(v vi) (in-indexed (for-function))])
>> (list v vi)))
>>
>> (check (for/list ([v (in-sequences (in-range 0 10) (in-range 0 10))])
>> v)
>> (for/list ([v (in-sequences (for-function) (for-function))])
>> v))
>>
>> ;; doesn't work yet
>> #;
>> (check (for/list ([v (in-cycle (in-range 0 10))]
>> [x (in-range 0 100)])
>> v)
>> (for/list ([v (in-cycle (for-function))]
>> [x (in-range 0 100)])
>> (printf "~a ~a\n" v x)
>> v))
>> )
>>
>> ;; completely broken version using call/cc and creating too many sequence
>> objects
>> (define test1
>> (let ()
>> (define-syntax yield
>> (syntax-rules ()
>> [(_ yielder value)
>> (call/cc (lambda (ret)
>> (let ([s (make-do-sequence (lambda ()
>> (values
>> (lambda (i) value)
>> (lambda (x) (ret #f))
>> 0
>> (lambda (x) #t)
>> (lambda (v) (eq? v value))
>> (lambda (x v) #t))))])
>> (yielder s))))]))
>>
>> (define-syntax define-generator
>> (syntax-rules ()
>> [(_ ret (name args ...) body0 bodies ...)
>> (define (name args ...)
>> (call/cc (lambda (ret)
>> body0 bodies ...
>> (make-do-sequence (lambda ()
>> (values
>> (lambda (i) (void))
>> (lambda (x) (void))
>> 0
>> (lambda (x) #f)
>> (lambda (x) #f)
>> (lambda (x y) #f))))
>> )))]))
>>
>>
>> (define-generator yielder (blah)
>> (for ([x (in-range 0 10)])
>> (yield yielder x)))
>>
>> (printf "test1\n")
>> (do-tests blah)
>> ))
>>
>> ;; working version using prompt/control
>> (define test2
>> (let ()
>> (define-syntax yield
>> (syntax-rules ()
>> [(_ value)
>> ;; Capture the current delimited continuation, f, and pass back to
>> the last prompt a,
>> ;; value and a function that installs a new prompt and continues
>> where f left off.
>> (control f (values value (lambda () (prompt (f)))))]))
>>
>> (define-syntax lambda-generator
>> (syntax-rules ()
>> [(_ (args ...) body0 bodies ...)
>> (lambda (args ...)
>> (let* ([current (lambda ()
>> (prompt
>> body0 bodies ...
>> ;; (printf "now what\n")
>> (values #f #f)
>> ))]
>> [pos 0]
>> [seq (make-do-sequence (lambda ()
>> (values
>> (lambda (i) (let-values ([(value
>> next) (current)])
>> ;; (printf "Next
>> value is ~a\n" value)
>> (set! current
>> next)
>> value))
>> (lambda (x) (add1 x))
>> 0
>> (lambda (x) current)
>> (lambda (v) current)
>> (lambda (x v) current))))])
>> seq))]))
>>
>> (define-syntax define-generator
>> (syntax-rules ()
>> [(_ (name args ...) body0 bodies ...)
>> (define name (lambda-generator (args ...) body0 bodies ...))]))
>>
>> (define-generator (blah)
>> (for ([x (in-range 0 10)])
>> (yield x)))
>>
>> (printf "test2\n")
>> (do-tests blah)
>>
>> #;
>> (printf "test3\n")
>> #;
>> (do-tests (lambda ()
>> (make-do-sequence (lambda ()
>> (values
>> (lambda (i) i)
>> (lambda (x) (add1 x))
>> 0
>> (lambda (x) (< x 10))
>> (lambda (v) #t)
>> (lambda (x v) #t))))))
>>
>> ;; a cute example
>> #;
>> (let ()
>> ;; generate infinte list of unique names
>> (define-generator (machine-names)
>> (define letters "abcdefghijklmnopqrstuvwxyz")
>> (let loop ([len 0])
>> ;; generates strings of length num
>> (define-generator (generate num)
>> (for ([letter (in-string
>> letters)])
>> (if (= num 0)
>> (yield (string letter))
>> (for ([l2 (generate (- num
>> 1))])
>> (yield (string-append
>> (string letter) l2))))))
>> (for ([str (generate len)])
>> (yield str))
>> (loop (add1 len))))
>> (for ([s (machine-names)]
>> [j (in-range 0 1000)])
>> (printf "~a: ~a\n" j s)))
>>
>> ))
>>
>> ;; better version using shift/reset
>> (define test3
>> (let ()
>> (define-syntax yield
>> (syntax-rules ()
>> [(_ value)
>> (shift f (values value f))]))
>>
>> (define-syntax lambda-generator
>> (syntax-rules ()
>> [(_ (args ...) body0 bodies ...)
>> (lambda (args ...)
>> (let* ([current (lambda ()
>> (reset
>> body0 bodies ...
>> ;; (printf "now what\n")
>> (values #f #f)
>> ))]
>> [pos 0]
>> [seq (make-do-sequence (lambda ()
>> (values
>> (lambda (i) (let-values ([(value
>> next) (current)])
>> ;; (printf "Next
>> value is ~a\n" value)
>> (set! current
>> next)
>> value))
>> (lambda (x) (add1 x))
>> 0
>> (lambda (x) current)
>> (lambda (v) current)
>> (lambda (x v) current))))])
>> seq))]))
>>
>> (define-syntax define-generator
>> (syntax-rules ()
>> [(_ (name args ...) body0 bodies ...)
>> (define name (lambda-generator (args ...) body0 bodies ...))]))
>>
>> (define-generator (blah)
>> (for ([x (in-range 0 10)])
>> (yield x)))
>>
>> (printf "test3\n")
>> (do-tests blah)
>>
>> #;
>> (printf "test3\n")
>> #;
>> (do-tests (lambda ()
>> (make-do-sequence (lambda ()
>> (values
>> (lambda (i) i)
>> (lambda (x) (add1 x))
>> 0
>> (lambda (x) (< x 10))
>> (lambda (v) #t)
>> (lambda (x v) #t))))))
>>
>> ;; a cute example
>> #;
>> (let ()
>> ;; generate infinte list of unique names
>> (define-generator (machine-names)
>> (define letters "abcdefghijklmnopqrstuvwxyz")
>> (let loop ([len 0])
>> ;; generates strings of length num
>> (define-generator (generate num)
>> (for ([letter (in-string
>> letters)])
>> (if (= num 0)
>> (yield (string letter))
>> (for ([l2 (generate (- num
>> 1))])
>> (yield (string-append
>> (string letter) l2))))))
>> (for ([str (generate len)])
>> (yield str))
>> (loop (add1 len))))
>> (for ([s (machine-names)]
>> [j (in-range 0 1000)])
>> (printf "~a: ~a\n" j s)))
>>
>> ))
>>
>> ;; better version of shift/reset using continuation tags
>> ;; also use a unique value to determine the end of the sequence instead of
>> using #f
>> (define test4
>> (let ()
>> (define-syntax-parameter yield (lambda (stx)
>> (raise-syntax-error #f "yield is only
>> bound inside a sequence generator")))
>>
>> (define-syntax lambda-generator
>> (syntax-rules ()
>> [(_ (args ...) body0 bodies ...)
>> (lambda (args ...)
>> (let* ([last (lambda () (void))]
>> ;; current is a function that invokes user code and
>> produces values
>> [current (lambda ()
>> ;; a unique tag to jump to
>> (define tag (make-continuation-prompt-tag))
>> ;; give the value to the sequence
>> (define next (lambda (value)
>> (shift-at tag f (values value
>> f))))
>> (syntax-parameterize ([yield
>> (make-rename-transformer #'next)])
>> (reset-at tag
>> body0 bodies ...
>> (values #f last)
>> )))]
>> [pos 0]
>> [seq (make-do-sequence (lambda ()
>> (values
>> ;; produce a value and a
>> continuation
>> (lambda (i) (let-values ([(value
>> next) (current)])
>> ;; set! is ugly
>> but can we do better?
>> (set! current
>> next)
>> value))
>> (lambda (x) (add1 x))
>> 0
>> (lambda (x) (not (eq? last
>> current)))
>> (lambda (v) (not (eq? last
>> current)))
>> (lambda (x v) (not (eq? last
>> current))))))])
>> seq))]))
>>
>> (define-syntax define-generator
>> (syntax-rules ()
>> [(_ (name args ...) body0 bodies ...)
>> (define name (lambda-generator (args ...) body0 bodies ...))]))
>>
>> (define-generator (blah)
>> (for ([x (in-range 0 10)])
>> (yield x)))
>>
>> (printf "test4\n")
>> (do-tests blah)
>>
>> (check (for/list ([i ((lambda-generator ()
>> (for ([i (in-range 0 5)]) (yield
>> #f))))])
>> i)
>> (for/list ([i (in-range 0 5)])
>> #f))
>>
>> (check (for/list ([i ((lambda-generator ()
>> (for ([i (in-range 0 5)])
>> (yield
>> (reset
>> (for ([j (in-range 2 5)])
>> (shift k (+ i
>> j))))))))])
>> i)
>> (for/list ([i (in-range 2 7)])
>> i))
>>
>> #;
>> (printf "test3\n")
>> #;
>> (do-tests (lambda ()
>> (make-do-sequence (lambda ()
>> (values
>> (lambda (i) i)
>> (lambda (x) (add1 x))
>> 0
>> (lambda (x) (< x 10))
>> (lambda (v) #t)
>> (lambda (x v) #t))))))
>>
>> ;; a cute example
>> #;
>> (let ()
>> ;; generate infinte list of unique names
>> (define-generator (machine-names)
>> (define letters "abcdefghijklmnopqrstuvwxyz")
>> (let loop ([len 0])
>> ;; generates strings of length num
>> (define-generator (generate num)
>> (for ([letter (in-string
>> letters)])
>> (if (= num 0)
>> (yield (string letter))
>> (for ([l2 (generate (- num
>> 1))])
>> (yield (string-append
>> (string letter) l2))))))
>> (for ([str (generate len)])
>> (yield str))
>> (loop (add1 len))))
>> (for ([s (machine-names)]
>> [j (in-range 0 1000)])
>> (printf "~a: ~a\n" j s)))
>>
>> ))
>>
>> _________________________________________________
>> For list-related administrative tasks:
>> http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
> _________________________________________________
> For list-related administrative tasks:
> http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
![[logo]](/logo.png){kind=logo}