make-iterator, guile spidermonkey (, ECMAScript 6). racket , racket call-with-continuation-prompt abort-current-continue guile call-with-prompt .
:
;; 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 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
(define (lazy-filter iter proc)
(make-iterator (lambda (yield)
(for-iter iter (lambda (val) (if (proc val) (yield val)))))))
. 280 Rhino:
(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 , .
Edit:
, , . guile , /cc ( , ):
(define (make-iterator proc . args)
(define prompt-cont
(define iter-cont
(define done
(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
(prompt-cont 'stop-iteration))))))))