; billboard challenge, part 1
(define (make-list n x)
(let loop ((n n) (xs '()))
(if (zero? n) xs
(loop (- n 1) (cons x xs)))))
(define (prime? n)
(if (even? n) #f
(let loop ((f 3))
(if (< n (* f f)) #t
(if (zero? (modulo n f)) #f
(loop (+ f 2)))))))
(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-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)))
(define (billboard1)
(define e (e-spigot 250))
(let loop ((i 0) (n (e)))
(if (and (< #e1e9 n) (prime? n))
(values i n)
(loop (+ i 1) (+ (* 10 (modulo n #e1e9)) (e))))))
(call-with-values
(lambda () (billboard1))
(lambda (start-position ten-digits)
(display start-position) (newline)
(display ten-digits) (newline)))