#lang scheme/base
;; Sequences

(provide
 (all-defined-out))
(require
 scheme/control
 "misc.ss"
 "list.ss")


(define (in-append . seqs)
  (make-do-sequence
   (lambda ()
     (define seq-stack seqs)
     (define seq-more? false)
     (define generate #f)
     (define (shift-sequences!)
       (if (null? seq-stack)
           (set! seq-more? false)
           (let-values (((m g) (sequence-generate (pop! seq-stack))))
             (set! seq-more? m)
             (set! generate g))))
     (define (more?)
       (or (seq-more?)
           (begin
             (shift-sequences!)
             (seq-more?))))
     (values (lambda _ (generate))
             void void
             (lambda _ (more?))
             void void))))



(define (values-generator fun done)
  (define (yield . vals)
    (control k
             (set! cont (lambda () (k (void))))
             vals))
  (define (cont) (fun yield) (done)) 
  (lambda () (prompt (cont))))

(define (generator fun [done eos])
  (let ((gen (values-generator fun done)))
    (lambda ()
      (apply values (gen)))))

(define (in-generator fun)
  (make-do-sequence
   (lambda ()
     (define last '(dummy)) ;; Helas, only single-valued zero-length sequences..
     (define more #t)
     (define i (values-generator fun false))
     (values (lambda (_)
               (let ((vlist (i)))
                 ;; End-of-sequence cannot be determined until the
                 ;; one-past-last value is attempted to be generated.
                 ;; Record last so we can give the correct amount of
                 ;; values, but set exit condition so that result can
                 ;; be invalidated by (*)
                 (if vlist
                     (set! last vlist)
                     (set! more #f))
                 (apply values last)))
             void void void
             (lambda _ more) ;; (*)
             void))))

;; Run forever / exit with exception.
(define-values
  (eos eos?)
  (let ((end "end-of-sequence")) ;; unique value
    (values (lambda () (raise end))
            (lambda (x) (eq? end x)))))
                         

(define (in-thunk thunk)
  (in-generator
   (lambda (yield)
     (with-handlers ((eos? void))
       (let loop ()
         (yield (thunk))
         (loop))))))