[plt-scheme] On continuations...

From: Matthias Felleisen (matthias at ccs.neu.edu)
Date: Fri Dec 17 23:11:16 EST 2004

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. -- 

;; 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 
                                 [#,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 
;; 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)))))

;; 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)

Posted on the users mailing list.