; double dabble

(use-modules (ice-9 format))

(define (double x) (+ x x))

(define (string-join sep ss)
  (define (f s ss)
    (string-append s (string sep) ss))
  (define (join ss)
    (if (null? (cdr ss)) (car ss)
      (f (car ss) (join (cdr ss)))))
  (if (null? ss) "" (join ss)))

(define (dabble-ones n)
  (let ((ones (modulo (quotient n (* 16 16)) 16)))
    (cond ((< 4 ones)
            (display " dabble-ones")
            (+ n (* 3 (* 16 16))))
          (else n))))

(define (dabble-tens n)
  (let ((tens (modulo (quotient n (* 16 16 16)) 16)))
    (cond ((< 4 tens)
            (display " dabble-tens")
            (+ n (* 3 (* 16 16 16))))
          (else n))))

(define (display-bits n)
  (string-join #\space (list
    (format "~4,'0B" (modulo (quotient n (* 16 16 16 16)) 16))
    (format "~4,'0B" (modulo (quotient n (* 16 16 16)) 16))
    (format "~4,'0B" (modulo (quotient n (* 16 16)) 16))
    (format "~8,'0B" (modulo n 256)))))

(define (double-dabble n)
  (do ((i 0 (+ i 1)))
      ((= i 8) (display (display-bits n)) (newline))
    (display (display-bits n))
    (set! n (dabble-ones n))
    (set! n (dabble-tens n))
    (set! n (double n))
    (newline)))

(double-dabble  42) (newline)
(double-dabble 220) (newline)
(double-dabble 243) (newline)