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

() ()
(1) (1)
(2) (2)
(3) (3)
(4) (4)
(5) (5)
(6) (6)
(7) (7)
(9) (1 1)
(1 2 1) (1 7 1)
(2 9 2) (4 4 4)
(3 3 3) (5 1 5)
(3 7 3) (5 6 5)
(4 1 4) (6 3 6)
(5 8 5) (1 1 1 1)
(3 6 6 3) (7 1 1 7)
(8 7 7 8) (2 1 1 1 2)
(1 3 1 3 1) (3 1 5 1 3)
(1 3 3 3 1) (3 2 0 2 3)
(2 6 4 6 2) (6 3 5 3 6)
(2 6 6 6 2) (6 4 0 4 6)
(3 0 1 0 3) (7 2 6 2 7)
(3 0 3 0 3) (7 3 1 3 7)
(2 0 7 7 0 2) (6 2 5 5 2 6)
(6 2 8 8 2 6) (2 3 1 4 1 3 2)
(6 6 0 0 6 6) (2 4 1 1 1 4 2)

Timeout