How to implement Python-style generator in Scheme (Racket or ChezScheme)?

Question

today I solve the N-queen problem using Scheme but it is extremely slow compared to the same version of Python. when N = 8, Scheme takes 90+ seconds! I know one reason is th

Answer 1

I have a make-iterator procedure using guile prompts to implement spidermonkey generators (similar but not identical to ECMAScript 6 generators). Since racket also has prompts this should be directly translatable to racket's call-with-continuation-prompt and abort-current-continuation in place of guile's call-with-prompt and abort-to-prompt.

Here is the code:

;; this procedure takes a generator procedure, namely a procedure
;; which has a 'yield' parameter for its first or only argument,
;; followed by such other arguments (other than the one for the
;; 'yield' parameter) as the generator procedure requires, and
;; constructs an iterator from them.  When the iterator is invoked, it
;; will begin executing the procedure unless and until the argument
;; comprising the yield procedure is called, which will cause the
;; iterator to suspend computation and instead return the value passed
;; to yield (yield is a procedure taking one argument).  If invoked
;; again, the iterator will resume computation at the point where it
;; last left off (returning a list of the values, if any, passed to
;; the iterator on resuming).  When the generator procedure has
;; executed to the end, the iterator returns 'stop-iteration.  This
;; procedure is intentionally modelled on javascript/spider-monkey
;; generators.  It has some resemblance to call/ec, except that (i)
;; instead of executing the passed procedure immediately, it returns
;; an iterator which will do so, (ii) it is resumable, and (iii) the
;; procedure to be executed can receive starting arguments in addition
;; to the yield/break argument, to provide an alternative to binding
;; them with a lambda closure.
(define (make-iterator proc . args)
  (define tag (make-prompt-tag))
  (define send-back '())
  (define (thunk)
    (apply proc
           (lambda (val)
             (abort-to-prompt tag val)
             send-back)
           args)
    ;; the generator procedure has returned - reset thunk to do
    ;; nothing except return 'stop-iteration and return
    ;; 'stop-iteration after this last call to proc
    (set! thunk (lambda () 'stop-iteration))
    'stop-iteration)
  (lambda send-args
    (set! send-back send-args)
    (call-with-prompt tag
                      thunk
                      (lambda (cont ret)
                        (set! thunk cont)
                        ret))))

Here are procedures for pipe-lining:

;; for-iter iterates until the iterator passed to it (as constructed
;; by make-iterator) returns 'stop-iteration.  It invokes the procedure
;; passed as a second argument with the value yielded by the iterator
;; on each iteration.  It is mainly used for composing lazy operations
;; by pipelining, as for example with lazy-map and lazy-filter.
(define (for-iter iter proc)
  (let loop()
    (let ([val (iter)])
      (if (not (eq? val 'stop-iteration))
          (begin
            (proc val)
            (loop))))))

;; lazy-map is a procedure which takes an input iterator constructed
;; by make-iterator and a standard procedure, and then returns another
;; iterator (the output iterator) which yields the values obtained by
;; applying the standard procedure to the input iterator's yielded
;; values.
(define (lazy-map iter proc)
  (make-iterator (lambda (yield)
                   (for-iter iter (lambda (val) (yield (proc val)))))))

;; lazy-filter is a procedure which takes an input iterator
;; constructed by make-iterator, and then returns another iterator
;; (the output iterator) which yields such of the values yielded by
;; the input iterator as are those for which the predicate proc
;; returns #t
(define (lazy-filter iter proc)
  (make-iterator (lambda (yield)
                   (for-iter iter (lambda (val) (if (proc val) (yield val)))))))

And here is the canonical counter example from p.280 of the 6th edition of the Rhino book:

(define (counter yield initial)
  (let loop ([next-value initial])
    (let ([increment (yield next-value)])
      (if (not (null? increment))
          (if (eq? (car increment) 'reset)
              (loop initial)
              (loop (+ next-value (car increment))))
          (loop (+ 1 next-value))))))

(define counter-iter (make-iterator counter 10))   ;; create iterator at 10
(display (counter-iter))(newline)                  ;; prints 10
(display (counter-iter 2))(newline)                ;; prints 12
(display (counter-iter 'reset))(newline)           ;; prints 10

I also have an anaphoric version as a macro, which injects a yield keyname into a body of code, but I prefer the approach above.

Edit:

For scheme implementations which do not support prompts, the following works identically to the version using prompts. However with guile, prompts are more efficient than using full call/cc continuations (I guess that is not necessarily true for all implementations):

(define (make-iterator proc . args)
  (define prompt-cont #f)
  (define iter-cont #f)
  (define done #f)
  (define (yield arg)
    (call/cc
     (lambda (k)
       (set! iter-cont k)
       (prompt-cont arg))))
  (lambda send-back
    (if done
      'stop-iteration
      (call/cc
       (lambda (k)
         (set! prompt-cont k)
         (if iter-cont
           (iter-cont send-back)
           (begin
              (apply proc yield args)
              (set! done #t)
              (prompt-cont 'stop-iteration))))))))