[plt-scheme] generators with sequences

 From: Jon Rafkind (rafkind at cs.utah.edu) Date: Wed Aug 26 01:29:26 EDT 2009 Previous message: [plt-scheme] plai: lazyness and exercise 6.4.2 Next message: [plt-scheme] generators with sequences Messages sorted by: [date] [thread] [subject] [author]

```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))
(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))
(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))