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