; generating palindromes
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
(if (zero? n) d
(loop (quotient n b)
(cons (modulo n b) d))))))
(define (undigits ds . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((ds ds) (n 0))
(if (null? ds) n
(loop (cdr ds) (+ (* n b) (car ds)))))))
(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 (palindromes)
(do ((k 0 (+ k 1))) ((= k 10))
(yield k))
(do ((i 1 (* i 10))) (#f)
(do ((j i (+ j 1))) ((= j (* 10 i)))
(let ((ds (digits j)))
(yield (undigits (append ds (reverse ds))))))
(do ((j i (+ j 1))) ((= j (* 10 i)))
(let ((ds (digits j)))
(do ((k 0 (+ k 1))) ((= k 10))
(yield (undigits (append ds (list k) (reverse ds)))))))))
(define (nth-palindrome n)
(let ((p (palindromes)))
(do ((n n (- n 1))) ((= n 1) (p)) (p))))
(let ((p (palindromes)))
(do ((n 100 (- n 1))) ((zero? n) (newline))
(display (p)) (newline)))
(display (nth-palindrome 100)) (newline)
(display (nth-palindrome 10000)) (newline)