codepad

Language:

; 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)))

Private [?]

Run code