我有一个使用 guile 提示的 make-iterator 过程来实现 spidermonkey 生成器(与 ECMAScript 6 生成器相似但不完全相同)。由于球拍也有提示,这应该可以直接翻译成球拍的呼叫连续提示和中止当前继续代替诡计的呼叫提示和中止提示。
代码如下:
;; 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))))
以下是管道内衬的程序:
;; 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)))))))
以下是 Rhino 书第 6 版第 280 页的典型反例:
(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
我还有一个作为宏的照应版本,它将一个 yield 键名注入到代码体中,但我更喜欢上面的方法。
编辑:
对于不支持提示的方案实现,以下与使用提示的版本相同。然而,使用诡计,提示比使用完整的调用/抄送延续更有效(我猜这不一定适用于所有实现):
(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))))))))