[plt-scheme] On continuations...
Here are the solution to the exercises. Note: I decided to turn return
and yield into values rather than syntax. I had them as global syntax
first, but I didn't want to invest the time to brush up on my rusty
macro skills to get this 100% right. So I took the lazy and convenient
way out. -- You should still be able to use these things for other
Python-ish stuff. -- Of course, the error messages for erroneous cases
won't be quite as good as if you had done everything in syntax. --
Matthias
;; Python
(define-struct generator (value resume))
;; Generator = (make-generator Any (-> (union Generator Any)))
;; Definition -> (def Identifier (Identifier ...) Expression Expression
...)
;; a definition form that binds _return_ and _yield_ in body
;; _yield_ suspends the function call, return a Generator
;; _return_ returns a result from the function call to the call site
;; or the last resumption point
(define-syntax (def stx)
(syntax-case stx ()
[(def p (n ...) exp ...)
(let ([ret (datum->syntax-object stx 'return)]
[yld (datum->syntax-object stx 'yield)])
#`(define (p n ...)
(let/cc #,ret
(let ([#,yld (lambda (x) ;; yield value via generator
(let/cc k
(let ([gen (lambda ()
(let/cc r (set! #,ret r) (k
#f)))])
[#,ret (make-generator x gen)])))])
exp ...))))]))
;; (Any ... -> Any) Any ... (Any -> Any) -> Void
;; (for-each-yield p args ... consumer): apply p to args,
;; then resume the resulting generator until it yields some other value
(define (for-each-yield p . args)
(let* ([all-but-last car]
[last cadr]
[arg (all-but-last args)]
[proc (last args)])
(let L ([next (p arg)])
(when (generator? next)
(proc (generator-value next))
(L ([generator-resume next]))))))
;; Partition : comment .scheme with #; and delete #; from python to
switch
;; Nat -> (Listof (Listof Number))
(define (partitions.scheme n)
(cond [(= n 0) (list empty)]
[else (foldr append ()
(map (lambda (p)
(if (and (pair? p)
(or (null? (cdr p)) (< (car p)
(cadr p))))
(list (cons 1 p) (cons (+ 1 (car p))
(cdr p)))
(list (cons 1 p))))
(partitions (- n 1))))]))
(define (partitions #;.python n)
(def part (n)
(when (= n 0)
(yield empty)
(return #f))
(for-each-yield part (- n 1)
(lambda (p)
(yield (cons 1 p))
(when (and (pair? p) (or (null? (cdr p)) (<
(car p) (cadr p))))
(yield (cons (+ 1 (car p)) (cdr p)))))))
(let ([results '()])
(for-each-yield part n (lambda (p) (set! results (append results
(list p)))))
results))
;; Tests
(equal? (partitions 0) (list empty))
(equal? (partitions 1) (list (list 1)))
(equal? (partitions 2) (list (list 1 1) (list 2)))
(equal? (partitions 3) (list (list 1 1 1)
(list 1 2)
(list 3)))
;; run program run
(partitions 6)