; prime string

(define (make-hash hash eql? oops size)
  (define (delete x xs)
    (let loop ((xs xs) (zs (list)))
      (cond ((null? xs) zs)
            ((eql? (caar xs) x) (loop (cdr xs) zs))
            (else (loop (cdr xs) (cons (car xs) zs))))))
  (define (lookup x xs)
    (cond ((null? xs) oops)
          ((eql? x (caar xs)) (cdar xs))
          (else (lookup x (cdr xs)))))
  (let ((table (make-vector size '())))
    (lambda (message key . val)
      (let* ((index (modulo (hash key) size))
             (alist (vector-ref table index)))
        (case message
          ((show) (do ((i 0 (+ i 1))) ((= i size))
                    (display i) (display " ")
                    (display (vector-ref table i))
                    (newline)))
          ((insert!) (vector-set! table index
            (cons (cons key (car val)) alist)))
          ((delete!) (vector-set! table index
            (delete key alist)))
          ((lookup) (lookup key alist)))))))

(define-syntax while
  (syntax-rules ()
    ((while pred? body ...)
      (do () ((not pred?)) body ...))))
 
(define (identity x) x)
 
(define-syntax define-generator
  (lambda (x)
    (syntax-case x (lambda)
      ((stx name (lambda formals e0 e1 ...))
         (with-syntax ((yield (datum->syntax (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 (primegen)
  (yield 2) (yield 3)
  (let* ((ps (primegen))
         (p (and (ps) (ps)))
         (q (* p p))
         (d (make-hash identity = #f 997)))
    (define (add x s)
      (while (d 'lookup x)
        (set! x (+ x s)))
      (d 'insert! x s))
    (do ((c (+ p 2) (+ c 2))) (#f)
      (cond ((d 'lookup c)
              (let ((s (d 'lookup c)))
                (d 'delete! c)
                (add (+ c s) s)))
            ((< c q) (yield c))
            (else (add (+ c p p) (+ p p))
                  (set! p (ps))
                  (set! q (* p p)))))))

(define (prime-substring n)
  (let ((ps (primegen)))
    (let loop ((i 0) (str ""))
      (cond ((< (string-length str) 5)
              (loop i (string-append str (number->string (ps)))))
            ((< i n)
              (loop (+ i 1) (substring str 1 (string-length str))))
            (else (substring str 0 5))))))

(display (prime-substring 50)) (newline)
(display (prime-substring 1000)) (newline)