; fractran

(define (ilog b n)
  (let loop1 ((lo 0) (b^lo 1) (hi 1) (b^hi b))
    (if (< b^hi n) (loop1 hi b^hi (* hi 2) (* b^hi b^hi))
      (let loop2 ((lo lo) (b^lo b^lo) (hi hi) (b^hi b^hi))
        (if (<= (- hi lo) 1) (if (= b^hi n) hi lo)
          (let* ((mid (quotient (+ lo hi) 2))
                 (b^mid (* b^lo (expt b (- mid lo)))))
            (cond ((< n b^mid) (loop2 lo b^lo mid b^mid))
                  ((< b^mid n) (loop2 mid b^mid hi b^hi))
                  (else mid))))))))

(define primegame '(17/91 78/85 19/51 23/38 29/33
  77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55))

(define (fractran prog n)
  (let loop ((fs prog))
    (cond ((null? fs) 'halt)
          ((integer? (* (car fs) n))
            (* (car fs) n))
          (else (loop (cdr fs))))))

(let loop ((n 2) (k 20))
  (when (positive? k)
    (display n) (display " ")
    (loop (fractran primegame n) (- k 1))))
(newline)

(define (primes)
  (let loop ((k 1) (n 2))
    (when (= (expt 2 (ilog 2 n)) n)
      (display k) (display " ")
      (display (ilog 2 n)) (newline))
    (loop (+ k 1) (fractran primegame n))))

(primes)

2 15 825 725 1925 2275 425 390 330 290 770 910 170 156 132 116 308 364 68 4 
1 1
20 2
70 3
281 5
708 7
2364 11
3877 13
8069 17
11320 19
19202 23
36867 29
45552 31
75225 37
101113 41
117832 43
152026 47

Timeout