; two-base 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 b)
(do ((k 0 (+ k 1))) ((= k b))
(yield k))
(do ((i 1 (* i b))) (#f)
(do ((j i (+ j 1))) ((= j (* b i)))
(let ((ds (digits j b)))
(yield (undigits (append ds (reverse ds)) b))))
(do ((j i (+ j 1))) ((= j (* b i)))
(let ((ds (digits j b)))
(do ((k 0 (+ k 1))) ((= k b))
(yield (undigits (append ds (list k) (reverse ds)) b)))))))
(let ((p10 (palindromes 10)) (p8 (palindromes 8)))
(let loop ((a (p10)) (b (p8)))
(cond ((< a b) (loop (p10) b))
((< b a) (loop a (p8)))
(else (display (digits a)) (display " ")
(display (digits b 8)) (newline)
(loop (p10) (p8))))))