; digits of e

(define (make-list n x)
  (let loop ((n n) (xs '()))
    (if (zero? n) xs
      (loop (- n 1) (cons x xs)))))

(define-syntax define-generator
  (lambda (x)
    (syntax-case x (lambda)
      ((stx name (lambda formals e0 e1 ...))
         (with-syntax ((yield (datum->syntax-object (syntax stx) 'yield)))
           (syntax (define name
             (lambda formals
               (let ((resume #f) (return #f))
                 (define yield
                   (lambda args
                     (call-with-current-continuation
                      (lambda (cont)
                        (set! resume cont)
                        (apply return args)))))
                 (lambda ()
                   (call-with-current-continuation
                    (lambda (cont)
                      (set! return cont)
                      (cond (resume (resume))
                      (else (let () e0 e1 ...)
                            (error 'name "unexpected return"))))))))))))
        ((stx (name . formals) e0 e1 ...)
          (syntax (stx name (lambda formals e0 e1 ...)))))))

(define (take-gen n gen)
  (let loop ((n n) (xs (list)))
    (if (zero? n) (reverse xs)
      (loop (- n 1) (cons (gen) xs)))))

(define-generator (e-spigot n)
  (define (times10 x) (* 10 x))
  (yield 2)
  (let loop1 ((ts (make-list n 10)) (k n))
    (if (< 1 k)
      (let loop2 ((ts ts) (rs (list)) (i (+ n 1)) (carry 0))
        (if (= i 1)
            (begin (yield carry) (loop1 (map times10 (reverse rs)) (- k 1)))
            (let* ((x (+ (car ts) carry)) (q (quotient x i)) (r (remainder x i)))
              (loop2 (cdr ts) (cons r rs) (- i 1) q))))))
  (let loop3 () (yield #f) (loop3)))

(display (take-gen 30 (e-spigot 25))) (newline)

(define-generator (make-spigot f lo hi)
  (define (split v)
    (values (vector-ref v 0) (vector-ref v 1) (vector-ref v 2)))
  (define (approx abc n)
    (let-values (((a b c) (split abc)))
      (quotient (+ (* a n) b) c)))
  (define (mul abc def)
    (let-values (((a b c) (split abc)) ((d e f) (split def)))
      (vector (* a d) (+ (* a e) (* b f)) (* c f))))
  (define (g k) (let-values (((n d a) (f k))) (vector n (* a d) d)))
  (let loop ((z (vector 1 0 1)) (k 1))
    (let ((lbound (approx z lo)))
      (cond ((= lbound (approx z hi))
              (yield lbound)
              (loop (mul (vector 10 (* -10 lbound) 1) z) k))
      (else (loop (mul z (g k)) (+ k 1)))))))

(define pi-spigot (make-spigot (lambda (k) (values k (+ k k 1) 2)) 3 4))
(define e-spigot (make-spigot (lambda (k) (values 1 k 1)) 1 2))
(define sqrt2-spigot
  (make-spigot
    (lambda (k)
      (if (= k 1)
          (values 7 5 0)
          (values (+ k k -3) (* (- k 1) 100) 1)))
    1 2))

(display (take-gen 30 pi-spigot)) (newline)
(display (take-gen 30 e-spigot)) (newline)
(display (take-gen 30 sqrt2-spigot)) (newline)

(2 7 1 8 2 8 1 8 2 8 4 5 9 0 4 5 2 3 5 3 6 0 2 8 7 #f #f #f #f #f)
(3 1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7)
(2 7 1 8 2 8 1 8 2 8 4 5 9 0 4 5 2 3 5 3 6 0 2 8 7 4 7 1 3 5)
(1 4 1 4 2 1 3 5 6 2 3 7 3 0 9 5 0 4 8 8 0 1 6 8 8 7 2 4 2 0)